diff --git a/metadata/entries/Simpl.toml b/metadata/entries/Simpl.toml
--- a/metadata/entries/Simpl.toml
+++ b/metadata/entries/Simpl.toml
@@ -1,25 +1,26 @@
 title = "A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment"
 date = 2008-02-29
 topics = [
   "Computer science/Programming languages/Language definitions",
   "Computer science/Programming languages/Logics",
 ]
 abstract = "We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational semantics) and Hoare logics for both partial as well as total correctness. We prove soundness and completeness of the Hoare logic. We integrate and automate the Hoare logic in Isabelle/HOL to obtain a practically usable verification environment for imperative programs. Simpl is independent of a concrete programming language but expressive enough to cover all common language features: mutually recursive procedures, abrupt termination and exceptions, runtime faults, local and global variables, pointers and heap, expressions with side effects, pointers to procedures, partial application and closures, dynamic method invocation and also unbounded nondeterminism."
-license = "lgpl"
+license = "bsd"
 note = ""
 
 [authors]
 
 [authors.schirmer]
 
 [contributors]
 
 [notify]
 klein = "klein_email"
 schirmer = "schirmer_email"
 
 [history]
+2024-02-18 = "License change to BSD; more canonical and versatile ML interfaces; some more derived language constructs."
 
 [extra]
 
 [related]
diff --git a/thys/Simpl/AlternativeSmallStep.thy b/thys/Simpl/AlternativeSmallStep.thy
--- a/thys/Simpl/AlternativeSmallStep.thy
+++ b/thys/Simpl/AlternativeSmallStep.thy
@@ -1,3884 +1,3863 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      AlternativeSmallStep.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section  \<open>Alternative Small Step Semantics\<close>
 
 theory AlternativeSmallStep imports HoareTotalDef
 begin
 
 
 text \<open>
 This is the small-step semantics, which is described and used in my PhD-thesis \<^cite>\<open>"Schirmer-PhD"\<close>.
 It decomposes the statement into a list of statements and finally executes the head.
 So the redex is always the head of the list. The equivalence between termination
 (based on the big-step semantics) and the absence of infinite computations in
 this small-step semantics follows the same lines of reasoning as for
 the new small-step semantics. However, it is technically more involved since
 the configurations are more complicated. Thats why I switched to the new small-step
 semantics in the "main trunk". I keep this alternative version and the important
 proofs in this theory, so that one can compare both approaches.
 \<close>
 
 
 subsection \<open>Small-Step Computation: \<open>\<Gamma>\<turnstile>(cs, css, s) \<rightarrow> (cs', css', s')\<close>\<close>
 
 type_synonym ('s,'p,'f) continuation = "('s,'p,'f) com list \<times> ('s,'p,'f) com list"
 
 type_synonym ('s,'p,'f) config =
   "('s,'p,'f)com list \<times> ('s,'p,'f)continuation list \<times> ('s,'f) xstate"
 
 
 
 inductive "step"::"[('s,'p,'f) body,('s,'p,'f) config,('s,'p,'f) config] \<Rightarrow> bool"
                                 ("_\<turnstile> (_ \<rightarrow>/ _)" [81,81,81] 100)
   for \<Gamma>::"('s,'p,'f) body"
 where
   Skip: "\<Gamma>\<turnstile>(Skip#cs,css,Normal s) \<rightarrow> (cs,css,Normal s)"
 | Guard: "s\<in>g \<Longrightarrow> \<Gamma>\<turnstile>(Guard f g c#cs,css,Normal s) \<rightarrow> (c#cs,css,Normal s)"
 
 | GuardFault: "s\<notin>g \<Longrightarrow> \<Gamma>\<turnstile>(Guard f g c#cs,css,Normal s) \<rightarrow> (cs,css,Fault f)"
 
 | FaultProp: "\<Gamma>\<turnstile>(c#cs,css,Fault f) \<rightarrow> (cs,css,Fault f)"
 | FaultPropBlock: "\<Gamma>\<turnstile>([],(nrms,abrs)#css,Fault f) \<rightarrow> (nrms,css,Fault f)"
   (* FaultPropBlock: "\<Gamma>\<turnstile>([],cs#css,Fault) \<rightarrow> ([],css,Fault)"*)
 
 | AbruptProp:  "\<Gamma>\<turnstile>(c#cs,css,Abrupt s) \<rightarrow> (cs,css,Abrupt s)"
 
 | ExitBlockNormal:
     "\<Gamma>\<turnstile>([],(nrms,abrs)#css,Normal s) \<rightarrow> (nrms,css,Normal s)"
 | ExitBlockAbrupt:
     "\<Gamma>\<turnstile>([],(nrms,abrs)#css,Abrupt s) \<rightarrow> (abrs,css,Normal s)"
 
 | Basic: "\<Gamma>\<turnstile>(Basic f#cs,css,Normal s) \<rightarrow> (cs,css,Normal (f s))"
 
 | Spec: "(s,t) \<in> r \<Longrightarrow> \<Gamma>\<turnstile>(Spec r#cs,css,Normal s) \<rightarrow> (cs,css,Normal t)"
 | SpecStuck: "\<forall>t. (s,t) \<notin> r \<Longrightarrow> \<Gamma>\<turnstile>(Spec r#cs,css,Normal s) \<rightarrow> (cs,css,Stuck)"
 
 | Seq: "\<Gamma>\<turnstile>(Seq c\<^sub>1 c\<^sub>2#cs,css,Normal s) \<rightarrow> (c\<^sub>1#c\<^sub>2#cs,css,Normal s)"
 
 | CondTrue:  "s\<in>b \<Longrightarrow> \<Gamma>\<turnstile>(Cond b c\<^sub>1 c\<^sub>2#cs,css,Normal s) \<rightarrow> (c\<^sub>1#cs,css,Normal s)"
 | CondFalse: "s\<notin>b \<Longrightarrow> \<Gamma>\<turnstile>(Cond b c\<^sub>1 c\<^sub>2#cs,css,Normal s) \<rightarrow> (c\<^sub>2#cs,css,Normal s)"
 
 | WhileTrue: "\<lbrakk>s\<in>b\<rbrakk>
               \<Longrightarrow>
    \<Gamma>\<turnstile>(While b c#cs,css,Normal s) \<rightarrow> (c#While b c#cs,css,Normal s)"
 | WhileFalse: "\<lbrakk>s\<notin>b\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>(While b c#cs,css,Normal s) \<rightarrow> (cs,css,Normal s)"
 
 | Call: "\<Gamma> p=Some bdy \<Longrightarrow>
          \<Gamma>\<turnstile>(Call p#cs,css,Normal s) \<rightarrow> ([bdy],(cs,Throw#cs)#css,Normal s)"
 
 | CallUndefined: "\<Gamma> p=None \<Longrightarrow>
          \<Gamma>\<turnstile>(Call p#cs,css,Normal s) \<rightarrow> (cs,css,Stuck)"
 
 | StuckProp: "\<Gamma>\<turnstile>(c#cs,css,Stuck) \<rightarrow> (cs,css,Stuck)"
 | StuckPropBlock: "\<Gamma>\<turnstile>([],(nrms,abrs)#css,Stuck) \<rightarrow> (nrms,css,Stuck)"
 
 | DynCom: "\<Gamma>\<turnstile>(DynCom c#cs,css,Normal s) \<rightarrow> (c s#cs,css,Normal s)"
 
 | Throw: "\<Gamma>\<turnstile>(Throw#cs,css,Normal s) \<rightarrow> (cs,css,Abrupt s)"
 | Catch: "\<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2#cs,css,Normal s) \<rightarrow> ([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal s)"
 
 lemmas step_induct = step.induct [of _ "(c,css,s)" "(c',css',s')", split_format (complete),
 case_names
 Skip Guard GuardFault FaultProp FaultPropBlock AbruptProp ExitBlockNormal ExitBlockAbrupt
 Basic Spec SpecStuck Seq CondTrue CondFalse WhileTrue WhileFalse Call CallUndefined
 StuckProp StuckPropBlock DynCom Throw Catch, induct set]
 
 inductive_cases step_elim_cases [cases set]:
  "\<Gamma>\<turnstile>(c#cs,css,Fault f) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],css,Fault f) \<rightarrow> u"
  "\<Gamma>\<turnstile>(c#cs,css,Stuck) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],css,Stuck) \<rightarrow> u"
  "\<Gamma>\<turnstile>(c#cs,css,Abrupt s) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],css,Abrupt s) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Skip#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Guard f g c#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Basic f#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Spec r#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Seq c1 c2#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Cond b c1 c2#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(While b c#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Call p#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(DynCom c#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Throw#cs,css,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Catch c1 c2#cs,css,s) \<rightarrow> u"
 
 inductive_cases step_Normal_elim_cases [cases set]:
  "\<Gamma>\<turnstile>(c#cs,css,Fault f) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],css,Fault f) \<rightarrow> u"
  "\<Gamma>\<turnstile>(c#cs,css,Stuck) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],css,Stuck) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],(nrms,abrs)#css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>([],(nrms,abrs)#css,Abrupt s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Skip#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Guard f g c#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Basic f#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Spec r#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Seq c1 c2#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Cond b c1 c2#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(While b c#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Call p#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(DynCom c#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Throw#cs,css,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Catch c1 c2#cs,css,Normal s) \<rightarrow> u"
 
 abbreviation
  "step_rtrancl" :: "[('s,'p,'f) body,('s,'p,'f) config,('s,'p,'f) config] \<Rightarrow> bool"
                                 ("_\<turnstile> (_ \<rightarrow>\<^sup>*/ _)" [81,81,81] 100)
   where
   "\<Gamma>\<turnstile>cs0 \<rightarrow>\<^sup>* cs1     == (step \<Gamma>)\<^sup>*\<^sup>* cs0 cs1"
 
 abbreviation
 
  "step_trancl" :: "[('s,'p,'f) body,('s,'p,'f) config,('s,'p,'f) config] \<Rightarrow> bool"
                                 ("_\<turnstile> (_ \<rightarrow>\<^sup>+/ _)" [81,81,81] 100)
   where
   "\<Gamma>\<turnstile>cs0 \<rightarrow>\<^sup>+ cs1     == (step \<Gamma>)\<^sup>+\<^sup>+ cs0 cs1"
 
 
 subsubsection \<open>Structural Properties of Small Step Computations\<close>
 
 lemma Fault_app_steps: "\<Gamma>\<turnstile>(cs@xs,css,Fault f) \<rightarrow>\<^sup>* (xs,css,Fault f)"
 proof (induct cs)
   case Nil thus ?case by simp
 next
   case (Cons c cs)
   have "\<Gamma>\<turnstile>(c#cs@xs, css, Fault f) \<rightarrow>\<^sup>* (xs, css, Fault f)"
   proof -
     have "\<Gamma>\<turnstile>(c#cs@xs, css, Fault f) \<rightarrow> (cs@xs, css, Fault f)"
       by (rule step.FaultProp)
     also
     have "\<Gamma>\<turnstile>(cs@xs, css, Fault f) \<rightarrow>\<^sup>* (xs, css, Fault f)"
       by (rule Cons.hyps)
     finally show ?thesis .
   qed
   thus ?case
     by simp
 qed
 
 lemma Stuck_app_steps: "\<Gamma>\<turnstile>(cs@xs,css,Stuck) \<rightarrow>\<^sup>* (xs,css,Stuck)"
 proof (induct cs)
   case Nil thus ?case by simp
 next
   case (Cons c cs)
   have "\<Gamma>\<turnstile>(c#cs@xs, css, Stuck) \<rightarrow>\<^sup>* (xs, css, Stuck)"
   proof -
     have "\<Gamma>\<turnstile>(c#cs@xs, css, Stuck) \<rightarrow> (cs@xs, css, Stuck)"
       by (rule step.StuckProp)
     also
     have "\<Gamma>\<turnstile>(cs@xs, css, Stuck) \<rightarrow>\<^sup>* (xs, css, Stuck)"
       by (rule Cons.hyps)
     finally show ?thesis .
   qed
   thus ?case
     by simp
 qed
 
 text \<open>We can only append commands inside a block, if execution does not
         enter or exit a block.
 \<close>
 lemma app_step:
   assumes step: "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow> (cs',css',t)"
   shows "css=css' \<Longrightarrow> \<Gamma>\<turnstile>(cs@xs,css,s) \<rightarrow> (cs'@xs,css',t)"
 using step
 apply induct
 apply (simp_all del: fun_upd_apply,(blast intro: step.intros)+)
 done
 
 text \<open>We can append whole blocks, without interfering with the actual
         block. Outer blocks do not influence execution of
         inner blocks.\<close>
 lemma app_css_step:
   assumes step: "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow> (cs',css',t)"
   shows "\<Gamma>\<turnstile>(cs,css@xs,s) \<rightarrow> (cs',css'@xs,t)"
 using step
 apply induct
 apply (simp_all del: fun_upd_apply,(blast intro: step.intros)+)
 done
 
 ML \<open>
   ML_Thms.bind_thm ("trancl_induct3", Split_Rule.split_rule @{context}
     (Rule_Insts.read_instantiate @{context}
       [((("a", 0), Position.none), "(ax, ay, az)"),
        ((("b", 0), Position.none), "(bx, by, bz)")] []
       @{thm tranclp_induct}));
 \<close>
 
 lemma app_css_steps:
   assumes step: "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow>\<^sup>+ (cs',css',t)"
   shows "\<Gamma>\<turnstile>(cs,css@xs,s) \<rightarrow>\<^sup>+ (cs',css'@xs,t)"
 apply(rule trancl_induct3 [OF step])
  apply (rule app_css_step [THEN tranclp.r_into_trancl [of "step \<Gamma>"]],assumption)
 apply(blast intro:app_css_step tranclp_trans)
 done
 
 lemma step_Cons':
   assumes step: "\<Gamma>\<turnstile>(ccs,css,s) \<rightarrow> (cs',css',t)"
   shows
   "\<And>c cs. ccs=c#cs \<Longrightarrow> \<exists>css''. css'=css''@css \<and>
       (if css''=[] then \<exists>p. cs'=p@cs
        else (\<exists>pnorm pabr. css''=[(pnorm@cs,pabr@cs)]))"
 using step
 by induct force+
 
 lemma step_Cons:
   assumes step: "\<Gamma>\<turnstile>(c#cs,css,s) \<rightarrow> (cs',css',t)"
   shows "\<exists>pcss. css'=pcss@css \<and>
          (if pcss=[] then \<exists>ps. cs'=ps@cs
           else (\<exists>pcs_normal pcs_abrupt. pcss=[(pcs_normal@cs,pcs_abrupt@cs)]))"
 using step_Cons' [OF step]
 by blast
 
 
 lemma step_Nil':
   assumes step: "\<Gamma>\<turnstile>(cs,asscss,s) \<rightarrow> (cs',css',t)"
   shows
   "\<And>ass. \<lbrakk>cs=[]; asscss=ass@css; ass\<noteq>Nil\<rbrakk> \<Longrightarrow>
           css'=tl ass@css \<and>
           (case s of
              Abrupt s' \<Rightarrow> cs'=snd (hd ass) \<and> t=Normal s'
            |  _ \<Rightarrow> cs'=fst (hd ass) \<and> t=s)"
 using step
 by (induct) (fastforce simp add: neq_Nil_conv)+
 
 lemma step_Nil:
   assumes step: "\<Gamma>\<turnstile>([],ass@css,s) \<rightarrow> (cs',css',t)"
   assumes ass_not_Nil: "ass\<noteq>[]"
   shows "css'=tl ass@css \<and>
           (case s of
              Abrupt s' \<Rightarrow> cs'=snd (hd ass) \<and> t=Normal s'
            |  _ \<Rightarrow> cs'=fst (hd ass) \<and> t=s)"
   using step_Nil' [OF step _ _ ass_not_Nil]
   by simp
 
 lemma step_Nil'':
   assumes step: "\<Gamma>\<turnstile>([],(pcs_normal,pcs_abrupt)#pcss@css,s) \<rightarrow> (cs',pcss@css,t)"
   shows "(case s of
              Abrupt s' \<Rightarrow> cs'=pcs_abrupt \<and> t=Normal s'
            |  _ \<Rightarrow> cs'=pcs_normal \<and> t=s)"
   using step_Nil' [OF step, where ass ="(pcs_normal,pcs_abrupt)#pcss" and css="css"]
   by (auto split: xstate.splits)
 
 lemma drop_suffix_css_step':
 assumes step: "\<Gamma>\<turnstile>(cs,cssxs,s) \<rightarrow> (cs',css'xs,t)"
 shows "\<And>css css' xs. \<lbrakk>cssxs = css@xs; css'xs=css'@xs\<rbrakk>
      \<Longrightarrow> \<Gamma>\<turnstile>(cs,css,s) \<rightarrow> (cs',css',t)"
 using step
 apply induct
 apply (fastforce intro: step.intros)+
 done
 
 lemma drop_suffix_css_step:
 assumes step: "\<Gamma>\<turnstile>(cs,pcss@css,s) \<rightarrow> (cs',pcss'@css,t)"
 shows "\<Gamma>\<turnstile>(cs,pcss,s) \<rightarrow> (cs',pcss',t)"
 using step by (blast intro: drop_suffix_css_step')
 
 lemma drop_suffix_hd_css_step':
   assumes step: "\<Gamma>\<turnstile> (pcs,css,s) \<rightarrow> (cs',css'css,t)"
   shows "\<And>p ps cs pnorm pabr. \<lbrakk>pcs=p#ps@cs; css'css=(pnorm@cs,pabr@cs)#css\<rbrakk>
          \<Longrightarrow> \<Gamma>\<turnstile> (p#ps,css,s) \<rightarrow> (cs',(pnorm,pabr)#css,t)"
 using step
 by induct (force intro: step.intros)+
 
 lemma drop_suffix_hd_css_step'':
   assumes step: "\<Gamma>\<turnstile> (p#ps@cs,css,s) \<rightarrow> (cs',(pnorm@cs,pabr@cs)#css,t)"
   shows  "\<Gamma>\<turnstile> (p#ps,css,s) \<rightarrow> (cs',(pnorm,pabr)#css,t)"
 using drop_suffix_hd_css_step' [OF step]
 by auto
 
 lemma drop_suffix_hd_css_step:
   assumes step: "\<Gamma>\<turnstile> (p#ps@cs,css,s) \<rightarrow> (cs',[(pnorm@ps@cs,pabr@ps@cs)]@css,t)"
   shows  "\<Gamma>\<turnstile> (p#ps,css,s) \<rightarrow> (cs',[(pnorm@ps,pabr@ps)]@css,t)"
 proof -
   from step drop_suffix_hd_css_step'' [of _ p ps cs css s cs' "pnorm@ps" "pabr@ps" t]
   show ?thesis
     by auto
 qed
 
 lemma drop_suffix':
   assumes step: "\<Gamma>\<turnstile>(csxs,css,s) \<rightarrow> (cs'xs,css',t)"
   shows "\<And>xs cs cs'. \<lbrakk>css=css'; csxs=cs@xs; cs'xs = cs'@xs; cs\<noteq>[] \<rbrakk>
          \<Longrightarrow> \<Gamma>\<turnstile>(cs,css,s) \<rightarrow> (cs',css,t)"
 using step
 apply induct
 apply (fastforce intro: step.intros simp add: neq_Nil_conv)+
 done
 
 lemma drop_suffix:
   assumes step: "\<Gamma>\<turnstile>(c#cs@xs,css,s) \<rightarrow> (cs'@xs,css,t)"
   shows "\<Gamma>\<turnstile>(c#cs,css,s) \<rightarrow> (cs',css,t)"
   by(rule drop_suffix' [OF step _ _ _]) auto
 
 lemma drop_suffix_same_css_step:
   assumes step: "\<Gamma>\<turnstile>(cs@xs,css,s) \<rightarrow> (cs'@xs,css,t)"
   assumes not_Nil: "cs\<noteq>[]"
   shows "\<Gamma>\<turnstile>(cs,xss,s) \<rightarrow> (cs',xss,t)"
 proof-
   from drop_suffix' [OF step _ _ _ not_Nil]
   have "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow> (cs',css,t)"
     by auto
   with drop_suffix_css_step [of _ cs "[]" css s cs' "[]" t]
   have "\<Gamma>\<turnstile> (cs, [], s) \<rightarrow> (cs', [], t)"
     by auto
   from app_css_step [OF this]
   show ?thesis
     by auto
 qed
 
 lemma Cons_change_css_step:
   assumes step: "\<Gamma>\<turnstile> (cs,css,s) \<rightarrow> (cs',css'@css,t)"
   shows "\<Gamma>\<turnstile> (cs,xss,s) \<rightarrow> (cs',css'@xss,t)"
 proof -
   from step
     drop_suffix_css_step [where cs=cs and pcss="[]" and css=css and s=s
                              and cs'=cs' and pcss'=css' and t=t]
   have "\<Gamma>\<turnstile> (cs, [], s) \<rightarrow> (cs', css', t)"
     by auto
   from app_css_step [where xs=xss, OF this]
   show ?thesis
     by auto
 qed
 
 lemma Nil_change_css_step:
   assumes step: "\<Gamma>\<turnstile>([],ass@css,s) \<rightarrow> (cs',ass'@css,t)"
   assumes ass_not_Nil: "ass\<noteq>[]"
   shows "\<Gamma>\<turnstile>([],ass@xss,s) \<rightarrow> (cs',ass'@xss,t)"
 proof -
   from step drop_suffix_css_step [of _ "[]" ass css s cs' ass' t]
   have "\<Gamma>\<turnstile> ([], ass, s) \<rightarrow> (cs', ass', t)"
     by auto
   from app_css_step [where xs=xss, OF this]
   show ?thesis
     by auto
 qed
 
 subsubsection \<open>Equivalence between Big and Small-Step Semantics\<close>
 
 lemma exec_impl_steps:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<And>cs css. \<Gamma>\<turnstile>(c#cs,css,s) \<rightarrow>\<^sup>* (cs,css,t)"
 using exec
 proof (induct)
   case Skip thus ?case by (blast intro: step.Skip)
 next
   case Guard thus ?case by (blast intro: step.Guard rtranclp_trans)
 next
   case GuardFault thus ?case by (blast intro: step.GuardFault)
 next
   case FaultProp thus ?case by (blast intro: step.FaultProp)
 next
   case Basic thus ?case by (blast intro: step.Basic)
 next
   case Spec thus ?case by (blast intro: step.Spec)
 next
   case SpecStuck thus ?case by (blast intro: step.SpecStuck)
 next
   case Seq thus ?case by (blast intro: step.Seq rtranclp_trans)
 next
   case CondTrue thus ?case by (blast intro: step.CondTrue rtranclp_trans)
 next
   case CondFalse thus ?case by (blast intro: step.CondFalse rtranclp_trans)
 next
   case WhileTrue thus ?case by (blast intro: step.WhileTrue rtranclp_trans)
 next
   case WhileFalse thus ?case by (blast intro: step.WhileFalse)
 next
   case (Call p bdy s s' cs css)
   have bdy: "\<Gamma> p = Some bdy" by fact
   have steps_body: "\<Gamma>\<turnstile>([bdy],(cs,Throw#cs)#css,Normal s) \<rightarrow>\<^sup>*
                        ([],(cs,Throw#cs)#css, s')" by fact
   show ?case
   proof (cases s')
     case (Normal s'')
     note steps_body
     also from Normal have "\<Gamma>\<turnstile>([],(cs,Throw#cs)#css, s') \<rightarrow> (cs,css,s')"
       by (auto intro: step.intros)
     finally show ?thesis
       using bdy
       by (blast intro: step.Call rtranclp_trans)
   next
     case (Abrupt s'')
     with steps_body
     have "\<Gamma>\<turnstile>([bdy],(cs,Throw#cs)#css,Normal s) \<rightarrow>\<^sup>*
              ([],(cs,Throw#cs)#css, Abrupt s'')" by simp
     also have "\<Gamma>\<turnstile>([],(cs,Throw#cs)#css, Abrupt s'') \<rightarrow> (Throw#cs,css,Normal s'')"
       by (rule ExitBlockAbrupt)
     also have "\<Gamma>\<turnstile>(Throw#cs,css,Normal s'') \<rightarrow> (cs,css,Abrupt s'')"
       by (rule Throw)
     finally show ?thesis
       using bdy Abrupt
       by (auto intro: step.Call rtranclp_trans)
   next
     case Fault
     note steps_body
     also from Fault have "\<Gamma>\<turnstile>([],(cs,Throw#cs)#css, s') \<rightarrow> (cs,css,s')"
       by (auto intro: step.intros)
     finally show ?thesis
       using bdy
       by (blast intro: step.Call rtranclp_trans)
   next
     case Stuck
     note steps_body
     also from Stuck have "\<Gamma>\<turnstile>([],(cs,Throw#cs)#css, s') \<rightarrow> (cs,css,s')"
       by (auto intro: step.intros)
     finally show ?thesis
       using bdy
       by (blast intro: step.Call rtranclp_trans)
   qed
 next
   case (CallUndefined p s cs css)
   have undef: "\<Gamma> p = None" by fact
   hence "\<Gamma>\<turnstile>(Call p # cs, css, Normal s) \<rightarrow> (cs, css, Stuck)"
     by (rule step.CallUndefined)
   thus ?case ..
 next
   case StuckProp thus ?case by (blast intro: step.StuckProp rtrancl_trans)
 next
   case DynCom thus ?case by (blast intro: step.DynCom rtranclp_trans)
 next
    case Throw thus ?case by (blast intro: step.Throw)
 next
   case AbruptProp thus ?case by (blast intro: step.AbruptProp)
 next
   case (CatchMatch c\<^sub>1 s s' c\<^sub>2 s'' cs css)
   have steps_c1: "\<Gamma>\<turnstile>([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal s) \<rightarrow>\<^sup>*
                     ([],(cs,c\<^sub>2#cs)#css,Abrupt s')" by fact
   also
   have "\<Gamma>\<turnstile>([],(cs,c\<^sub>2#cs)#css,Abrupt s') \<rightarrow> (c\<^sub>2#cs,css,Normal s')"
     by (rule ExitBlockAbrupt)
   also
   have steps_c2: "\<Gamma>\<turnstile>(c\<^sub>2#cs,css,Normal s') \<rightarrow>\<^sup>* (cs,css,s'')"  by fact
   finally
   show "\<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2 # cs, css, Normal s) \<rightarrow>\<^sup>* (cs, css, s'')"
     by (blast intro: step.Catch rtranclp_trans)
 next
   case (CatchMiss c\<^sub>1 s s' c\<^sub>2 cs css)
   assume notAbr: "\<not> isAbr s'"
   have steps_c1: "\<Gamma>\<turnstile>([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal s) \<rightarrow>\<^sup>* ([],(cs,c\<^sub>2#cs)#css,s')" by fact
   show "\<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2 # cs, css, Normal s) \<rightarrow>\<^sup>* (cs, css, s')"
   proof (cases s')
     case (Normal w)
     with steps_c1
     have "\<Gamma>\<turnstile>([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal s) \<rightarrow>\<^sup>* ([],(cs,c\<^sub>2#cs)#css,Normal w)"
       by simp
     also
     have "\<Gamma>\<turnstile>([],(cs,c\<^sub>2#cs)#css,Normal w) \<rightarrow> (cs,css,Normal w)"
       by (rule ExitBlockNormal)
     finally show ?thesis using Normal
       by (auto intro: step.Catch rtranclp_trans)
   next
     case Abrupt with notAbr show ?thesis by simp
   next
     case (Fault f)
     with steps_c1
     have "\<Gamma>\<turnstile>([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal s) \<rightarrow>\<^sup>* ([],(cs,c\<^sub>2#cs)#css,Fault f)"
       by simp
     also
     have "\<Gamma>\<turnstile>([],(cs,c\<^sub>2#cs)#css,Fault f) \<rightarrow> (cs,css,Fault f)"
       by (rule FaultPropBlock)
     finally show ?thesis using Fault
       by (auto intro: step.Catch rtranclp_trans)
   next
     case Stuck
     with steps_c1
     have "\<Gamma>\<turnstile>([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal s) \<rightarrow>\<^sup>* ([],(cs,c\<^sub>2#cs)#css,Stuck)"
       by simp
     also
     have "\<Gamma>\<turnstile>([],(cs,c\<^sub>2#cs)#css,Stuck) \<rightarrow> (cs,css,Stuck)"
       by (rule StuckPropBlock)
     finally show ?thesis using Stuck
       by (auto intro: step.Catch rtranclp_trans)
   qed
 qed
 
 
 inductive "execs"::"[('s,'p,'f) body,('s,'p,'f) com list,
                       ('s,'p,'f) continuation list,
                       ('s,'f) xstate,('s,'f) xstate] \<Rightarrow> bool"
                    ("_\<turnstile> \<langle>_,_,_\<rangle> \<Rightarrow> _" [50,50,50,50,50] 50)
   for \<Gamma>:: "('s,'p,'f) body"
 where
   Nil: "\<Gamma>\<turnstile>\<langle>[],[],s\<rangle> \<Rightarrow> s"
 
 | ExitBlockNormal: "\<Gamma>\<turnstile>\<langle>nrms,css,Normal s\<rangle> \<Rightarrow> t
                     \<Longrightarrow>
                     \<Gamma>\<turnstile>\<langle>[],(nrms,abrs)#css,Normal s\<rangle> \<Rightarrow> t"
 
 | ExitBlockAbrupt: "\<Gamma>\<turnstile>\<langle>abrs,css,Normal s\<rangle> \<Rightarrow> t
                     \<Longrightarrow>
                     \<Gamma>\<turnstile>\<langle>[],(nrms,abrs)#css,Abrupt s\<rangle> \<Rightarrow> t"
 
 | ExitBlockFault: "\<Gamma>\<turnstile>\<langle>nrms,css,Fault f\<rangle> \<Rightarrow> t
                     \<Longrightarrow>
                     \<Gamma>\<turnstile>\<langle>[],(nrms,abrs)#css,Fault f\<rangle> \<Rightarrow> t"
 
 | ExitBlockStuck: "\<Gamma>\<turnstile>\<langle>nrms,css,Stuck\<rangle> \<Rightarrow> t
                     \<Longrightarrow>
                     \<Gamma>\<turnstile>\<langle>[],(nrms,abrs)#css,Stuck\<rangle> \<Rightarrow> t"
 
 | Cons: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t; \<Gamma>\<turnstile>\<langle>cs,css,t\<rangle> \<Rightarrow> u\<rbrakk>
          \<Longrightarrow>
          \<Gamma>\<turnstile>\<langle>c#cs,css,s\<rangle> \<Rightarrow> u"
 
 
 inductive_cases execs_elim_cases [cases set]:
  "\<Gamma>\<turnstile>\<langle>[],css,s\<rangle> \<Rightarrow> t"
  "\<Gamma>\<turnstile>\<langle>c#cs,css,s\<rangle> \<Rightarrow> t"
 
 ML \<open>
   ML_Thms.bind_thm ("converse_rtrancl_induct3", Split_Rule.split_rule @{context}
     (Rule_Insts.read_instantiate @{context}
       [((("a", 0), Position.none), "(cs, css, s)"),
        ((("b", 0), Position.none), "(cs', css', t)")] []
       @{thm converse_rtranclp_induct}));
 \<close>
 
 lemma execs_Fault_end:
   assumes execs: "\<Gamma>\<turnstile>\<langle>cs,css,s\<rangle> \<Rightarrow> t" shows "s=Fault f\<Longrightarrow> t=Fault f"
   using execs
   by (induct) (auto dest: Fault_end)
 
 lemma execs_Stuck_end:
   assumes execs: "\<Gamma>\<turnstile>\<langle>cs,css,s\<rangle> \<Rightarrow> t" shows "s=Stuck \<Longrightarrow> t=Stuck"
   using execs
   by (induct) (auto dest: Stuck_end)
 
 
 theorem steps_impl_execs:
   assumes steps: "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow>\<^sup>* ([],[],t)"
   shows "\<Gamma>\<turnstile>\<langle>cs,css,s\<rangle> \<Rightarrow> t"
 using steps
 proof (induct rule: converse_rtrancl_induct3 [consumes 1])
   show "\<Gamma>\<turnstile>\<langle>[],[],t\<rangle> \<Rightarrow> t" by (rule execs.Nil)
 next
   fix cs css s cs' css' w
   assume step: "\<Gamma>\<turnstile>(cs,css, s) \<rightarrow> (cs',css', w)"
   assume execs: "\<Gamma>\<turnstile>\<langle>cs',css',w\<rangle> \<Rightarrow> t"
   from step
   show "\<Gamma>\<turnstile>\<langle>cs,css,s\<rangle> \<Rightarrow> t"
   proof (cases)
     case (Catch c1 c2 cs s)
     with execs obtain t' where
       exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> t'" and
       execs_rest: "\<Gamma>\<turnstile>\<langle>[],(cs, c2 # cs) # css,t'\<rangle> \<Rightarrow> t"
       by (clarsimp elim!: execs_elim_cases)
     have  "\<Gamma>\<turnstile>\<langle>Catch c1 c2 # cs,css,Normal s\<rangle> \<Rightarrow> t"
     proof (cases t')
       case (Normal t'')
       with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> t'"
         by (auto intro: exec.CatchMiss)
       moreover
       from execs_rest Normal have "\<Gamma>\<turnstile>\<langle>cs,css,t'\<rangle> \<Rightarrow> t"
         by (cases) auto
       ultimately show ?thesis
         by (rule execs.Cons)
     next
       case (Abrupt t'')
       from execs_rest Abrupt have "\<Gamma>\<turnstile>\<langle>c2#cs,css,Normal t''\<rangle> \<Rightarrow> t"
         by (cases) auto
       then obtain v where
           exec_c2: "\<Gamma>\<turnstile>\<langle>c2,Normal t''\<rangle> \<Rightarrow> v" and
           rest: "\<Gamma>\<turnstile>\<langle>cs,css,v\<rangle> \<Rightarrow> t"
         by cases
       from exec_c1 Abrupt exec_c2
       have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> v"
         by  - (rule exec.CatchMatch, auto)
       from this rest
       show ?thesis
         by (rule execs.Cons)
     next
       case (Fault f)
       with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec.intros)
       moreover from execs_rest Fault have "\<Gamma>\<turnstile>\<langle>cs,css,Fault f\<rangle> \<Rightarrow> t"
         by (cases) auto
       ultimately show ?thesis
         by (rule execs.Cons)
     next
       case Stuck
       with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> Stuck"
         by (auto intro: exec.intros)
       moreover from execs_rest Stuck have "\<Gamma>\<turnstile>\<langle>cs,css,Stuck\<rangle> \<Rightarrow> t"
         by (cases) auto
       ultimately show ?thesis
         by (rule execs.Cons)
     qed
     with Catch show ?thesis by simp
   next
     case (Call p bdy cs s)
     have bdy: "\<Gamma> p = Some bdy" by fact
     from Call execs obtain t' where
       exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow> t'" and
       execs_rest:
             "\<Gamma>\<turnstile>\<langle>[],(cs,Throw#cs)#css ,t'\<rangle> \<Rightarrow> t"
        by (clarsimp elim!: execs_elim_cases)
     have "\<Gamma>\<turnstile>\<langle>Call p # cs,css,Normal s\<rangle> \<Rightarrow> t"
     proof (cases t')
       case (Normal t'')
       with exec_body bdy
       have "\<Gamma>\<turnstile>\<langle>Call p ,Normal s\<rangle> \<Rightarrow> Normal t''"
         by (auto intro: exec.intros)
       moreover
       from execs_rest Normal
       have "\<Gamma>\<turnstile>\<langle>cs,css ,Normal t''\<rangle> \<Rightarrow> t"
         by cases auto
       ultimately show ?thesis by (rule execs.Cons)
     next
       case (Abrupt t'')
       with exec_body bdy
       have "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> Abrupt t''"
         by (auto intro: exec.intros)
       moreover
       from execs_rest Abrupt have
         "\<Gamma>\<turnstile>\<langle>Throw # cs,css,Normal t''\<rangle> \<Rightarrow> t"
         by (cases) auto
       then obtain v where v: "\<Gamma>\<turnstile>\<langle>Throw,Normal t''\<rangle> \<Rightarrow> v" "\<Gamma>\<turnstile>\<langle>cs,css,v\<rangle> \<Rightarrow> t"
         by (clarsimp elim!: execs_elim_cases)
       moreover from v have "v=Abrupt t''"
         by (auto elim: exec_Normal_elim_cases)
       ultimately
       show ?thesis by (auto intro: execs.Cons)
     next
       case (Fault f)
       with exec_body bdy have "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec.intros)
       moreover from execs_rest Fault have "\<Gamma>\<turnstile>\<langle>cs,css,Fault f\<rangle> \<Rightarrow> t"
         by (cases) (auto elim: execs_elim_cases dest: Fault_end)
       ultimately
       show ?thesis by (rule execs.Cons)
     next
       case Stuck
       with exec_body bdy have "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> Stuck"
         by (auto intro: exec.intros)
       moreover from execs_rest Stuck have "\<Gamma>\<turnstile>\<langle>cs,css,Stuck\<rangle> \<Rightarrow> t"
         by (cases) (auto elim: execs_elim_cases dest: Stuck_end)
       ultimately
       show ?thesis by (rule execs.Cons)
     qed
     with Call show ?thesis by simp
   qed (insert execs,
       (blast intro:execs.intros exec.intros elim!: execs_elim_cases)+)
 qed
 
 theorem steps_impl_exec:
   assumes steps: "\<Gamma>\<turnstile>([c],[],s) \<rightarrow>\<^sup>* ([],[],t)"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 using steps_impl_execs [OF steps]
 by (blast elim: execs_elim_cases)
 
 corollary steps_eq_exec: "\<Gamma>\<turnstile>([c],[],s) \<rightarrow>\<^sup>* ([],[],t) = \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   by (blast intro: steps_impl_exec exec_impl_steps)
 
 
 subsection \<open>Infinite Computations: \<open>inf \<Gamma> cs css s\<close>\<close>
 
 definition inf ::
  "[('s,'p,'f) body,('s,'p,'f) com list,('s,'p,'f) continuation list,('s,'f) xstate]
   \<Rightarrow> bool"
 where "inf \<Gamma> cs css s = (\<exists>f. f 0 = (cs,css,s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f(Suc i)))"
 
 lemma not_infI: "\<lbrakk>\<And>f. \<lbrakk>f 0 = (cs,css,s); \<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)\<rbrakk> \<Longrightarrow> False\<rbrakk>
                 \<Longrightarrow> \<not>inf \<Gamma> cs css s"
   by (auto simp add: inf_def)
 
 subsection \<open>Equivalence of Termination and Absence of Infinite Computations\<close>
 
 
 inductive "terminatess":: "[('s,'p,'f) body,('s,'p,'f) com list,
                             ('s,'p,'f) continuation list,('s,'f) xstate] \<Rightarrow> bool"
                 ("_\<turnstile>_,_ \<Down> _" [60,20,60] 89)
   for  \<Gamma>::"('s,'p,'f) body"
 where
    Nil: "\<Gamma>\<turnstile>[],[]\<Down>s"
 
 |  ExitBlockNormal: "\<Gamma>\<turnstile>nrms,css\<Down>Normal s
                      \<Longrightarrow>
                      \<Gamma>\<turnstile>[],(nrms,abrs)#css\<Down>Normal s"
 
 |  ExitBlockAbrupt: "\<Gamma>\<turnstile>abrs,css\<Down>Normal s
                      \<Longrightarrow>
                      \<Gamma>\<turnstile>[],(nrms,abrs)#css\<Down>Abrupt s"
 
 |  ExitBlockFault: "\<Gamma>\<turnstile>nrms,css\<Down>Fault f
                     \<Longrightarrow>
                     \<Gamma>\<turnstile>[],(nrms,abrs)#css\<Down>Fault f"
 
 |  ExitBlockStuck: "\<Gamma>\<turnstile>nrms,css\<Down>Stuck
                     \<Longrightarrow>
                     \<Gamma>\<turnstile>[],(nrms,abrs)#css\<Down>Stuck"
 
 
 |  Cons: "\<lbrakk>\<Gamma>\<turnstile>c\<down>s; (\<forall>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<longrightarrow> \<Gamma>\<turnstile>cs,css\<Down>t)\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>c#cs,css\<Down>s"
 
 inductive_cases terminatess_elim_cases [cases set]:
  "\<Gamma>\<turnstile>[],css\<Down>t"
  "\<Gamma>\<turnstile>c#cs,css\<Down>t"
 
 lemma terminatess_Fault: "\<And>cs. \<Gamma>\<turnstile>cs,css\<Down>Fault f"
 proof (induct css)
   case Nil
   show "\<Gamma>\<turnstile>cs,[]\<Down>Fault f"
   proof (induct cs)
     case Nil show "\<Gamma>\<turnstile>[],[]\<Down>Fault f" by (rule terminatess.Nil)
   next
     case (Cons c cs)
     thus ?case
       by (auto intro: terminatess.intros terminates.intros dest: Fault_end)
   qed
 next
   case (Cons d css)
   have hyp: "\<And>cs. \<Gamma>\<turnstile>cs,css\<Down>Fault f" by fact
   obtain nrms abrs where d: "d=(nrms,abrs)"  by (cases d) auto
   have "\<Gamma>\<turnstile>cs,(nrms,abrs)#css\<Down>Fault f"
   proof (induct cs)
     case Nil
     show "\<Gamma>\<turnstile>[],(nrms, abrs) # css\<Down>Fault f"
       by (rule terminatess.ExitBlockFault) (rule hyp)
   next
     case (Cons c cs)
     have hyp1: "\<Gamma>\<turnstile>cs,(nrms, abrs) # css\<Down>Fault f" by fact
     show "\<Gamma>\<turnstile>c#cs,(nrms, abrs)#css\<Down>Fault f"
       by (auto intro: hyp1 terminatess.Cons terminates.intros dest: Fault_end)
   qed
   with d show ?case by simp
 qed
 
 lemma terminatess_Stuck: "\<And>cs. \<Gamma>\<turnstile>cs,css\<Down>Stuck"
 proof (induct css)
   case Nil
   show "\<Gamma>\<turnstile>cs,[]\<Down>Stuck"
   proof (induct cs)
     case Nil show "\<Gamma>\<turnstile>[],[]\<Down>Stuck" by (rule terminatess.Nil)
   next
     case (Cons c cs)
     thus ?case
       by (auto intro: terminatess.intros terminates.intros dest: Stuck_end)
   qed
 next
   case (Cons d css)
   have hyp: "\<And>cs. \<Gamma>\<turnstile>cs,css\<Down>Stuck" by fact
   obtain nrms abrs where d: "d=(nrms,abrs)" by (cases d) auto
   have "\<Gamma>\<turnstile>cs,(nrms,abrs)#css\<Down>Stuck"
   proof (induct cs)
     case Nil
     show "\<Gamma>\<turnstile>[],(nrms, abrs) # css\<Down>Stuck"
       by (rule terminatess.ExitBlockStuck) (rule hyp)
   next
     case (Cons c cs)
     have hyp1: "\<Gamma>\<turnstile>cs,(nrms, abrs) # css\<Down>Stuck" by fact
     show "\<Gamma>\<turnstile>c#cs,(nrms, abrs)#css\<Down>Stuck"
       by (auto intro: hyp1 terminatess.Cons terminates.intros dest: Stuck_end)
   qed
   with d show ?case by simp
 qed
 
 
 lemma Basic_terminates: "\<Gamma>\<turnstile>Basic f \<down> t"
   by (cases t) (auto intro: terminates.intros)
 
 lemma step_preserves_terminations:
   assumes step: "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow> (cs',css',t)"
   shows "\<Gamma>\<turnstile>cs,css\<Down>s \<Longrightarrow> \<Gamma>\<turnstile>cs',css'\<Down>t"
 using step
 proof (induct)
   case Skip thus ?case
     by (auto elim: terminates_Normal_elim_cases terminatess_elim_cases
              intro: exec.intros)
 next
   case Guard thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
              intro: terminatess.intros terminates.intros exec.intros)
 next
   case GuardFault thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case FaultProp show ?case by (rule terminatess_Fault)
 next
   case FaultPropBlock show ?case by (rule terminatess_Fault)
 next
   case AbruptProp thus ?case
     by (blast elim: terminatess_elim_cases
               intro: terminatess.intros)
 next
   case ExitBlockNormal thus ?case
     by (blast elim: terminatess_elim_cases
               intro: terminatess.intros )
 next
   case ExitBlockAbrupt thus ?case
     by (blast elim: terminatess_elim_cases
               intro: terminatess.intros )
 next
   case Basic thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case Spec thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case SpecStuck thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case Seq thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case CondTrue thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case CondFalse thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case WhileTrue thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case WhileFalse thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case (Call p bdy cs css s)
   have bdy: "\<Gamma> p = Some bdy" by fact
   from Call obtain
     term_body: "\<Gamma>\<turnstile>bdy \<down> Normal s" and
     term_rest: "\<forall>t. \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> t \<longrightarrow> \<Gamma>\<turnstile>cs,css\<Down>t"
     by (fastforce elim!: terminatess_elim_cases terminates_Normal_elim_cases)
   show "\<Gamma>\<turnstile>[bdy],(cs,Throw # cs)#css\<Down>Normal s"
   proof (rule terminatess.Cons [OF term_body],clarsimp)
     fix t
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow> t"
     show "\<Gamma>\<turnstile>[],(cs,Throw # cs) # css\<Down>t"
     proof (cases t)
       case (Normal t')
       with exec_body bdy
       have "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> Normal t'"
         by (auto intro: exec.intros)
       with term_rest have "\<Gamma>\<turnstile>cs,css\<Down>Normal t'"
         by iprover
       with Normal show ?thesis
         by (auto intro: terminatess.intros terminates.intros
                  elim: exec_Normal_elim_cases)
     next
       case (Abrupt t')
       with exec_body bdy
       have "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> Abrupt t'"
         by (auto intro: exec.intros)
       with term_rest have "\<Gamma>\<turnstile>cs,css\<Down>Abrupt t'"
         by iprover
       with Abrupt show ?thesis
         by (fastforce intro: terminatess.intros terminates.intros
                      elim: exec_Normal_elim_cases)
     next
       case Fault
       thus ?thesis
         by (iprover intro: terminatess_Fault)
     next
       case Stuck
       thus ?thesis
         by (iprover intro: terminatess_Stuck)
     qed
   qed
 next
   case CallUndefined thus ?case
     by (iprover intro: terminatess_Stuck)
 next
   case StuckProp show ?case by (rule terminatess_Stuck)
 next
   case StuckPropBlock show ?case by (rule terminatess_Stuck)
 next
   case DynCom thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case Throw thus ?case
     by (blast elim: terminatess_elim_cases terminates_Normal_elim_cases
               intro: terminatess.intros terminates.intros exec.intros)
 next
   case (Catch c1 c2 cs css s)
   then obtain
     term_c1: "\<Gamma>\<turnstile>c1 \<down> Normal s" and
     term_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> Abrupt s' \<longrightarrow> \<Gamma>\<turnstile>c2 \<down> Normal s'"and
     term_rest: "\<forall>t. \<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> t \<longrightarrow> \<Gamma>\<turnstile>cs,css\<Down>t"
     by (clarsimp elim!: terminatess_elim_cases terminates_Normal_elim_cases)
   show "\<Gamma>\<turnstile>[c1],(cs, c2 # cs) # css\<Down>Normal s"
   proof (rule terminatess.Cons [OF term_c1],clarsimp)
     fix t
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> t"
     show "\<Gamma>\<turnstile>[],(cs, c2 # cs) # css\<Down>t"
     proof (cases t)
       case (Normal t')
       with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> t"
         by (auto intro: exec.intros)
       with term_rest have "\<Gamma>\<turnstile>cs,css\<Down>t"
         by iprover
       with Normal show ?thesis
         by (iprover intro: terminatess.intros)
     next
       case (Abrupt t')
       with exec_c1 term_c2 have "\<Gamma>\<turnstile>c2 \<down> Normal t'"
         by auto
       moreover
       {
         fix w
         assume exec_c2: "\<Gamma>\<turnstile>\<langle>c2,Normal t'\<rangle> \<Rightarrow> w"
         have "\<Gamma>\<turnstile>cs,css\<Down>w"
         proof -
           from exec_c1 Abrupt exec_c2
           have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow> w"
             by (auto intro: exec.intros)
           with term_rest show ?thesis by simp
         qed
       }
       ultimately
       show ?thesis using Abrupt
         by (auto intro: terminatess.intros)
     next
       case Fault thus ?thesis
         by (iprover intro: terminatess_Fault)
     next
       case Stuck thus ?thesis
         by (iprover intro: terminatess_Stuck)
     qed
   qed
 qed
 
 
 ML \<open>
   ML_Thms.bind_thm ("rtrancl_induct3", Split_Rule.split_rule @{context}
     (Rule_Insts.read_instantiate @{context}
       [((("a", 0), Position.none), "(ax, ay, az)"),
        ((("b", 0), Position.none), "(bx, by, bz)")] []
       @{thm rtranclp_induct}));
 \<close>
 
 lemma steps_preserves_terminations:
   assumes steps: "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow>\<^sup>* (cs',css',t)"
   shows "\<Gamma>\<turnstile>cs,css\<Down>s \<Longrightarrow> \<Gamma>\<turnstile>cs',css'\<Down>t"
 using steps
 proof (induct rule: rtrancl_induct3 [consumes 1])
   assume  "\<Gamma>\<turnstile>cs,css\<Down>s" then show "\<Gamma>\<turnstile>cs,css\<Down>s".
 next
   fix cs'' css'' w cs' css' t
   assume "\<Gamma>\<turnstile>(cs'',css'', w) \<rightarrow> (cs',css', t)" "\<Gamma>\<turnstile>cs,css\<Down>s \<Longrightarrow> \<Gamma>\<turnstile>cs'',css''\<Down>w"
          "\<Gamma>\<turnstile>cs,css\<Down>s"
   then show "\<Gamma>\<turnstile>cs',css'\<Down>t"
     by (blast dest: step_preserves_terminations)
 qed
 
 theorem steps_preserves_termination:
   assumes steps: "\<Gamma>\<turnstile>([c],[],s) \<rightarrow>\<^sup>* (c'#cs',css',t)"
   assumes term_c: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<Gamma>\<turnstile>c'\<down>t"
 proof -
   from term_c have "\<Gamma>\<turnstile>[c],[]\<Down>s"
     by (auto intro: terminatess.intros)
   from steps this
   have "\<Gamma>\<turnstile>c'#cs',css'\<Down>t"
     by (rule steps_preserves_terminations)
   thus "\<Gamma>\<turnstile>c'\<down>t"
     by (auto elim: terminatess_elim_cases)
 qed
 
 
 
 
 
 lemma renumber':
   assumes f: "\<forall>i. (a,f i) \<in> r\<^sup>* \<and> (f i,f(Suc i)) \<in> r"
   assumes a_b: "(a,b) \<in> r\<^sup>*"
   shows "b = f 0 \<Longrightarrow> (\<exists>f. f 0 = a \<and> (\<forall>i. (f i, f(Suc i)) \<in> r))"
 using a_b
 proof (induct rule: converse_rtrancl_induct [consumes 1])
   assume "b = f 0"
   with f show "\<exists>f. f 0 = b \<and> (\<forall>i. (f i, f (Suc i)) \<in> r)"
     by blast
 next
   fix a z
   assume a_z: "(a, z) \<in> r" and "(z, b) \<in> r\<^sup>*"
   assume "b = f 0 \<Longrightarrow> \<exists>f. f 0 = z \<and> (\<forall>i. (f i, f (Suc i)) \<in> r)"
          "b = f 0"
   then obtain f where f0: "f 0 = z" and seq: "\<forall>i. (f i, f (Suc i)) \<in> r"
     by iprover
   {
     fix i have "((\<lambda>i. case i of 0 \<Rightarrow> a | Suc i \<Rightarrow> f i) i, f i) \<in> r"
       using seq a_z f0
       by (cases i) auto
   }
   then
   show "\<exists>f. f 0 = a \<and> (\<forall>i. (f i, f (Suc i)) \<in> r)"
     by - (rule exI [where x="\<lambda>i. case i of 0 \<Rightarrow> a | Suc i \<Rightarrow> f i"],simp)
 qed
 
 lemma renumber:
  "\<forall>i. (a,f i) \<in> r\<^sup>* \<and> (f i,f(Suc i)) \<in> r
  \<Longrightarrow> \<exists>f. f 0 = a \<and> (\<forall>i. (f i, f(Suc i)) \<in> r)"
   by(blast dest:renumber')
 
 lemma not_inf_Fault':
   assumes enum_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
   shows "\<And>k cs. f k = (cs,css,Fault m) \<Longrightarrow> False"
 proof (induct css)
   case Nil
   have f_k: "f k = (cs,[],Fault m)" by fact
   have "\<And>k. f k = (cs,[],Fault m) \<Longrightarrow> False"
   proof (induct cs)
     case Nil
     have "f k = ([], [], Fault m)" by fact
     moreover
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     ultimately show "False"
       by (fastforce elim: step_elim_cases)
   next
     case (Cons c cs)
     have fk: "f k = (c # cs, [], Fault m)" by fact
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     with fk have "f (Suc k) = (cs,[],Fault m)"
       by (fastforce elim: step_elim_cases)
     with enum_step Cons.hyps
     show False
       by blast
   qed
   from this f_k show False by blast
 next
   case (Cons ds css)
   then obtain nrms abrs where ds: "ds=(nrms,abrs)" by (cases ds) auto
   have hyp: "\<And>k cs. f k = (cs,css,Fault m) \<Longrightarrow> False" by fact
   have "\<And>k. f k = (cs,(nrms,abrs)#css,Fault m) \<Longrightarrow> False"
   proof (induct cs)
     case Nil
     have fk: "f k = ([], (nrms, abrs) # css, Fault m)" by fact
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     with fk have "f (Suc k) = (nrms,css,Fault m)"
       by (fastforce elim: step_elim_cases)
     thus ?case
       by (rule hyp)
   next
     case (Cons c cs)
     have fk: "f k = (c#cs, (nrms, abrs) # css, Fault m)" by fact
     have hyp1: "\<And>k. f k = (cs, (nrms, abrs) # css, Fault m) \<Longrightarrow> False" by fact
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     with fk have "f (Suc k) = (cs,(nrms,abrs)#css,Fault m)"
       by (fastforce elim: step_elim_cases)
     thus ?case
       by (rule hyp1)
   qed
   with ds Cons.prems show False by auto
 qed
 
 lemma not_inf_Fault:
   "\<not> inf \<Gamma> cs css (Fault m)"
 apply (rule not_infI)
 apply (rule_tac f=f in not_inf_Fault' )
 by auto
 
 lemma not_inf_Stuck':
   assumes enum_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
   shows "\<And>k cs. f k = (cs,css,Stuck) \<Longrightarrow> False"
 proof (induct css)
   case Nil
   have f_k: "f k = (cs,[],Stuck)" by fact
   have "\<And>k. f k = (cs,[],Stuck) \<Longrightarrow> False"
   proof (induct cs)
     case Nil
     have "f k = ([], [], Stuck)" by fact
     moreover
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     ultimately show "False"
       by (fastforce elim: step_elim_cases)
   next
     case (Cons c cs)
     have fk: "f k = (c # cs, [], Stuck)" by fact
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     with fk have "f (Suc k) = (cs,[],Stuck)"
       by (fastforce elim: step_elim_cases)
     with enum_step Cons.hyps
     show False
       by blast
   qed
   from this f_k show False .
 next
   case (Cons ds css)
   then obtain nrms abrs where ds: "ds=(nrms,abrs)" by (cases ds) auto
   have hyp: "\<And>k cs. f k = (cs,css,Stuck) \<Longrightarrow> False" by fact
   have "\<And>k. f k = (cs,(nrms,abrs)#css,Stuck) \<Longrightarrow> False"
   proof (induct cs)
     case Nil
     have fk: "f k = ([], (nrms, abrs) # css, Stuck)" by fact
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     with fk have "f (Suc k) = (nrms,css,Stuck)"
       by (fastforce elim: step_elim_cases)
     thus ?case
       by (rule hyp)
   next
     case (Cons c cs)
     have fk: "f k = (c#cs, (nrms, abrs) # css, Stuck)" by fact
     have hyp1: "\<And>k. f k = (cs, (nrms, abrs) # css, Stuck) \<Longrightarrow> False" by fact
     from enum_step have "\<Gamma>\<turnstile>f k \<rightarrow> f (Suc k)"..
     with fk have "f (Suc k) = (cs,(nrms,abrs)#css,Stuck)"
       by (fastforce elim: step_elim_cases)
     thus ?case
       by (rule hyp1)
   qed
   with ds Cons.prems show False by auto
 qed
 
 lemma not_inf_Stuck:
   "\<not> inf \<Gamma> cs css Stuck"
 apply (rule not_infI)
 apply (rule_tac f=f in not_inf_Stuck')
 by auto
 
 lemma last_butlast_app:
 assumes butlast: "butlast as = xs @ butlast bs"
 assumes not_Nil: "bs \<noteq> []" "as \<noteq> []"
 assumes last: "fst (last as) = fst (last bs)" "snd (last as) = snd (last bs)"
 shows "as = xs @ bs"
 proof -
   from last have "last as = last bs"
     by (cases "last as",cases "last bs") simp
   moreover
   from not_Nil have "as = butlast as @ [last as]" "bs = butlast bs @ [last bs]"
     by auto
   ultimately show ?thesis
     using butlast
     by simp
 qed
 
 
 lemma last_butlast_tl:
 assumes butlast: "butlast bs = x # butlast as"
 assumes not_Nil: "bs \<noteq> []" "as \<noteq> []"
 assumes last: "fst (last as) = fst (last bs)" "snd (last as) = snd (last bs)"
 shows "as = tl bs"
 proof -
   from last have "last as = last bs"
     by (cases "last as",cases "last bs") simp
   moreover
   from not_Nil have "as = butlast as @ [last as]" "bs = butlast bs @ [last bs]"
     by auto
   ultimately show ?thesis
     using butlast
     by simp
 qed
 
 locale inf =
 fixes CS:: "('s,'p,'f) config \<Rightarrow> ('s, 'p,'f) com list"
   and CSS:: "('s,'p,'f) config \<Rightarrow> ('s, 'p,'f) continuation list"
   and S:: "('s,'p,'f) config \<Rightarrow> ('s,'f) xstate"
   defines CS_def : "CS \<equiv> fst"
   defines CSS_def : "CSS \<equiv> \<lambda>c. fst (snd c)"
   defines S_def: "S \<equiv> \<lambda>c. snd (snd c)"
 
 lemma (in inf) steps_hd_drop_suffix:
 assumes f_0: "f 0 = (c#cs,css,s)"
 assumes f_step: "\<forall>i. \<Gamma>\<turnstile> f(i) \<rightarrow> f(Suc i)"
 assumes not_finished: "\<forall>i < k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)"
 assumes simul: "\<forall>i\<le>k.
         (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
                  else CS (f i)=pcs i \<and>
                       CSS (f i)= butlast (pcss i)@
                               [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                               css)"
 defines "p\<equiv>\<lambda>i. (pcs i, pcss i, S (f i))"
 shows "\<forall>i<k. \<Gamma>\<turnstile> p i \<rightarrow> p (Suc i)"
 using not_finished simul
 proof (induct k)
   case 0
   thus ?case by simp
 next
   case (Suc k)
   have simul: "\<forall>i\<le>Suc k.
         (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
                  else CS (f i)=pcs i \<and>
                       CSS (f i)= butlast (pcss i)@
                               [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                               css)" by fact
   have not_finished': "\<forall>i < Suc k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)" by fact
   with simul
   have not_finished: "\<forall>i<Suc k. \<not> (pcs i = [] \<and> pcss i = [])"
     by (auto simp add: CS_def CSS_def S_def split: if_split_asm)
   show ?case
   proof (clarify)
     fix i
     assume i_le_Suc_k: "i < Suc k"
     show "\<Gamma>\<turnstile> p i \<rightarrow> p (Suc i)"
     proof (cases "i < k")
       case True
       with not_finished' simul Suc.hyps
       show ?thesis
         by auto
     next
       case False
       with i_le_Suc_k
       have eq_i_k: "i=k"
         by simp
       show "\<Gamma>\<turnstile>p i \<rightarrow> p (Suc i)"
       proof -
         obtain cs' css' t' where
           f_Suc_i: "f (Suc i) = (cs', css', t')"
           by (cases "f (Suc i)")
         obtain cs'' css'' t'' where
           f_i: "f i = (cs'',css'',t'')"
           by (cases "f i")
         from not_finished eq_i_k
         have pcs_pcss_not_Nil: "\<not> (pcs i = [] \<and> pcss i = [])"
           by auto
         from simul [rule_format, of i] i_le_Suc_k f_i
         have pcs_pcss_i:
           "if pcss i = [] then css''=css \<and> cs''=pcs i@cs
            else cs''=pcs i \<and>
            css''= butlast (pcss i)@
                        [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                        css"
           by (simp add: CS_def CSS_def S_def cong: if_cong)
         from simul [rule_format, of "Suc i"] i_le_Suc_k f_Suc_i
         have pcs_pcss_Suc_i:
         "if pcss (Suc i) = [] then css' = css \<and> cs' = pcs (Suc i) @ cs
          else cs' = pcs (Suc i) \<and>
               css' = butlast (pcss (Suc i)) @
                [(fst (last (pcss (Suc i))) @ cs, snd (last (pcss (Suc i))) @ cs)] @
                css"
           by (simp add: CS_def CSS_def S_def cong: if_cong)
         show ?thesis
         proof (cases "pcss i = []")
           case True
           note pcss_Nil = this
           with pcs_pcss_i pcs_pcss_not_Nil obtain p ps where
             pcs_i: "pcs i = p#ps" and
             css'': "css''=css" and
             cs'': "cs''=(p#ps)@cs"
             by (auto simp add: neq_Nil_conv)
           with f_i have "f i = (p#(ps@cs),css,t'')"
             by simp
           with f_Suc_i f_step [rule_format, of i]
           have step_css: "\<Gamma>\<turnstile> (p#(ps@cs),css,t'') \<rightarrow> (cs',css',t')"
             by simp
           from step_Cons' [OF this, of p "ps@cs"]
           obtain css''' where
             css''': "css' = css''' @ css"
             "if css''' = [] then \<exists>p. cs' = p @ ps @ cs
             else (\<exists>pnorm pabr. css'''=[(pnorm @ ps @ cs,pabr @ ps @ cs)])"
             by auto
           show ?thesis
           proof (cases "css''' = []")
             case True
             with css'''
             obtain p' where
               css': "css' = css" and
               cs': "cs' = p' @ ps @ cs"
               by auto
                 (*from cs' css' f_Suc_i f_i [rule_format, of "Suc k"]
                 have p_ps_not_Nil: "p'@ps \<noteq> Nil"
                 by auto*)
             from css' cs' step_css
             have step: "\<Gamma>\<turnstile> (p#(ps@cs),css,t'') \<rightarrow> (p'@ps@cs,css,t')"
               by simp
             hence "\<Gamma>\<turnstile> ((p#ps)@cs,css,t'') \<rightarrow> ((p'@ps)@cs,css,t')"
               by simp
             from drop_suffix_css_step' [OF drop_suffix_same_css_step [OF this],
               where xs="css" and css="[]" and css'="[]"]
             have  "\<Gamma>\<turnstile> (p#ps,[],t'') \<rightarrow> (p'@ps,[],t')"
               by simp
             moreover
             from css' cs' pcs_pcss_Suc_i
             obtain "pcs (Suc i) = p'@ps" and "pcss (Suc i) = []"
               by (simp split: if_split_asm)
             ultimately show ?thesis
               using pcs_i pcss_Nil f_i f_Suc_i
               by (simp add: CS_def CSS_def S_def p_def)
           next
             case False
             with css'''
             obtain pnorm pabr where
               css': "css'=css'''@css"
               "css'''=[(pnorm @ ps @ cs,pabr @ ps @ cs)]"
               by auto
             with css''' step_css
             have "\<Gamma>\<turnstile> (p#ps@cs,css,t'') \<rightarrow> (cs',[(pnorm@ps@cs,pabr@ps@cs)]@css,t')"
               by simp
             then
             have "\<Gamma>\<turnstile>(p#ps, css, t'') \<rightarrow> (cs', [(pnorm@ps, pabr@ps)] @ css, t')"
               by (rule drop_suffix_hd_css_step)
             from drop_suffix_css_step' [OF this,
               where css="[]" and xs="css" and css'="[(pnorm@ps, pabr@ps)]"]
             have "\<Gamma>\<turnstile> (p#ps,[],t'') \<rightarrow> (cs',[(pnorm@ps, pabr@ps)],t')"
               by simp
             moreover
             from css' pcs_pcss_Suc_i
             obtain "pcs (Suc i) = cs'" "pcss (Suc i) = [(pnorm@ps, pabr@ps)]"
               apply (cases "pcss (Suc i)")
               apply (auto split: if_split_asm)
               done
             ultimately show ?thesis
               using pcs_i pcss_Nil f_i f_Suc_i
               by (simp add: p_def CS_def CSS_def S_def)
           qed
         next
           case False
           note pcss_i_not_Nil = this
           with pcs_pcss_i obtain
             cs'': "cs''=pcs i" and
             css'': "css''= butlast (pcss i)@
                             [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                             css"
             by auto
           from f_Suc_i f_i f_step [rule_format, of i]
           have step_i_full: "\<Gamma>\<turnstile> (cs'',css'',t'') \<rightarrow> (cs',css',t')"
             by simp
           show ?thesis
           proof (cases cs'')
             case (Cons c' cs)
             with step_Cons' [OF step_i_full]
             obtain css''' where css': "css' = css'''@css''"
               by auto
             with step_i_full
             have "\<Gamma>\<turnstile> (cs'',css'',t'') \<rightarrow> (cs',css'''@css'',t')"
               by simp
             from Cons_change_css_step [OF this, where xss="pcss i"] Cons cs''
             have "\<Gamma>\<turnstile> (pcs i, pcss i,t'') \<rightarrow> (cs',css'''@pcss i,t')"
               by simp
             moreover
             from cs'' css'' css' False pcs_pcss_Suc_i
             obtain "pcs (Suc i) = cs'" "pcss (Suc i) = css'''@pcss i"
               apply (auto  split: if_split_asm)
               apply (drule (4) last_butlast_app)
               by simp
             ultimately show ?thesis
               using f_i f_Suc_i
               by (simp add: p_def CS_def CSS_def S_def)
           next
             case Nil
             note cs''_Nil = this
             show ?thesis
             proof (cases "butlast (pcss i)")
               case (Cons bpcs bpcss)
               with cs''_Nil step_i_full css''
               have *: "\<Gamma>\<turnstile> ([],[hd css'']@tl css'',t'') \<rightarrow> (cs',css',t')"
                 by simp
               moreover
               from step_Nil [OF *]
               have css': "css'=tl css''"
                 by simp
               ultimately have
                 step_i_full: "\<Gamma>\<turnstile> ([],[hd css'']@tl css'',t'') \<rightarrow> (cs',tl css'',t')"
                 by simp
               from css'' Cons pcss_i_not_Nil
               have "hd css'' = hd (pcss i)"
                 by (auto simp add: neq_Nil_conv split: if_split_asm)
               with cs'' cs''_Nil
                 Nil_change_css_step [where ass="[hd css'']" and
                 css="tl css''" and ass'="[]" and
                 xss="tl (pcss i)", simplified, OF step_i_full [simplified]]
               have "\<Gamma>\<turnstile> (pcs i,[hd (pcss i)]@tl (pcss i),t'') \<rightarrow> (cs',tl (pcss i),t')"
                 by simp
               with pcss_i_not_Nil
               have "\<Gamma>\<turnstile> (pcs i,pcss i,t'') \<rightarrow> (cs',tl (pcss i),t')"
                 by simp
               moreover
               from css' css'' cs''_Nil Cons pcss_i_not_Nil pcs_pcss_Suc_i
               obtain "pcs (Suc i) = cs'" "pcss (Suc i) = tl (pcss i)"
                 apply (clarsimp  split: if_split_asm)
                 apply (drule (4) last_butlast_tl)
                 by simp
               ultimately show ?thesis
                 using f_i f_Suc_i
                 by (simp add: p_def CS_def CSS_def S_def)
             next
               case Nil
               with css'' pcss_i_not_Nil
               obtain pnorm pabr
                 where css'': "css''= [(pnorm@cs,pabr@cs)]@css" and
                 pcss_i: "pcss i = [(pnorm,pabr)]"
                 by (force simp add: neq_Nil_conv split: if_split_asm)
               with cs''_Nil step_i_full
               have "\<Gamma>\<turnstile>([],[(pnorm@cs,pabr@cs)]@css,t'') \<rightarrow> (cs',css',t')"
                 by simp
               from step_Nil [OF this]
               obtain
                 css': "css'=css" and
                 cs': "(case t'' of
                          Abrupt s' \<Rightarrow> cs' = pabr @ cs \<and> t' = Normal s'
                        | _ \<Rightarrow> cs' = pnorm @ cs \<and> t' = t'')"
                 by (simp cong: xstate.case_cong)
               let "?pcs_Suc_i " = "(case t'' of Abrupt s' \<Rightarrow> pabr | _ \<Rightarrow> pnorm)"
               from cs'
               have "\<Gamma>\<turnstile>([],[(pnorm,pabr)],t'') \<rightarrow> (?pcs_Suc_i,[],t')"
                 by (auto intro: step.intros split: xstate.splits)
               moreover
               from css'' css' cs' pcss_i pcs_pcss_Suc_i
               obtain "pcs (Suc i) = ?pcs_Suc_i" "pcss (Suc i) = []"
                 by (simp split: if_split_asm xstate.splits)
               ultimately
               show ?thesis
                 using pcss_i cs'' cs''_Nil f_i f_Suc_i
                 by (simp add: p_def CS_def CSS_def S_def)
             qed
           qed
         qed
       qed
     qed
   qed
 qed
 
 lemma k_steps_to_rtrancl:
   assumes steps: "\<forall>i<k. \<Gamma>\<turnstile> p i \<rightarrow> p (Suc i)"
   shows "\<Gamma>\<turnstile>p 0\<rightarrow>\<^sup>* p k"
 using steps
 proof (induct k)
   case 0 thus ?case by auto
 next
   case (Suc k)
   have "\<forall>i<Suc k. \<Gamma>\<turnstile> p i \<rightarrow> p (Suc i)" by fact
   then obtain
   step_le_k: "\<forall>i<k. \<Gamma>\<turnstile> p i \<rightarrow> p (Suc i)" and step_k: "\<Gamma>\<turnstile> p k \<rightarrow> p (Suc k)"
     by auto
   from Suc.hyps [OF step_le_k]
   have "\<Gamma>\<turnstile> p 0 \<rightarrow>\<^sup>* p k".
   also note step_k
   finally show ?case .
 qed
 
 
 
 lemma (in inf) steps_hd_drop_suffix_finite:
 assumes f_0: "f 0 = (c#cs,css,s)"
 assumes f_step: "\<forall>i. \<Gamma>\<turnstile> f(i) \<rightarrow> f(Suc i)"
 assumes not_finished: "\<forall>i < k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)"
 assumes simul: "\<forall>i\<le>k.
         (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
                  else CS (f i)=pcs i \<and>
                       CSS (f i)= butlast (pcss i)@
                               [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                               css)"
 shows "\<Gamma>\<turnstile>([c],[],s) \<rightarrow>\<^sup>* (pcs k, pcss k, S (f k))"
 proof -
   from steps_hd_drop_suffix [OF f_0 f_step not_finished simul]
   have "\<forall>i<k. \<Gamma>\<turnstile> (pcs i, pcss i, S (f i)) \<rightarrow>
                   (pcs (Suc i), pcss (Suc i), S (f (Suc i)))".
   from k_steps_to_rtrancl [OF this]
   have "\<Gamma>\<turnstile> (pcs 0, pcss 0, S (f 0)) \<rightarrow>\<^sup>* (pcs k, pcss k, S (f k))".
   moreover from f_0 simul [rule_format, of 0]
   have "(pcs 0, pcss 0, S (f 0)) = ([c],[],s)"
     by (auto split: if_split_asm simp add: CS_def CSS_def S_def)
   ultimately show ?thesis by simp
 qed
 
 lemma (in inf) steps_hd_drop_suffix_infinite:
 assumes f_0: "f 0 = (c#cs,css,s)"
 assumes f_step: "\<forall>i. \<Gamma>\<turnstile> f(i) \<rightarrow> f(Suc i)"
 assumes not_finished: "\<forall>i. \<not> (CS (f i) = cs \<and> CSS (f i) = css)"
 (*assumes not_finished: "\<forall>i. \<not> (pcs i = [] \<and> pcss i = [])"*)
 assumes simul: "\<forall>i.
         (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
                  else CS (f i)=pcs i \<and>
                       CSS (f i)= butlast (pcss i)@
                               [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                               css)"
 defines "p\<equiv>\<lambda>i. (pcs i, pcss i, S (f i))"
 shows "\<Gamma>\<turnstile> p i \<rightarrow> p (Suc i)"
 proof -
   from steps_hd_drop_suffix [OF f_0 f_step, of "Suc i" pcss pcs] not_finished simul
   show ?thesis
     by (auto simp add: p_def)
 qed
 
 lemma (in inf) steps_hd_progress:
 assumes f_0: "f 0 = (c#cs,css,s)"
 assumes f_step: "\<forall>i. \<Gamma>\<turnstile> f(i) \<rightarrow> f(Suc i)"
 assumes c_unfinished: "\<forall>i < k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)"
 shows "\<forall>i \<le> k. (\<exists>pcs pcss.
           (if pcss = [] then CSS (f i)=css \<and> CS (f i)=pcs@cs
            else CS (f i)=pcs  \<and>
                 CSS (f i)= butlast pcss@
                            [(fst (last pcss)@cs,(snd (last pcss))@cs)]@
                            css))"
 using c_unfinished
 proof (induct k)
   case 0
   with f_0 show ?case
     by (simp add: CSS_def CS_def)
 next
   case (Suc k)
   have c_unfinished: "\<forall>i<Suc k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)" by fact
   hence c_unfinished': "\<forall>i< k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)" by simp
   show ?case
   proof (clarify)
     fix i
     assume i_le_Suc_k: "i \<le> Suc k"
     show "\<exists>pcs pcss.
           (if pcss = [] then CSS (f i)=css \<and> CS (f i)=pcs@cs
            else CS (f i)=pcs  \<and>
                 CSS (f i)= butlast pcss@
                            [(fst (last pcss)@cs,(snd (last pcss))@cs)]@
                            css)"
     proof (cases "i < Suc k")
       case True
       with Suc.hyps [OF c_unfinished', rule_format, of i] c_unfinished
       show ?thesis
         by auto
     next
       case False
       with i_le_Suc_k have eq_i_Suc_k: "i=Suc k"
         by auto
       obtain cs' css' t' where
         f_Suc_k: "f (Suc k) = (cs', css', t')"
         by (cases "f (Suc k)")
       obtain cs'' css'' t'' where
         f_k: "f k = (cs'',css'',t'')"
         by (cases "f k")
       with Suc.hyps [OF c_unfinished',rule_format, of k]
       obtain pcs pcss where
         pcs_pcss_k:
         "if pcss = [] then css'' = css \<and> cs'' = pcs @ cs
          else cs'' = pcs \<and>
               css'' = butlast pcss @
                            [(fst (last pcss) @ cs, snd (last pcss) @ cs)] @
                            css"
         by (auto simp add: CSS_def CS_def cong: if_cong)
       from c_unfinished [rule_format, of k] f_k pcs_pcss_k
       have pcs_pcss_empty: "\<not> (pcs = [] \<and> pcss = [])"
         by (auto simp add: CS_def CSS_def S_def split: if_split_asm)
       show ?thesis
       proof (cases "pcss = []")
         case True
         note pcss_Nil = this
         with pcs_pcss_k pcs_pcss_empty obtain p ps where
           pcs_i: "pcs = p#ps" and
           css'': "css''=css" and
           cs'': "cs''=(p#ps)@cs"
           by (cases "pcs") auto
         with f_k have "f k = (p#(ps@cs),css,t'')"
           by simp
         with f_Suc_k f_step [rule_format, of k]
         have step_css: "\<Gamma>\<turnstile> (p#(ps@cs),css,t'') \<rightarrow> (cs',css',t')"
           by simp
         from step_Cons' [OF this, of p "ps@cs"]
         obtain css''' where
           css''': "css' = css''' @ css"
           "if css''' = [] then \<exists>p. cs' = p @ ps @ cs
           else (\<exists>pnorm pabr. css'''=[(pnorm @ ps @ cs,pabr @ ps @ cs)])"
           by auto
         show ?thesis
         proof (cases "css''' = []")
           case True
           with css'''
           obtain p' where
             css': "css' = css" and
             cs': "cs' = p' @ ps @ cs"
             by auto
           from css' cs' f_Suc_k
           show ?thesis
             apply (rule_tac x="p'@ps" in exI)
             apply (rule_tac x="[]" in exI)
             apply (simp add: CSS_def CS_def eq_i_Suc_k)
             done
         next
           case False
           with css'''
           obtain pnorm pabr where
             css': "css'=css'''@css"
             "css'''=[(pnorm @ ps @ cs,pabr @ ps @ cs)]"
             by auto
           with f_Suc_k eq_i_Suc_k
           show ?thesis
             apply (rule_tac x="cs'" in exI)
             apply (rule_tac x="[(pnorm@ps, pabr@ps)]" in exI)
             by (simp add: CSS_def CS_def)
         qed
       next
         case False
         note pcss_k_not_Nil = this
         with pcs_pcss_k obtain
           cs'': "cs''=pcs" and
           css'': "css''= butlast pcss@
                            [(fst (last pcss)@cs,(snd (last pcss))@cs)]@
                            css"
           by auto
         from f_Suc_k f_k f_step [rule_format, of k]
         have step_i_full: "\<Gamma>\<turnstile> (cs'',css'',t'') \<rightarrow> (cs',css',t')"
           by simp
         show ?thesis
         proof (cases cs'')
           case (Cons c' cs)
           with step_Cons' [OF step_i_full]
           obtain css''' where css': "css' = css'''@css''"
             by auto
           with cs'' css'' f_Suc_k eq_i_Suc_k pcss_k_not_Nil
           show ?thesis
             apply (rule_tac x="cs'" in exI)
             apply (rule_tac x="css'''@pcss" in exI)
             by (clarsimp simp add: CSS_def CS_def butlast_append)
         next
           case Nil
           note cs''_Nil = this
           show ?thesis
           proof (cases "butlast pcss")
             case (Cons bpcs bpcss)
             with cs''_Nil step_i_full css''
             have *: "\<Gamma>\<turnstile> ([],[hd css'']@tl css'',t'') \<rightarrow> (cs',css',t')"
               by simp
             moreover
             from step_Nil [OF *]
             obtain css': "css'=tl css''" and
                    cs': "cs' = (case t'' of Abrupt s' \<Rightarrow> snd (hd css'')
                                  | _ \<Rightarrow> fst (hd css''))"
               by (auto split: xstate.splits)
             from css'' Cons pcss_k_not_Nil
             have "hd css'' = hd pcss"
               by (auto simp add: neq_Nil_conv split: if_split_asm)
             with css' cs' css'' cs''_Nil Cons pcss_k_not_Nil f_Suc_k eq_i_Suc_k
             show ?thesis
               apply (rule_tac x="cs'" in exI)
               apply (rule_tac x="tl pcss" in exI)
               apply (clarsimp split: xstate.splits
                        simp add: CS_def CSS_def neq_Nil_conv split: if_split_asm)
               done
           next
             case Nil
             with css'' pcss_k_not_Nil
             obtain pnorm pabr
               where css'': "css''= [(pnorm@cs,pabr@cs)]@css" and
               pcss_k: "pcss = [(pnorm,pabr)]"
               by (force simp add: neq_Nil_conv split: if_split_asm)
             with cs''_Nil step_i_full
             have "\<Gamma>\<turnstile>([],[(pnorm@cs,pabr@cs)]@css,t'') \<rightarrow> (cs',css',t')"
               by simp
             from step_Nil [OF this]
             obtain
               css': "css'=css" and
               cs': "(case t'' of
               Abrupt s' \<Rightarrow> cs' = pabr @ cs \<and> t' = Normal s'
               | _ \<Rightarrow> cs' = pnorm @ cs \<and> t' = t'')"
               by (simp cong: xstate.case_cong)
             let "?pcs_Suc_k " = "(case t'' of Abrupt s' \<Rightarrow> pabr | _ \<Rightarrow> pnorm)"
             from css'' css' cs' pcss_k f_Suc_k eq_i_Suc_k
             show ?thesis
               apply (rule_tac x="?pcs_Suc_k" in exI)
               apply (rule_tac x="[]" in exI)
               apply (simp split: xstate.splits add: CS_def CSS_def)
               done
           qed
         qed
       qed
     qed
   qed
 qed
 
 lemma (in inf) inf_progress:
 assumes f_0: "f 0 = (c#cs,css,s)"
 assumes f_step: "\<forall>i. \<Gamma>\<turnstile> f(i) \<rightarrow> f(Suc i)"
 assumes unfinished: "\<forall>i. \<not> ((CS (f i) = cs) \<and> (CSS (f i) = css))"
 shows "\<exists>pcs pcss.
           (if pcss = [] then CSS (f i)=css \<and> CS (f i)=pcs@cs
            else CS (f i)=pcs  \<and>
                 CSS (f i)= butlast pcss@
                            [(fst (last pcss)@cs,(snd (last pcss))@cs)]@
                            css)"
 proof -
   from steps_hd_progress [OF f_0 f_step, of "i"] unfinished
   show ?thesis
     by auto
 qed
 
 lemma skolemize1: "\<forall>x. P x \<longrightarrow> (\<exists>y. Q x y) \<Longrightarrow> \<exists>f.\<forall>x. P x \<longrightarrow> Q x (f x)"
   by (rule choice) blast
 
 lemma skolemize2: "\<forall>x. P x \<longrightarrow> (\<exists>y z. Q x y z) \<Longrightarrow> \<exists>f g.\<forall>x. P x \<longrightarrow> Q x (f x) (g x)"
 apply (drule skolemize1)
 apply (erule exE)
 apply (drule skolemize1)
 apply fast
 done
 
 lemma skolemize2': "\<forall>x.\<exists>y z. P x y z \<Longrightarrow> \<exists>f g.\<forall>x. P x (f x) (g x)"
 apply (drule choice)
 apply (erule exE)
 apply (drule choice)
 apply fast
 done
 
 theorem (in inf) inf_cases:
   fixes c::"('s,'p,'f) com"
   assumes inf: "inf \<Gamma> (c#cs) css s"
   shows "inf \<Gamma> [c] [] s \<or> (\<exists>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<and> inf \<Gamma> cs css t)"
 proof -
   from inf obtain f where
     f_0: "f 0 = (c#cs,css,s)" and
     f_step: "(\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i))"
     by (auto simp add: inf_def)
   show ?thesis
   proof (cases "\<exists>i. CS (f i) = cs \<and> CSS (f i) = css")
     case True
     define k where "k = (LEAST i. CS (f i) = cs \<and> CSS (f i) = css)"
     from True
     obtain CS_f_k: "CS (f k) = cs" and CSS_f_k: "CSS (f k) = css"
       apply -
       apply (erule exE)
       apply (drule LeastI)
       apply (simp add: k_def)
       done
     have less_k_prop: "\<forall>i<k. \<not> (CS (f i) = cs \<and> CSS (f i) = css)"
       apply (intro allI impI)
       apply (unfold k_def)
       apply (drule not_less_Least)
       apply simp
       done
     have "\<Gamma>\<turnstile>([c], [], s) \<rightarrow>\<^sup>* ([],[],S (f k))"
     proof -
       have "\<forall>i\<le>k. \<exists>pcs pcss.
         (if pcss = [] then CSS (f i)=css \<and> CS (f i)=pcs@cs
            else CS (f i)=pcs  \<and>
                 CSS (f i)= butlast pcss@
                            [(fst (last pcss)@cs,(snd (last pcss))@cs)]@
                            css)"
         by (rule steps_hd_progress
         [OF f_0 f_step, where k=k, OF less_k_prop])
       from skolemize2 [OF this] obtain pcs pcss where
         pcs_pcss:
             "\<forall>i\<le>k.
                (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
                 else CS (f i)=pcs i \<and>
                      CSS (f i)= butlast (pcss i)@
                            [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                            css)"
         by iprover
       from pcs_pcss [rule_format, of k] CS_f_k CSS_f_k
       have finished: "pcs k = []" "pcss k = []"
         by (auto simp add: CS_def CSS_def S_def split: if_split_asm)
       from pcs_pcss
       have simul: "\<forall>i\<le>k. (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
                    else CS (f i)=pcs i \<and>
                      CSS (f i)= butlast (pcss i)@
                            [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                             css)"
         by auto
       from steps_hd_drop_suffix_finite [OF f_0 f_step less_k_prop simul] finished
       show ?thesis
         by simp
     qed
     hence "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> S (f k)"
       by (rule steps_impl_exec)
     moreover
     from CS_f_k CSS_f_k f_step
     have "inf \<Gamma> cs css (S (f k))"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (i + k)" in exI)
       apply simp
       apply (auto simp add: CS_def CSS_def S_def)
       done
     ultimately
     have "(\<exists>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<and> inf \<Gamma> cs css t)"
       by blast
     thus ?thesis
       by simp
   next
     case False
     hence unfinished: "\<forall>i. \<not> ((CS (f i) = cs) \<and> (CSS (f i) = css))"
       by simp
     from inf_progress [OF f_0 f_step this]
     have "\<forall>i. \<exists>pcs pcss.
           (if pcss = [] then CSS (f i)=css \<and> CS (f i)=pcs@cs
            else CS (f i)=pcs  \<and>
                 CSS (f i)= butlast pcss@
                            [(fst (last pcss)@cs,(snd (last pcss))@cs)]@
                            css)"
       by auto
     from skolemize2' [OF this] obtain pcs pcss where
       pcs_pcss: "\<forall>i.
           (if pcss i = [] then CSS (f i)=css \<and> CS (f i)=pcs i@cs
            else CS (f i)=pcs i  \<and>
                 CSS (f i)= butlast (pcss i)@
                            [(fst (last (pcss i))@cs,(snd (last (pcss i)))@cs)]@
                            css)"
       by iprover
     define g where "g i = (pcs i, pcss i, S (f i))" for i
     from pcs_pcss [rule_format, of 0] f_0
     have "g 0 = ([c],[],s)"
       by (auto split: if_split_asm simp add: CS_def CSS_def S_def g_def)
     moreover
     from steps_hd_drop_suffix_infinite [OF f_0 f_step unfinished pcs_pcss]
     have "\<forall>i. \<Gamma>\<turnstile>g i \<rightarrow> g (Suc i)"
       by (simp add: g_def)
     ultimately
     have "inf \<Gamma> [c] [] s"
       by (auto simp add: inf_def)
     thus ?thesis
       by simp
   qed
 qed
 
 lemma infE [consumes 1]:
   assumes inf: "inf \<Gamma> (c#cs) css s"
   assumes cases: "inf \<Gamma> [c] [] s \<Longrightarrow> P"
                  "\<And>t. \<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t; inf \<Gamma> cs css t\<rbrakk> \<Longrightarrow> P"
   shows P
 using inf cases
 apply -
 apply (drule inf.inf_cases)
 apply auto
 done
 
 lemma inf_Seq:
   "inf \<Gamma> (Seq c1 c2#cs) css (Normal s) = inf \<Gamma> (c1#c2#cs) css (Normal s)"
 proof
   assume "inf \<Gamma> (Seq c1 c2 # cs) css (Normal s)"
   then obtain f where
     f_0: "f 0 = (Seq c1 c2#cs,css,Normal s)" and
     f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     by (auto simp add: inf_def)
   from f_step [rule_format, of 0] f_0
   have "f 1 = (c1#c2#cs,css,Normal s)"
     by (auto elim: step_Normal_elim_cases)
   with f_step show "inf \<Gamma> (c1#c2#cs) css (Normal s)"
     apply (simp add: inf_def)
     apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
     apply simp
     done
 next
   assume "inf \<Gamma> (c1 # c2 # cs) css (Normal s)"
   then obtain f where
     f_0: "f 0 = (c1# c2#cs,css,Normal s)" and
     f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     by (auto simp add: inf_def)
   define g where "g i = (case i of 0 \<Rightarrow> (Seq c1 c2#cs,css,Normal s) | Suc j \<Rightarrow> f j)" for i
   with f_0 have
     "\<Gamma>\<turnstile>g 0 \<rightarrow> g (Suc 0)"
     by (auto intro: step.intros)
   moreover
   from f_step have "\<forall>i. i\<noteq>0 \<longrightarrow> \<Gamma>\<turnstile>g i \<rightarrow> g (Suc i)"
     by (auto simp add: g_def split: nat.splits)
   ultimately
   show "inf \<Gamma> (Seq c1 c2 # cs) css (Normal s)"
     apply (simp add: inf_def)
     apply (rule_tac x=g in exI)
     apply (simp add: g_def split: nat.splits)
     done
 qed
 
 lemma inf_WhileTrue:
   assumes b: "s \<in> b"
   shows "inf \<Gamma> (While b c#cs) css (Normal s) =
           inf \<Gamma> (c#While b c#cs) css (Normal s)"
 proof
   assume "inf \<Gamma> (While b c # cs) css (Normal s)"
   then obtain f where
     f_0: "f 0 = (While b c#cs,css,Normal s)" and
     f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     by (auto simp add: inf_def)
   from b f_step [rule_format, of 0] f_0
   have "f 1 = (c#While b c#cs,css,Normal s)"
     by (auto elim: step_Normal_elim_cases)
   with f_step show "inf \<Gamma> (c # While b c # cs) css (Normal s)"
     apply (simp add: inf_def)
     apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
     apply simp
     done
 next
   assume "inf \<Gamma> (c # While b c # cs) css (Normal s)"
   then obtain f where
     f_0: "f 0 = (c # While b c #cs,css,Normal s)" and
     f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     by (auto simp add: inf_def)
   define h where "h i = (case i of 0 \<Rightarrow> (While b c#cs,css,Normal s) | Suc j \<Rightarrow> f j)"  for i
   with b f_0 have
     "\<Gamma>\<turnstile>h 0 \<rightarrow> h (Suc 0)"
     by (auto intro: step.intros)
   moreover
   from f_step have "\<forall>i. i\<noteq>0 \<longrightarrow> \<Gamma>\<turnstile>h i \<rightarrow> h (Suc i)"
     by (auto simp add: h_def split: nat.splits)
   ultimately
   show "inf \<Gamma> (While b c # cs) css (Normal s)"
     apply (simp add: inf_def)
     apply (rule_tac x=h in exI)
     apply (simp add: h_def split: nat.splits)
     done
 qed
 
 lemma inf_Catch:
 "inf \<Gamma> (Catch c1 c2#cs) css (Normal s) = inf \<Gamma> [c1] ((cs,c2#cs)#css) (Normal s)"
 proof
   assume "inf \<Gamma> (Catch c1 c2#cs) css (Normal s)"
   then obtain f where
     f_0: "f 0 = (Catch c1 c2#cs,css,Normal s)" and
     f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     by (auto simp add: inf_def)
   from f_step [rule_format, of 0] f_0
   have "f 1 = ([c1],(cs,c2#cs)#css,Normal s)"
     by (auto elim: step_Normal_elim_cases)
   with f_step show "inf \<Gamma> [c1] ((cs,c2#cs)#css) (Normal s)"
     apply (simp add: inf_def)
     apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
     apply simp
     done
 next
   assume "inf \<Gamma> [c1] ((cs,c2#cs)#css) (Normal s)"
   then obtain f where
     f_0: "f 0 = ([c1],(cs,c2#cs)#css,Normal s)" and
     f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     by (auto simp add: inf_def)
   define h where "h i = (case i of 0 \<Rightarrow> (Catch c1 c2#cs,css,Normal s) | Suc j \<Rightarrow> f j)"  for i
   with f_0 have
     "\<Gamma>\<turnstile>h 0 \<rightarrow> h (Suc 0)"
     by (auto intro: step.intros)
   moreover
   from f_step have "\<forall>i. i\<noteq>0 \<longrightarrow> \<Gamma>\<turnstile>h i \<rightarrow> h (Suc i)"
     by (auto simp add: h_def split: nat.splits)
   ultimately
   show "inf \<Gamma> (Catch c1 c2 # cs) css (Normal s)"
     apply (simp add: inf_def)
     apply (rule_tac x=h in exI)
     apply (simp add: h_def split: nat.splits)
     done
 qed
 
 theorem terminates_impl_not_inf:
   assumes termi: "\<Gamma>\<turnstile>c \<down> s"
   shows "\<not>inf \<Gamma> [c] [] s"
 using termi
 proof induct
   case (Skip s) thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Skip], [], Normal s)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step [of 1]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Basic g s)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Basic g], [], Normal s)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Normal (g s))"
       by (auto elim: step_Normal_elim_cases)
     with f_step [of 1]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Spec r s)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Spec r], [], Normal s)"
     with f_step [of 0]
     have "\<Gamma>\<turnstile>([Spec r], [], Normal s) \<rightarrow> f (Suc 0)"
       by simp
     then show False
     proof (cases)
       fix t
       assume "(s, t) \<in> r" "f (Suc 0) = ([], [], Normal t)"
       with f_step [of 1]
       show False
         by (auto elim: step_elim_cases)
     next
       assume "\<forall>t. (s, t) \<notin> r" "f (Suc 0) = ([], [], Stuck)"
       with f_step [of 1]
       show False
         by (auto elim: step_elim_cases)
     qed
   qed
 next
   case (Guard s g c m)
   have g: "s \<in> g" by fact
   have hyp: "\<not> inf \<Gamma> [c] [] (Normal s)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Guard m g c], [], Normal s)"
     from g f_step [of 0] f_0
     have "f (Suc 0) = ([c],[],Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "inf \<Gamma> [c] [] (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp show False ..
   qed
 next
   case (GuardFault s g m c)
   have g: "s \<notin> g" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Guard m g c], [], Normal s)"
     from g f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Fault m)"
       by (auto elim: step_Normal_elim_cases)
     with f_step [of 1]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Fault c m)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([c], [], Fault m)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Fault m)"
       by (auto elim: step_Normal_elim_cases)
     with f_step [of 1]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Seq c1 s c2)
   have hyp_c1: "\<not> inf \<Gamma> [c1] [] (Normal s)" by fact
   have hyp_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>c2 \<down> s' \<and> \<not> inf \<Gamma> [c2] [] s'" by fact
   have "\<not> inf \<Gamma> ([c1,c2]) [] (Normal s)"
   proof
     assume "inf \<Gamma> [c1, c2] [] (Normal s)"
     then show False
     proof (cases rule: infE)
       assume "inf \<Gamma> [c1] [] (Normal s)"
       with hyp_c1 show ?thesis by simp
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> t" "inf \<Gamma> [c2] [] t"
       with hyp_c2 show ?thesis by simp
     qed
   qed
   thus ?case
     by (simp add: inf_Seq)
 next
   case (CondTrue s b c1 c2)
   have b: "s \<in> b" by fact
   have hyp_c1: "\<not> inf \<Gamma> [c1] [] (Normal s)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Cond b c1 c2], [], Normal s)"
     from b f_step [of 0] f_0
     have "f 1 = ([c1],[],Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "inf \<Gamma> [c1] [] (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp_c1 show False by simp
   qed
 next
   case (CondFalse s b c2 c1)
   have b: "s \<notin> b" by fact
   have hyp_c2: "\<not> inf \<Gamma> [c2] [] (Normal s)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Cond b c1 c2], [], Normal s)"
     from b f_step [of 0] f_0
     have "f 1 = ([c2],[],Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "inf \<Gamma> [c2] [] (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp_c2 show False by simp
   qed
 next
   case (WhileTrue s b c)
   have b: "s \<in> b" by fact
   have hyp_c: "\<not> inf \<Gamma> [c] [] (Normal s)" by fact
   have hyp_w: "\<forall>s'. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> s' \<longrightarrow>
                       \<Gamma>\<turnstile>While b c \<down> s' \<and> \<not> inf \<Gamma> [While b c] [] s'" by fact
   have "\<not> inf \<Gamma> [c,While b c] [] (Normal s)"
   proof
     assume "inf \<Gamma> [c,While b c] [] (Normal s)"
     from this hyp_c hyp_w show False
       by (cases rule: infE) auto
   qed
   with b show ?case
     by (simp add: inf_WhileTrue)
 next
   case (WhileFalse s b c)
   have b: "s \<notin> b" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([While b c], [], Normal s)"
     from b f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step [of 1]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Call p bdy s)
   have bdy: "\<Gamma> p = Some bdy" by fact
   have hyp: "\<not> inf \<Gamma> [bdy] [] (Normal s)" by fact
   have not_inf_bdy:
     "\<not> inf \<Gamma> [bdy] [([],[Throw])] (Normal s)"
   proof
     assume "inf \<Gamma> [bdy] [([],[Throw])] (Normal s)"
     then show False
     proof (rule infE)
       assume "inf \<Gamma> [bdy] [] (Normal s)"
       with hyp show False by simp
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow> t"
       assume inf: "inf \<Gamma> [] [([], [Throw])] t"
       then obtain f where
         f_0: "f 0 = ([],[([], [Throw])],t)" and
         f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
         by (auto simp add: inf_def)
       show False
       proof (cases t)
         case (Normal t')
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([],[],(Normal t'))"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of "Suc 0"]
         show False
           by (auto elim: step.cases)
       next
         case (Abrupt t')
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([Throw],[],(Normal t'))"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of "Suc 0"]
         have "f (Suc (Suc 0)) = ([],[],(Abrupt t'))"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of "Suc(Suc 0)"]
         show False
           by (auto elim: step.cases)
       next
         case (Fault m)
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([],[],Fault m)"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of 1]
         have "f (Suc (Suc 0)) = ([],[],Fault m)"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of "Suc (Suc 0)"]
         show False
           by (auto elim: step.cases)
       next
         case Stuck
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([],[],Stuck)"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of 1]
         have "f (Suc (Suc 0)) = ([],[],Stuck)"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of "Suc (Suc 0)"]
         show False
           by (auto elim: step.cases)
       qed
     qed
   qed
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Call p], [], Normal s)"
     from bdy f_step [of 0] f_0
     have "f (Suc 0) =
               ([bdy],[([],[Throw])],Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "inf \<Gamma> [bdy] [([],[Throw])] (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with not_inf_bdy
     show False by simp
   qed
 next
   case (CallUndefined p s)
   have undef: "\<Gamma> p = None" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Call p], [], Normal s)"
     from undef f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Stuck)"
       by (auto elim: step_Normal_elim_cases)
     with f_step [rule_format, of "Suc 0"]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Stuck c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([c], [], Stuck)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Stuck)"
       by (auto elim: step_elim_cases)
     with f_step [rule_format, of "Suc 0"]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (DynCom c s)
   have hyp: "\<not> inf \<Gamma> [(c s)] [] (Normal s)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([DynCom c], [], Normal s)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([(c s)], [], Normal s)"
       by (auto elim: step_elim_cases)
     with f_step have "inf \<Gamma> [(c s)] [] (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp
     show False by simp
   qed
 next
   case (Throw s)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([Throw], [], Normal s)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Abrupt s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step [of 1]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Abrupt c s)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = ([c], [], Abrupt s)"
     from f_step [of 0] f_0
     have "f (Suc 0) = ([],[],Abrupt s)"
       by (auto elim: step_elim_cases)
     with f_step [rule_format, of "Suc 0"]
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Catch c1 s c2)
   have hyp_c1: "\<not> inf \<Gamma> [c1] [] (Normal s)" by fact
   have hyp_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> Abrupt s' \<longrightarrow>
                    \<Gamma>\<turnstile>c2 \<down> Normal s' \<and> \<not> inf \<Gamma> [c2] [] (Normal s')" by fact
   have "\<not> inf \<Gamma> [c1] [([],[c2])] (Normal s)"
   proof
     assume "inf \<Gamma> [c1] [([],[c2])] (Normal s)"
     then show False
     proof (rule infE)
       assume "inf \<Gamma> [c1] [] (Normal s)"
       with hyp_c1 show False by simp
     next
       fix t
       assume eval: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> t"
       assume inf: "inf \<Gamma> [] [([], [c2])] t"
       then obtain f where
         f_0: "f 0 = ([],[([], [c2] )],t)" and
         f_step: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
         by (auto simp add: inf_def)
       show False
       proof (cases t)
         case (Normal t')
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([],[],Normal t')"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of 1]
         show False
           by (auto elim: step_elim_cases)
       next
         case (Abrupt t')
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([c2],[],Normal t')"
           by (auto elim: step_Normal_elim_cases)
         with f_step eval Abrupt
         have "inf \<Gamma> [c2] [] (Normal t')"
           apply (simp add: inf_def)
           apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
           by simp
         with eval hyp_c2 Abrupt show False by simp
       next
         case (Fault m)
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([],[],Fault m)"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of 1]
         show False
           by (auto elim: step_elim_cases)
       next
         case Stuck
         with f_0 f_step [rule_format, of 0]
         have "f (Suc 0) = ([],[],Stuck)"
           by (auto elim: step_Normal_elim_cases)
         with f_step [rule_format, of 1]
         show False
           by (auto elim: step_elim_cases)
       qed
     qed
   qed
   thus ?case
     by (simp add: inf_Catch)
 qed
 
 lemma terminatess_impl_not_inf:
  assumes termi: "\<Gamma>\<turnstile>cs,css\<Down>s"
   shows "\<not>inf \<Gamma> cs css s"
 using termi
 proof (induct)
   case (Nil s)
   show ?case
   proof (rule not_infI)
     fix f
     assume "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     hence "\<Gamma>\<turnstile>f 0 \<rightarrow> f (Suc 0)"
       by simp
     moreover
     assume "f 0 = ([], [], s)"
     ultimately show False
       by (fastforce elim: step.cases)
   qed
 next
   case (ExitBlockNormal nrms css s abrs)
   have hyp: "\<not> inf \<Gamma> nrms css (Normal s)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f0: "f 0 = ([], (nrms, abrs) # css, Normal s)"
     with f_step [of 0] have "f (Suc 0) = (nrms,css,Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step have "inf \<Gamma> nrms css (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp show False ..
   qed
 next
   case (ExitBlockAbrupt abrs css s nrms)
   have hyp: "\<not> inf \<Gamma> abrs css (Normal s)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f0: "f 0 = ([], (nrms, abrs) # css, Abrupt s)"
     with f_step [of 0] have "f (Suc 0) = (abrs,css,Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step have "inf \<Gamma> abrs css (Normal s)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp show False ..
   qed
 next
   case (ExitBlockFault nrms css f abrs)
   show ?case
     by (rule not_inf_Fault)
 next
   case (ExitBlockStuck nrms css abrs)
   show ?case
     by (rule not_inf_Stuck)
 next
   case (Cons c s cs css)
   have termi_c: "\<Gamma>\<turnstile>c \<down> s" by fact
   have hyp: "\<forall>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<longrightarrow> \<Gamma>\<turnstile>cs,css\<Down>t \<and> \<not> inf \<Gamma> cs css t"  by fact
   show "\<not> inf \<Gamma> (c # cs) css s"
   proof
     assume "inf \<Gamma> (c # cs) css s"
     thus False
     proof (rule infE)
       assume "inf \<Gamma> [c] [] s"
       with terminates_impl_not_inf [OF termi_c]
       show False ..
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t" "inf \<Gamma> cs css t"
       with hyp show False by simp
     qed
   qed
 qed
 
 lemma lem:
   "\<forall>y. r\<^sup>+\<^sup>+ a y \<longrightarrow> P a \<longrightarrow> P y
    \<Longrightarrow> ((b,a) \<in> {(y,x). P x \<and> r x y}\<^sup>+) = ((b,a) \<in> {(y,x). P x \<and> r\<^sup>+\<^sup>+ x y})"
 apply(rule iffI)
  apply clarify
  apply(erule trancl_induct)
   apply blast
  apply(blast intro:tranclp_trans)
 apply clarify
 apply(erule tranclp_induct)
  apply blast
 apply(blast intro:trancl_trans)
 done
 
 corollary terminatess_impl_no_inf_chain:
  assumes terminatess: "\<Gamma>\<turnstile>cs,css\<Down>s"
  shows "\<not>(\<exists>f. f 0 = (cs,css,s) \<and> (\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f(Suc i)))"
 proof -
   have "wf({(y,x). \<Gamma>\<turnstile>(cs,css,s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+)"
   proof (rule wf_trancl)
     show "wf {(y, x). \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}"
     proof (simp only: wf_iff_no_infinite_down_chain,clarify,simp)
       fix f
       assume "\<forall>i. \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* f i \<and> \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
       hence "\<exists>f. f 0 = (cs, css, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i))"
         by (rule renumber [to_pred])
       moreover from terminatess
       have "\<not> (\<exists>f. f 0 = (cs, css, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)))"
         by (rule terminatess_impl_not_inf [unfolded inf_def])
       ultimately show False
         by simp
     qed
   qed
   hence "\<not> (\<exists>f. \<forall>i. (f (Suc i), f i)
                  \<in> {(y, x). \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+)"
     by (simp add: wf_iff_no_infinite_down_chain)
   thus ?thesis
   proof (rule contrapos_nn)
     assume "\<exists>f. f 0 = (cs, css, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f (Suc i))"
     then obtain f where
       f0: "f 0 = (cs, css, s)" and
       seq: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f (Suc i)"
       by iprover
     show
       "\<exists>f. \<forall>i. (f (Suc i), f i) \<in> {(y, x). \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+"
     proof (rule exI [where x=f],rule allI)
       fix i
       show "(f (Suc i), f i) \<in> {(y, x). \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+"
       proof -
         {
           fix i have "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow>\<^sup>* f i"
           proof (induct i)
             case 0 show "\<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* f 0"
               by (simp add: f0)
           next
             case (Suc n)
             have "\<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* f n"  by fact
             with seq show "\<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* f (Suc n)"
               by (blast intro: tranclp_into_rtranclp rtranclp_trans)
           qed
         }
         hence "\<Gamma>\<turnstile>(cs,css,s) \<rightarrow>\<^sup>* f i"
           by iprover
         with seq have
           "(f (Suc i), f i) \<in> {(y, x). \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow>\<^sup>+ y}"
           by clarsimp
         moreover
         have "\<forall>y. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ y\<longrightarrow>\<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* f i\<longrightarrow>\<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* y"
           by (blast intro: tranclp_into_rtranclp rtranclp_trans)
         ultimately
         show ?thesis
           by (subst lem)
       qed
     qed
   qed
 qed
 
 corollary terminates_impl_no_inf_chain:
  "\<Gamma>\<turnstile>c\<down>s \<Longrightarrow> \<not>(\<exists>f. f 0 = ([c],[],s) \<and> (\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f(Suc i)))"
   by (rule terminatess_impl_no_inf_chain) (iprover intro: terminatess.intros)
 
 
 definition
  termi_call_steps :: "('s,'p,'f) body \<Rightarrow> (('s \<times> 'p) \<times> ('s \<times> 'p))set"
 where
 "termi_call_steps \<Gamma> =
  {((t,q),(s,p)). \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal s \<and>
        (\<exists>css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal s) \<rightarrow>\<^sup>+ ([the (\<Gamma> q)],css,Normal t))}"
 
 text \<open>Sequencing computations, or more exactly continuation stacks\<close>
 primrec seq:: "(nat \<Rightarrow> 'a list) \<Rightarrow> nat \<Rightarrow> 'a list"
 where
 "seq css 0 = []" |
 "seq css (Suc i) = css i@seq css i"
 
 
 theorem wf_termi_call_steps: "wf (termi_call_steps \<Gamma>)"
 proof (simp only: termi_call_steps_def wf_iff_no_infinite_down_chain,
        clarify,simp)
   fix S
   assume inf:
      "\<forall>i. (\<lambda>(t,q) (s,p). \<Gamma>\<turnstile>(the (\<Gamma> p)) \<down> Normal s \<and>
                  (\<exists>css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal s) \<rightarrow>\<^sup>+ ([the (\<Gamma> q)],css,Normal t)))
            (S (Suc i)) (S i)"
   obtain s p where "s = (\<lambda>i. fst (S i))" and "p = (\<lambda>i. snd (S i))"
     by auto
   with inf
   have inf':
      "\<forall>i. \<Gamma>\<turnstile>(the (\<Gamma> (p i))) \<down> Normal (s i) \<and>
                  (\<exists>css. \<Gamma>\<turnstile>([the (\<Gamma> (p i))],[],Normal (s i)) \<rightarrow>\<^sup>+
                            ([the (\<Gamma> (p (Suc i)))],css,Normal (s (Suc i))))"
     apply -
     apply (rule allI)
     apply (erule_tac x=i in allE)
     apply auto
     done
   show False
   proof -
     from inf' \<comment> \<open>Skolemization of css with axiom of choice\<close>
     have "\<exists>css. \<forall>i. \<Gamma>\<turnstile>(the (\<Gamma> (p i))) \<down> Normal (s i) \<and>
                  \<Gamma>\<turnstile>([the (\<Gamma> (p i))],[],Normal (s i)) \<rightarrow>\<^sup>+
                            ([the (\<Gamma> (p (Suc i)))],css i,Normal (s (Suc i)))"
       apply -
       apply (rule choice)
       by blast
     then obtain css where
       termi_css: "\<forall>i. \<Gamma>\<turnstile>(the (\<Gamma> (p i))) \<down> Normal (s i)" and
       step_css: "\<forall>i. \<Gamma>\<turnstile>([the (\<Gamma> (p i))],[],Normal (s i)) \<rightarrow>\<^sup>+
                          ([the (\<Gamma> (p (Suc i)))],css i,Normal (s (Suc i)))"
       by blast
     define f where "f i = ([the (\<Gamma> (p i))], seq css i,Normal (s i)::('a,'c) xstate)" for i
     have "f 0 = ([the (\<Gamma> (p 0))],[],Normal (s 0))"
       by (simp add: f_def)
     moreover
     have "\<forall>i. \<Gamma>\<turnstile> (f i) \<rightarrow>\<^sup>+ (f (i+1))"
     proof
       fix i
       from step_css [rule_format, of i]
       have "\<Gamma>\<turnstile>([the (\<Gamma> (p i))], [], Normal (s i)) \<rightarrow>\<^sup>+
               ([the (\<Gamma> (p (Suc i)))], css i, Normal (s (Suc i)))".
       from app_css_steps [OF this,simplified]
       have "\<Gamma>\<turnstile>([the (\<Gamma> (p i))], seq css i, Normal (s i)) \<rightarrow>\<^sup>+
               ([the (\<Gamma> (p (Suc i)))], css i@seq css i, Normal (s (Suc i)))".
       thus "\<Gamma>\<turnstile> (f i) \<rightarrow>\<^sup>+ (f (i+1))"
         by (simp add: f_def)
     qed
     moreover from termi_css [rule_format, of 0]
     have "\<not> (\<exists>f. (f 0 = ([the (\<Gamma> (p 0))],[],Normal (s 0)) \<and>
                  (\<forall>i. \<Gamma>\<turnstile>(f i) \<rightarrow>\<^sup>+ f(Suc i))))"
       by (rule terminates_impl_no_inf_chain)
     ultimately show False
       by auto
   qed
 qed
 
 text \<open>An alternative proof using Hilbert-choice instead of axiom of choice.\<close>
 theorem "wf (termi_call_steps \<Gamma>)"
 proof (simp only: termi_call_steps_def wf_iff_no_infinite_down_chain,
        clarify,simp)
   fix S
   assume inf:
      "\<forall>i. (\<lambda>(t,q) (s,p). \<Gamma>\<turnstile>(the (\<Gamma> p)) \<down> Normal s \<and>
                  (\<exists>css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal s) \<rightarrow>\<^sup>+ ([the (\<Gamma> q)],css,Normal t)))
            (S (Suc i)) (S i)"
   obtain s p where "s = (\<lambda>i. fst (S i))" and "p = (\<lambda>i. snd (S i))"
     by auto
   with inf
   have inf':
      "\<forall>i. \<Gamma>\<turnstile>(the (\<Gamma> (p i))) \<down> Normal (s i) \<and>
                  (\<exists>css. \<Gamma>\<turnstile>([the (\<Gamma> (p i))],[],Normal (s i)) \<rightarrow>\<^sup>+
                            ([the (\<Gamma> (p (Suc i)))],css,Normal (s (Suc i))))"
     apply -
     apply (rule allI)
     apply (erule_tac x=i in allE)
     apply auto
     done
   show "False"
   proof -
     define CSS where "CSS i = (SOME css.
                       \<Gamma>\<turnstile>([the (\<Gamma> (p i))],[], Normal (s i)) \<rightarrow>\<^sup>+
                       ([the (\<Gamma> (p (i+1)))],css,Normal (s (i+1))))" for i
     define f where "f i = ([the (\<Gamma> (p i))], seq CSS i,Normal (s i)::('a,'c) xstate)" for i
     have "f 0 = ([the (\<Gamma> (p 0))],[],Normal (s 0))"
       by (simp add: f_def)
     moreover
     have "\<forall>i. \<Gamma>\<turnstile> (f i) \<rightarrow>\<^sup>+ (f (i+1))"
     proof
       fix i
       from inf' [rule_format, of i] obtain css where
          css: "\<Gamma>\<turnstile>([the (\<Gamma> (p i))],[],Normal (s i)) \<rightarrow>\<^sup>+
                 ([the (\<Gamma> (p (i+1)))],css,Normal (s (i+1)))"
         by fastforce
       hence "\<Gamma>\<turnstile>([the (\<Gamma> (p i))], seq CSS i, Normal (s i)) \<rightarrow>\<^sup>+
                   ([the (\<Gamma> (p (i+1)))], CSS i @ seq CSS i, Normal (s (i+1)))"
         apply -
         apply (unfold CSS_def)
         apply (rule someI2
               [where P="\<lambda>css.
                     \<Gamma>\<turnstile>([the (\<Gamma> (p i))],[],Normal (s i))\<rightarrow>\<^sup>+
                          ([the (\<Gamma> (p (i+1)))],css, Normal (s (i+1)))"])
         apply (rule css)
         apply (fastforce dest: app_css_steps)
         done
       thus "\<Gamma>\<turnstile> (f i) \<rightarrow>\<^sup>+ (f (i+1))"
         by (simp add: f_def)
     qed
     moreover from inf' [rule_format, of 0]
     have "\<Gamma>\<turnstile>the (\<Gamma> (p 0)) \<down> Normal (s 0)"
       by iprover
     then have "\<not> (\<exists>f. (f 0 = ([the (\<Gamma> (p 0))],[],Normal (s 0)) \<and>
                  (\<forall>i. \<Gamma>\<turnstile>(f i) \<rightarrow>\<^sup>+ f(Suc i))))"
       by (rule terminates_impl_no_inf_chain)
     ultimately show False
       by auto
   qed
 qed
 
 lemma not_inf_implies_wf: assumes not_inf: "\<not> inf \<Gamma> cs css s"
   shows "wf {(c2,c1). \<Gamma> \<turnstile> (cs,css,s) \<rightarrow>\<^sup>* c1 \<and> \<Gamma> \<turnstile> c1 \<rightarrow> c2}"
 proof (simp only: wf_iff_no_infinite_down_chain,clarify, simp)
   fix f
   assume "\<forall>i. \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* f i \<and> \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
   hence "\<exists>f. f 0 = (cs, css, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i))"
     by (rule renumber [to_pred])
   moreover from not_inf
   have "\<not> (\<exists>f. f 0 = (cs, css, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)))"
     by (unfold inf_def)
   ultimately show False
     by simp
 qed
 
 lemma wf_implies_termi_reach:
 assumes wf: "wf {(c2,c1). \<Gamma> \<turnstile> (cs,css,s) \<rightarrow>\<^sup>* c1 \<and> \<Gamma> \<turnstile> c1 \<rightarrow> c2}"
 shows "\<And>cs1 css1 s1. \<lbrakk>\<Gamma> \<turnstile> (cs,css,s) \<rightarrow>\<^sup>* c1;  c1=(cs1,css1,s1)\<rbrakk>\<Longrightarrow> \<Gamma>\<turnstile>cs1,css1\<Down>s1"
 using wf
 proof (induct c1, simp)
   fix cs1 css1 s1
   assume reach: "\<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* (cs1, css1, s1)"
   assume hyp_raw: "\<And>y cs2 css2 s2. \<lbrakk>\<Gamma> \<turnstile> (cs1,css1,s1) \<rightarrow> (cs2,css2,s2);
                  \<Gamma> \<turnstile> (cs,css,s) \<rightarrow>\<^sup>* (cs2,css2,s2); y=(cs2,css2,s2)\<rbrakk> \<Longrightarrow>
                  \<Gamma>\<turnstile>cs2,css2\<Down>s2"
   have hyp: "\<And>cs2 css2 s2. \<lbrakk>\<Gamma> \<turnstile> (cs1,css1,s1) \<rightarrow> (cs2,css2,s2)\<rbrakk> \<Longrightarrow>
                  \<Gamma>\<turnstile>cs2,css2\<Down>s2"
     apply -
     apply (rule hyp_raw)
     apply   assumption
     using reach
     apply  simp
     apply (rule refl)
     done
   show "\<Gamma>\<turnstile>cs1,css1\<Down>s1"
   proof (cases s1)
     case (Normal s1')
     show ?thesis
     proof (cases cs1)
       case Nil
       note cs1_Nil = this
       show ?thesis
       proof (cases css1)
         case Nil
         with cs1_Nil show ?thesis
           by (auto intro: terminatess.intros)
       next
         case (Cons nrms_abrs css1')
         then obtain nrms abrs where nrms_abrs: "nrms_abrs=(nrms,abrs)"
           by (cases "nrms_abrs")
         have "\<Gamma> \<turnstile> ([],(nrms,abrs)#css1',Normal s1') \<rightarrow> (nrms,css1',Normal s1')"
           by (rule step.intros)
         from hyp [simplified cs1_Nil Cons nrms_abrs Normal, OF this]
         have "\<Gamma>\<turnstile>nrms,css1'\<Down>Normal s1'".
         from ExitBlockNormal [OF this] cs1_Nil Cons nrms_abrs Normal
         show ?thesis
           by auto
       qed
     next
       case (Cons c1 cs1')
       have "\<Gamma>\<turnstile>c1#cs1',css1\<Down>Normal s1'"
       proof (cases c1)
         case Skip
         have "\<Gamma> \<turnstile> (Skip#cs1',css1,Normal s1') \<rightarrow> (cs1',css1,Normal s1')"
           by (rule step.intros)
         from hyp [simplified Cons Skip Normal, OF this]
         have "\<Gamma>\<turnstile>cs1',css1\<Down>Normal s1'".
         with Normal Skip show ?thesis
           by (auto intro: terminatess.intros terminates.intros
                   elim: exec_Normal_elim_cases)
       next
         case (Basic f)
         have "\<Gamma> \<turnstile> (Basic f#cs1',css1,Normal s1') \<rightarrow> (cs1',css1,Normal (f s1'))"
           by (rule step.intros)
         from hyp [simplified Cons Basic Normal, OF this]
         have "\<Gamma>\<turnstile>cs1',css1\<Down>Normal (f s1')".
         with Normal Basic show ?thesis
           by (auto intro: terminatess.intros terminates.intros
                   elim: exec_Normal_elim_cases)
       next
         case (Spec r)
         with Normal show ?thesis
           apply simp
           apply (rule terminatess.Cons)
           apply  (fastforce intro: terminates.intros)
           apply (clarify)
           apply (erule exec_Normal_elim_cases)
           apply  clarsimp
           apply  (rule hyp)
           apply  (fastforce intro: step.intros simp add: Cons Spec Normal )
           apply (fastforce intro: terminatess_Stuck)
           done
       next
         case (Seq c\<^sub>1 c\<^sub>2)
         have "\<Gamma> \<turnstile> (Seq c\<^sub>1 c\<^sub>2#cs1',css1,Normal s1') \<rightarrow> (c\<^sub>1#c\<^sub>2#cs1',css1,Normal s1')"
           by (rule step.intros)
         from hyp [simplified Cons Seq Normal, OF this]
         have "\<Gamma>\<turnstile>c\<^sub>1 # c\<^sub>2 # cs1',css1\<Down>Normal s1'".
         with Normal Seq show ?thesis
           by (fastforce intro: terminatess.intros terminates.intros
                    elim: terminatess_elim_cases exec_Normal_elim_cases)
       next
         case (Cond b c\<^sub>1 c\<^sub>2)
         show ?thesis
         proof (cases "s1' \<in> b")
           case True
           hence "\<Gamma>\<turnstile>(Cond b c\<^sub>1 c\<^sub>2#cs1',css1,Normal s1') \<rightarrow> (c\<^sub>1#cs1',css1,Normal s1')"
             by (rule step.intros)
           from hyp [simplified Cons Cond Normal, OF this]
           have "\<Gamma>\<turnstile>c\<^sub>1 # cs1',css1\<Down>Normal s1'".
           with Normal Cond True show ?thesis
             by (fastforce intro: terminatess.intros terminates.intros
               elim: terminatess_elim_cases exec_Normal_elim_cases)
         next
           case False
           hence "\<Gamma>\<turnstile>(Cond b c\<^sub>1 c\<^sub>2#cs1',css1,Normal s1') \<rightarrow> (c\<^sub>2#cs1',css1,Normal s1')"
             by (rule step.intros)
           from hyp [simplified Cons Cond Normal, OF this]
           have "\<Gamma>\<turnstile>c\<^sub>2 # cs1',css1\<Down>Normal s1'".
           with Normal Cond False show ?thesis
             by (fastforce intro: terminatess.intros terminates.intros
               elim: terminatess_elim_cases exec_Normal_elim_cases)
         qed
       next
         case (While b c')
         show ?thesis
         proof (cases "s1' \<in> b")
           case True
           then have "\<Gamma>\<turnstile>(While b c' # cs1', css1, Normal s1') \<rightarrow>
                        (c' # While b c' # cs1', css1, Normal s1')"
             by (rule step.intros)
           from hyp [simplified Cons While Normal, OF this]
           have "\<Gamma>\<turnstile>c' # While b c' # cs1',css1\<Down>Normal s1'".
           with Cons While True Normal
           show ?thesis
             by (fastforce intro: terminatess.intros terminates.intros exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
         next
           case False
           then
           have "\<Gamma>\<turnstile>(While b c' # cs1', css1, Normal s1') \<rightarrow> (cs1', css1, Normal s1')"
             by (rule step.intros)
           from hyp [simplified Cons While Normal, OF this]
           have "\<Gamma>\<turnstile>cs1',css1\<Down>Normal s1'".
           with Cons While False Normal
           show ?thesis
             by (fastforce intro: terminatess.intros terminates.intros exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
         qed
       next
         case (Call p)
         show ?thesis
         proof (cases "\<Gamma> p")
           case None
           with Call Normal show ?thesis
             by (fastforce intro: terminatess.intros terminates.intros terminatess_Stuck
                  elim: exec_Normal_elim_cases)
         next
           case (Some bdy)
           then
           have "\<Gamma> \<turnstile> (Call p#cs1',css1,Normal s1') \<rightarrow>
                     ([bdy],(cs1',Throw#cs1')#css1,Normal s1')"
             by (rule step.intros)
           from hyp [simplified Cons Call Normal Some, OF this]
           have "\<Gamma>\<turnstile>[bdy],(cs1', Throw # cs1') # css1\<Down>Normal s1'".
           with Some Call Normal show ?thesis
             apply simp
             apply (rule terminatess.intros)
             apply (blast elim: terminatess_elim_cases intro: terminates.intros)
             apply clarify
             apply (erule terminatess_elim_cases)
             apply (erule exec_Normal_elim_cases)
             prefer 2
             apply  simp
             apply (erule_tac x=t in allE)
             apply (case_tac t)
             apply (auto intro: terminatess_Stuck terminatess_Fault exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
             done
         qed
       next
         case (DynCom c')
         have "\<Gamma> \<turnstile> (DynCom c'#cs1',css1,Normal s1') \<rightarrow> (c' s1'#cs1',css1,Normal s1')"
           by (rule step.intros)
         from hyp [simplified Cons DynCom Normal, OF this]
         have "\<Gamma>\<turnstile>c' s1'#cs1',css1\<Down>Normal s1'".
         with Normal DynCom show ?thesis
           by (fastforce intro: terminatess.intros terminates.intros exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
       next
         case (Guard f g c')
         show ?thesis
         proof (cases "s1' \<in> g")
           case True
           then have "\<Gamma> \<turnstile> (Guard f g c'#cs1',css1,Normal s1') \<rightarrow> (c'#cs1',css1,Normal s1')"
             by (rule step.intros)
           from hyp [simplified Cons Guard Normal, OF this]
           have "\<Gamma>\<turnstile>c'#cs1',css1\<Down>Normal s1'".
           with Normal Guard True show ?thesis
             by (fastforce intro: terminatess.intros terminates.intros exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
         next
           case False
           with Guard Normal show ?thesis
             by (fastforce intro: terminatess.intros terminatess_Fault
                                 terminates.intros
                  elim:  exec_Normal_elim_cases)
         qed
       next
         case Throw
         have "\<Gamma> \<turnstile> (Throw#cs1',css1,Normal s1') \<rightarrow> (cs1',css1,Abrupt s1')"
           by (rule step.intros)
         from hyp [simplified Cons Throw Normal, OF this]
         have "\<Gamma>\<turnstile>cs1',css1\<Down>Abrupt s1'".
         with Normal Throw show ?thesis
           by (auto intro: terminatess.intros terminates.intros
                   elim: exec_Normal_elim_cases)
       next
         case (Catch c\<^sub>1 c\<^sub>2)
         have "\<Gamma> \<turnstile> (Catch c\<^sub>1 c\<^sub>2#cs1',css1,Normal s1') \<rightarrow>
                   ([c\<^sub>1], (cs1',c\<^sub>2#cs1')# css1,Normal s1')"
           by (rule step.intros)
         from hyp [simplified Cons Catch Normal, OF this]
         have "\<Gamma>\<turnstile>[c\<^sub>1],(cs1', c\<^sub>2 # cs1') # css1\<Down>Normal s1'".
         with Normal Catch show ?thesis
           by (fastforce intro: terminatess.intros terminates.intros exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
       qed
       with Cons Normal show ?thesis
         by simp
     qed
   next
     case (Abrupt s1')
     show ?thesis
     proof (cases cs1)
       case Nil
       note cs1_Nil = this
       show ?thesis
       proof (cases css1)
         case Nil
         with cs1_Nil show ?thesis by (auto intro: terminatess.intros)
       next
         case (Cons nrms_abrs css1')
         then obtain nrms abrs where nrms_abrs: "nrms_abrs=(nrms,abrs)"
           by (cases "nrms_abrs")
         have "\<Gamma> \<turnstile> ([],(nrms,abrs)#css1',Abrupt s1') \<rightarrow> (abrs,css1',Normal s1')"
           by (rule step.intros)
         from hyp [simplified cs1_Nil Cons nrms_abrs Abrupt, OF this]
         have "\<Gamma>\<turnstile>abrs,css1'\<Down>Normal s1'".
         from ExitBlockAbrupt [OF this] cs1_Nil Cons nrms_abrs Abrupt
         show ?thesis
           by auto
       qed
     next
       case (Cons c1 cs1')
       have "\<Gamma>\<turnstile>c1#cs1',css1\<Down>Abrupt s1'"
       proof -
         have "\<Gamma> \<turnstile> (c1#cs1',css1,Abrupt s1') \<rightarrow> (cs1',css1,Abrupt s1')"
           by (rule step.intros)
         from hyp [simplified Cons Abrupt, OF this]
         have "\<Gamma>\<turnstile>cs1',css1\<Down>Abrupt s1'".
         with Cons Abrupt
         show ?thesis
           by (fastforce intro: terminatess.intros terminates.intros exec.intros
                     elim: terminatess_elim_cases exec_Normal_elim_cases)
       qed
       with Cons Abrupt show ?thesis by simp
     qed
   next
     case (Fault f)
     thus ?thesis by (auto intro: terminatess_Fault)
   next
     case Stuck
     thus ?thesis by (auto intro: terminatess_Stuck)
   qed
 qed
 
 lemma not_inf_impl_terminatess:
   assumes not_inf: "\<not> inf \<Gamma> cs css s"
   shows "\<Gamma>\<turnstile>cs,css\<Down>s"
 proof -
   from not_inf_implies_wf [OF not_inf]
   have wf: "wf {(c2, c1). \<Gamma>\<turnstile>(cs, css, s) \<rightarrow>\<^sup>* c1 \<and> \<Gamma>\<turnstile>c1 \<rightarrow> c2}".
   show ?thesis
     by (rule wf_implies_termi_reach [OF wf]) auto
 qed
 
 lemma not_inf_impl_terminates:
   assumes not_inf: "\<not> inf \<Gamma> [c] [] s"
   shows "\<Gamma>\<turnstile>c\<down>s"
 proof -
   from not_inf_impl_terminatess [OF not_inf]
   have "\<Gamma>\<turnstile>[c],[]\<Down>s".
   thus ?thesis
     by (auto elim: terminatess_elim_cases)
 qed
 
 theorem terminatess_iff_not_inf:
   "\<Gamma>\<turnstile>cs,css\<Down>s = (\<not> inf \<Gamma> cs css s)"
   apply rule
   apply  (erule terminatess_impl_not_inf)
   apply (erule not_inf_impl_terminatess)
   done
 
 corollary terminates_iff_not_inf:
   "\<Gamma>\<turnstile>c\<down>s = (\<not> inf \<Gamma> [c] [] s)"
   apply (rule)
   apply  (erule terminates_impl_not_inf)
   apply (erule not_inf_impl_terminates)
   done
 
 subsection \<open>Completeness of Total Correctness Hoare Logic\<close>
 
 lemma ConseqMGT:
   assumes modif: "\<forall>Z::'a. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z::'a assn) c (Q' Z),(A' Z)"
   assumes impl: "\<And>s. s \<in> P \<Longrightarrow> s \<in> P' s \<and> (\<forall>t. t \<in> Q' s \<longrightarrow> t \<in> Q) \<and>
                                             (\<forall>t. t \<in> A' s \<longrightarrow> t \<in> A)"
   shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 using impl
 by - (rule conseq [OF modif],blast)
 
 lemma conseq_extract_state_indep_prop:
   assumes state_indep_prop:"\<forall>s \<in> P. R"
   assumes to_show: "R \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   apply (rule Conseq)
   apply (clarify)
   apply (rule_tac x="P" in exI)
   apply (rule_tac x="Q" in exI)
   apply (rule_tac x="A" in exI)
   using state_indep_prop to_show
   by blast
 
 lemma Call_lemma':
  assumes Call_hyp:
  "\<forall>q\<in>dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
  shows "\<And>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
       {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and> \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c#cs,css,Normal s))}
               c
       {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
       {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof (induct c)
   case Skip
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Skip # cs,css,Normal s))}
                Skip
               {t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Skip [THEN conseqPre]) (blast intro: exec.Skip)
 next
   case (Basic f)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Basic f#cs,css,Normal s))}
                Basic f
               {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Basic [THEN conseqPre]) (blast intro: exec.Basic)
 next
   case (Spec r)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Spec r#cs,css,Normal s))}
                Spec r
               {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (rule hoaret.Spec [THEN conseqPre])
     apply (clarsimp)
     apply (case_tac "\<exists>t. (Z,t) \<in> r")
     apply (auto elim: exec_elim_cases simp add: final_notin_def intro: exec.intros)
     done
 next
   case (Seq c1 c2)
   have hyp_c1:
     "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                  (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c1#cs,css,Normal s))}
                 c1
                {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   have hyp_c2:
     "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                  (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c2#cs,css,Normal s))}
                 c2
                {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   have c1: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
               (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Seq c1 c2#cs,css,Normal s))}
                c1
                {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t \<and>
                    \<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                   (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c2#cs,css,Normal t))},
                {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp_c1],clarify,safe)
     assume "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (blast dest: Seq_NoFaultStuckD1)
   next
     fix cs css
     assume "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Seq c1 c2 # cs,css,Normal Z)"
     thus "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c1 # cs,css, Normal Z)"
       by (blast intro: rtranclp_into_tranclp1 [THEN tranclp_into_rtranclp]
                  step.Seq)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (blast dest: Seq_NoFaultStuckD2)
   next
     fix cs css t
     assume "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Seq c1 c2#cs,css,Normal Z)"
     also have "\<Gamma>\<turnstile>(Seq c1 c2 # cs,css,Normal Z) \<rightarrow> (c1#c2#cs,css,Normal Z)"
       by (rule step.Seq)
     also assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t"
     hence "\<Gamma>\<turnstile> (c1#c2#cs,css,Normal Z) \<rightarrow>\<^sup>* (c2#cs,css,Normal t)"
       by (rule exec_impl_steps)
     finally
     show "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c2 # cs,css, Normal t)"
       by iprover
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (blast intro: exec.intros)
   qed
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
               (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Seq c1 c2#cs,css,Normal s))}
               Seq c1 c2
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   by (rule hoaret.Seq [OF c1 ConseqMGT [OF hyp_c2]])
      (blast intro: exec.intros)
 next
   case (Cond b c1 c2)
   have hyp_c1:
        "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                         \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                     (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[], Normal \<sigma>) \<rightarrow>\<^sup>* (c1#cs,css,Normal s))}
                    c1
                   {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   have
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
            \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
            (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Cond b c1 c2#cs,css,Normal s))}
            \<inter> b)
            c1
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp_c1],safe)
     assume "Z \<in> b" "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (auto simp add: final_notin_def intro: exec.CondTrue)
   next
     fix cs css
     assume "Z \<in> b"
       "\<Gamma>\<turnstile>([the (\<Gamma> p)],[], Normal \<sigma>) \<rightarrow>\<^sup>* (Cond b c1 c2 # cs,css, Normal Z)"
     thus "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[], Normal \<sigma>) \<rightarrow>\<^sup>* (c1 # cs,css, Normal Z)"
       by (blast intro: rtranclp_into_tranclp1 [THEN tranclp_into_rtranclp]
           step.CondTrue)
   next
     fix t assume "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (blast intro: exec.CondTrue)
   next
     fix t assume "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (blast intro: exec.CondTrue)
   qed
   moreover
   have hyp_c2:
        "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                     (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c2#cs,css,Normal s))}
                    c2
                   {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   have
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
            (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*(Cond b c1 c2#cs,css, Normal s))}
            \<inter> -b)
            c2
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp_c2],safe)
     assume "Z \<notin> b" "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (auto simp add: final_notin_def intro: exec.CondFalse)
   next
     fix cs css
     assume "Z \<notin> b"
       "\<Gamma>\<turnstile>([the (\<Gamma> p)],[], Normal \<sigma>) \<rightarrow>\<^sup>* (Cond b c1 c2 # cs,css, Normal Z)"
     thus "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[], Normal \<sigma>) \<rightarrow>\<^sup>* (c2 # cs,css,Normal Z)"
       by (blast intro: rtranclp_into_tranclp1 [THEN tranclp_into_rtranclp]
           step.CondFalse)
   next
     fix t assume "Z \<notin> b" "\<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (blast intro: exec.CondFalse)
   next
     fix t assume "Z \<notin> b" "\<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (blast intro: exec.CondFalse)
   qed
   ultimately
   show
    "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
            (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Cond b c1 c2#cs,css,Normal s))}
            (Cond b c1 c2)
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Cond)
 next
   case (While b c)
   let ?unroll = "({(s,t). s\<in>b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t})\<^sup>*"
   let ?P' = "\<lambda>Z. {t. (Z,t)\<in>?unroll \<and>
                     (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                          \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                              (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                     \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                   (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                                (While b c#cs,css,Normal t))}"
   let ?A = "\<lambda>Z. {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   let ?r = "{(t,s). \<Gamma>\<turnstile>(While b c)\<down>Normal s \<and> s\<in>b \<and>
                     \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
        {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
           (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>)\<rightarrow>\<^sup>*(While b c#cs,css,Normal s))}
          (While b c)
        {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t},
        {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [where ?P'="\<lambda> Z. ?P' Z"
                          and ?Q'="\<lambda> Z. ?P' Z \<inter> - b"])
     have wf_r: "wf ?r" by (rule wf_terminates_while)
     show "\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (?P' Z) (While b c) (?P' Z \<inter> - b),(?A Z)"
     proof (rule allI, rule hoaret.While [OF wf_r])
       fix Z
       from While
       have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
             {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                 \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c # cs,css,Normal s))}
               c
             {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
             {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}" by iprover
       show "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> ?P' Z  \<inter> b) c
                        ({t. (t, \<sigma>) \<in> ?r} \<inter> ?P' Z),(?A Z)"
       proof (rule allI, rule ConseqMGT [OF hyp_c])
         fix \<tau> s
         assume  asm: "s\<in> {\<tau>} \<inter>
                    {t. (Z, t) \<in> ?unroll \<and>
                       (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                      \<Gamma>\<turnstile>the (\<Gamma> p)\<down> Normal \<sigma> \<and>
                      (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                                   (While b c#cs,css,Normal t))}
                    \<inter> b"
         then obtain cs css where
           s_eq_\<tau>: "s=\<tau>" and
           Z_s_unroll: "(Z,s) \<in> ?unroll" and
           noabort:"\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" and
           termi:  "\<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma>" and
           reach: "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                     (While b c#cs,css,Normal s)"and
           s_in_b: "s\<in>b"
           by blast
         have reach_c:
           "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c#While b c#cs,css,Normal s)"
         proof -
           note reach
           also from s_in_b
           have "\<Gamma>\<turnstile>(While b c#cs,css,Normal s)\<rightarrow>
                   (c#While b c#cs,css,Normal s)"
             by (rule step.WhileTrue)
           finally
           show ?thesis .
         qed
         from reach termi have
           termi_while: "\<Gamma>\<turnstile>While b c \<down> Normal s"
           by (rule steps_preserves_termination)
         show "s \<in> {t. t = s \<and> \<Gamma>\<turnstile>\<langle>c,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                       \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                    (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c#cs,css,Normal t))} \<and>
         (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t} \<longrightarrow>
              t \<in> {t. (t,\<tau>) \<in> ?r} \<inter>
                  {t. (Z, t) \<in> ?unroll \<and>
                      (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow>  e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                               (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                       \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                     (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                                  (While b c # cs,css,Normal t))}) \<and>
          (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t} \<longrightarrow>
              t \<in> {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t})"
           (is "?C1 \<and> ?C2 \<and> ?C3")
         proof (intro conjI)
           from Z_s_unroll noabort s_in_b termi reach_c show ?C1
             by blast
         next
           {
             fix t
             assume s_t: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t"
             with s_eq_\<tau> termi_while s_in_b have "(t,\<tau>) \<in> ?r"
               by blast
             moreover
             from Z_s_unroll s_t s_in_b
             have "(Z, t) \<in> ?unroll"
               by (blast intro: rtrancl_into_rtrancl)
             moreover
             have "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (While b c#cs,css,Normal t)"
             proof -
               note reach_c
               also from s_t
               have "\<Gamma>\<turnstile>(c#While b c#cs,css,Normal s)\<rightarrow>\<^sup>*
                       (While b c#cs,css, Normal t)"
                 by (rule exec_impl_steps)
               finally show ?thesis .
             qed
             moreover note noabort termi
             ultimately
             have "(t,\<tau>) \<in> ?r \<and> (Z, t) \<in> ?unroll \<and>
                   (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                     (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                                  (While b c # cs,css, Normal t))"
               by iprover
           }
           then show ?C2 by blast
         next
           {
             fix t
             assume s_t:  "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t"
             from Z_s_unroll noabort s_t s_in_b
             have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
               by blast
           } thus ?C3 by simp
         qed
       qed
     qed
   next
     fix s
     assume P: "s \<in> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                    (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                                 (While b c#cs,css,Normal s))}"
     hence WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by auto
     show "s \<in> ?P' s \<and>
      (\<forall>t. t\<in>(?P' s \<inter> - b)\<longrightarrow>
           t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t})\<and>
      (\<forall>t. t\<in>?A s \<longrightarrow> t\<in>?A Z)"
     proof (intro conjI)
       {
         fix e
         assume "(Z,e) \<in> ?unroll" "e \<in> b"
         from this WhileNoFault
         have "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" (is "?Prop Z e")
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           assume e_in_b: "e \<in> b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           with e_in_b WhileNoFault
           have cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           moreover
           {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with e_in_b have "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           ultimately
           show "?Prop e e"
             by iprover
         next
           fix Z r
           assume e_in_b: "e\<in>b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           assume hyp: "\<lbrakk>e\<in>b;\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))\<rbrakk>
                        \<Longrightarrow> ?Prop r e"
           assume Z_r:
             "(Z, r) \<in> {(Z, r). Z \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r}"
           with WhileNoFault
           have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           from hyp [OF e_in_b this] obtain
             cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))" and
             Abrupt_r: "\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u \<longrightarrow>
                             \<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u"
             by simp
 
            {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with Abrupt_r have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u" by simp
             moreover from  Z_r obtain
               "Z \<in> b"  "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by simp
             ultimately have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           with cNoFault show "?Prop Z e"
             by iprover
         qed
       }
       with P show "s \<in> ?P' s"
         by blast
     next
       {
         fix t
         assume "termination": "t \<notin> b"
         assume "(Z, t) \<in> ?unroll"
         hence "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           from "termination"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal t\<rangle> \<Rightarrow> Normal t"
             by (blast intro: exec.WhileFalse)
         next
           fix Z r
           assume first_body:
                  "(Z, r) \<in> {(s, t). s \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
           assume "(r, t) \<in> ?unroll"
           assume rest_loop: "\<Gamma>\<turnstile>\<langle>While b c, Normal r\<rangle> \<Rightarrow> Normal t"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
           proof -
             from first_body obtain
               "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by fast
             moreover
             from rest_loop have
               "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Normal t"
               by fast
             ultimately show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
               by (rule exec.WhileTrue)
           qed
         qed
       }
       with P
       show "\<forall>t. t\<in>(?P' s \<inter> - b)
             \<longrightarrow>t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t}"
         by blast
     next
       from P show "\<forall>t. t\<in>?A s \<longrightarrow> t\<in>?A Z"
         by simp
     qed
   qed
 next
   case (Call q)
   let ?P = "{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
               (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>*
                   (Call q # cs,css,Normal s))}"
   from noStuck_Call
   have "\<forall>s \<in> ?P. q \<in> dom \<Gamma>"
     by (fastforce simp add: final_notin_def)
   then show ?case
   proof (rule conseq_extract_state_indep_prop)
     assume q_defined: "q \<in> dom \<Gamma>"
     from Call_hyp have
       "\<forall>q\<in>dom \<Gamma>. \<forall>Z.
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>the (\<Gamma> q),Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                         \<Gamma>\<turnstile>(the (\<Gamma> q))\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> q),Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> q),Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (simp add: exec_Call_body' noFaultStuck_Call_body' [simplified]
          terminates_Normal_Call_body)
     from Call_hyp q_defined have Call_hyp':
     "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                   (Call q)
                  {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by auto
     show
      "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ?P
            (Call q)
           {t. \<Gamma>\<turnstile>\<langle>Call q ,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call q ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF Call_hyp'],safe)
       fix cs css
       assume
         "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>)\<rightarrow>\<^sup>* (Call q # cs,css,Normal Z)"
         "\<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma>"
       hence "\<Gamma>\<turnstile>Call q \<down> Normal Z"
         by (rule steps_preserves_termination)
       with q_defined show "\<Gamma>\<turnstile>Call q \<down> Normal Z"
         by (auto elim: terminates_Normal_elim_cases)
     next
       fix cs css
       assume reach:
         "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Call q#cs,css,Normal Z)"
       moreover have "\<Gamma>\<turnstile>(Call q # cs,css, Normal Z) \<rightarrow>
                         ([the (\<Gamma> q)],(cs,Throw#cs)#css, Normal Z)"
         by (rule step.Call) (insert q_defined,auto)
       ultimately
       have "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>+ ([the (\<Gamma> q)],(cs,Throw#cs)#css,Normal Z)"
         by (rule rtranclp_into_tranclp1)
       moreover
       assume termi: "\<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma>"
       ultimately
       show "((Z,q), \<sigma>,p) \<in> termi_call_steps \<Gamma>"
         by (auto simp add: termi_call_steps_def)
     qed
   qed
 next
   case (DynCom c)
   have hyp:
     "\<And>s'. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
       {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c s',Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
             \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
           (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c s'#cs,css,Normal s))}
         (c s')
        {t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using DynCom by simp
   have hyp':
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (DynCom c#cs,css,Normal s))}
         (c Z)
        {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp],safe)
     assume "\<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     then show "\<Gamma>\<turnstile>\<langle>c Z,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (fastforce simp add: final_notin_def intro: exec.intros)
   next
     fix cs css
     assume "\<Gamma>\<turnstile>([the (\<Gamma> p)], [], Normal \<sigma>) \<rightarrow>\<^sup>* (DynCom c # cs, css, Normal Z)"
     also have "\<Gamma>\<turnstile>(DynCom c # cs, css, Normal Z) \<rightarrow> (c Z#cs,css,Normal Z)"
       by (rule step.DynCom)
     finally
     show "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)], [], Normal \<sigma>) \<rightarrow>\<^sup>* (c Z # cs, css, Normal Z)"
       by blast
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c Z,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (auto intro: exec.intros)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c Z,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (auto intro: exec.intros)
   qed
   show ?case
     apply (rule hoaret.DynCom)
     apply safe
     apply (rule hyp')
     done
 next
   case (Guard f g c)
   have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
          {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
             (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c#cs,css,Normal s))}
           c
          {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
          {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Guard.hyps by iprover
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
             (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Guard f g c#cs,css,Normal s))}
               Guard f g c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (cases "f \<in> F")
     case True
     have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> {s. s=Z \<and>
                      \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
             (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Guard f g c#cs,css,Normal s))})
               c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF hyp_c], safe)
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))" "Z\<in>g"
       thus "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         by (auto simp add: final_notin_def intro: exec.intros)
     next
       fix cs css
       assume "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Guard f g c#cs,css,Normal Z)"
       also
       assume "Z \<in> g"
       hence "\<Gamma>\<turnstile>(Guard f g c#cs,css,Normal Z) \<rightarrow> (c#cs,css,Normal Z)"
         by (rule step.Guard)
       finally show "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c#cs,css,Normal Z)"
         by iprover
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
              "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t" "Z \<in> g"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t"
         by (auto simp add: final_notin_def intro: exec.intros )
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
               "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t" "Z \<in> g"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t"
         by (auto simp add: final_notin_def intro: exec.intros )
     qed
     from True this show ?thesis
       by (rule conseqPre [OF Guarantee]) auto
   next
     case False
     have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> {s. s=Z \<and>
                      \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
             (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Guard f g c#cs,css,Normal s))})
               c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF hyp_c], safe)
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       thus "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         using False
         by (cases "Z\<in> g") (auto simp add: final_notin_def intro: exec.intros)
     next
       fix cs css
       assume "\<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (Guard f g c#cs,css,Normal Z)"
       also assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       hence "Z \<in> g"
         using False by (auto simp add: final_notin_def intro: exec.GuardFault)
       hence "\<Gamma>\<turnstile>(Guard f g c#cs,css,Normal Z) \<rightarrow> (c#cs,css,Normal Z)"
         by (rule step.Guard)
       finally show "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c#cs,css,Normal Z)"
         by iprover
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t"
         using False
         by (cases "Z\<in> g") (auto simp add: final_notin_def intro: exec.intros )
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
              "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t"
         using False
         by (cases "Z\<in> g") (auto simp add: final_notin_def intro: exec.intros )
     qed
     then show ?thesis
       apply (rule conseqPre [OF hoaret.Guard])
       apply clarify
       apply (frule Guard_noFaultStuckD [OF _ False])
       apply auto
       done
   qed
 next
   case Throw
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[], Normal \<sigma>) \<rightarrow>\<^sup>* (Throw#cs,css,Normal s))}
               Throw
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule conseqPre [OF hoaret.Throw])
        (blast intro: exec.intros terminates.intros)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have hyp_c1:
    "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s= Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c\<^sub>1# cs, css,Normal s))}
                c\<^sub>1
               {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   have hyp_c2:
    "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s= Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                 (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c\<^sub>2# cs, css,Normal s))}
                c\<^sub>2
               {t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   have
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
             (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>)\<rightarrow>\<^sup>*(Catch c\<^sub>1 c\<^sub>2 #cs,css,Normal s))}
             c\<^sub>1
            {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
            {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t \<and>
                \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault`(-F)) \<and> \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c\<^sub>2# cs, css,Normal t))}"
   proof (rule ConseqMGT [OF hyp_c1],clarify,safe)
     assume "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (fastforce simp add: final_notin_def intro: exec.intros)
   next
     fix cs css
     assume "\<Gamma>\<turnstile>([the (\<Gamma> p)], [], Normal \<sigma>) \<rightarrow>\<^sup>* (Catch c\<^sub>1 c\<^sub>2 # cs, css, Normal Z)"
     also have
       "\<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2 # cs, css, Normal Z) \<rightarrow> ([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal Z)"
       by (rule step.Catch)
     finally
     show "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)], [], Normal \<sigma>) \<rightarrow>\<^sup>* (c\<^sub>1 # cs, css, Normal Z)"
       by iprover
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (auto intro: exec.intros)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (auto simp add: final_notin_def intro: exec.intros)
   next
     fix cs css t
     assume "\<Gamma>\<turnstile>([the (\<Gamma> p)], [], Normal \<sigma>) \<rightarrow>\<^sup>* (Catch c\<^sub>1 c\<^sub>2 # cs, css, Normal Z)"
     also have
       "\<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2 # cs, css, Normal Z) \<rightarrow> ([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal Z)"
       by (rule step.Catch)
     also
     assume "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     hence "\<Gamma>\<turnstile>([c\<^sub>1],(cs,c\<^sub>2#cs)#css,Normal Z) \<rightarrow>\<^sup>* ([],(cs,c\<^sub>2#cs)#css,Abrupt t)"
       by (rule exec_impl_steps)
     also
     have "\<Gamma>\<turnstile>([],(cs,c\<^sub>2#cs)#css,Abrupt t) \<rightarrow> (c\<^sub>2#cs,css,Normal t)"
       by (rule step.intros)
     finally
     show "\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)], [], Normal \<sigma>) \<rightarrow>\<^sup>* (c\<^sub>2 # cs, css, Normal t)"
       by iprover
   qed
   moreover
   have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t \<and>
                   \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p) \<down> Normal \<sigma> \<and>
                   (\<exists>cs css. \<Gamma>\<turnstile>([the (\<Gamma> p)],[],Normal \<sigma>) \<rightarrow>\<^sup>* (c\<^sub>2# cs, css,Normal t))}
                c\<^sub>2
               {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT [OF hyp_c2]) (fastforce intro: exec.intros)
   ultimately show ?case
     by (rule hoaret.Catch)
 qed
 
 
 text \<open>To prove a procedure implementation correct it suffices to assume
        only the procedure specifications of procedures that actually
        occur during evaluation of the body.
 \<close>
 lemma Call_lemma:
  assumes
  Call: "\<forall>q \<in> dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
                  {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
  shows "\<And>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
               ({\<sigma>} \<inter> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                  \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal s})
                  the (\<Gamma> p)
               {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 apply (rule conseqPre)
 apply (rule Call_lemma')
 apply (rule Call)
 apply blast
 done
 
 lemma Call_lemma_switch_Call_body:
  assumes
  call: "\<forall>q \<in> dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
                  {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
  assumes p_defined: "p \<in> dom \<Gamma>"
  shows "\<And>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
               ({\<sigma>} \<inter> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                  \<Gamma>\<turnstile>Call p\<down>Normal s})
                  the (\<Gamma> p)
               {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 apply (simp only: exec_Call_body' [OF p_defined] noFaultStuck_Call_body' [OF p_defined] terminates_Normal_Call_body [OF p_defined])
 apply (rule conseqPre)
 apply (rule Call_lemma')
 apply (rule call)
 apply blast
 done
 
 
 lemma MGT_Call:
 "\<forall>p \<in> dom \<Gamma>. \<forall>Z.
   \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
              \<Gamma>\<turnstile>(Call p)\<down>Normal s}
            (Call p)
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 apply (intro ballI allI)
 apply (rule CallRec' [where Procs="dom \<Gamma>" and
     P="\<lambda>p Z. {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call p\<down>Normal s}" and
     Q="\<lambda>p Z. {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t}" and
     A="\<lambda>p Z. {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}" and
     r="termi_call_steps \<Gamma>"
     ])
 apply    simp
 apply   simp
 apply  (rule wf_termi_call_steps)
 apply (intro ballI allI)
 apply simp
 apply (rule Call_lemma_switch_Call_body [rule_format, simplified])
 apply  (rule hoaret.Asm)
 apply  fastforce
 apply assumption
 done
 
 
 lemma CollInt_iff: "{s. P s} \<inter> {s. Q s} = {s. P s \<and> Q s}"
   by auto
 
 lemma image_Un_conv: "f ` (\<Union>p\<in>dom \<Gamma>. \<Union>Z. {x p Z}) =  (\<Union>p\<in>dom \<Gamma>. \<Union>Z. {f (x p Z)})"
   by (auto iff: not_None_eq)
 
 
 text \<open>Another proof of \<open>MGT_Call\<close>, maybe a little more readable\<close>
 lemma
 "\<forall>p \<in> dom \<Gamma>. \<forall>Z.
   \<Gamma>,{} \<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
              \<Gamma>\<turnstile>(Call p)\<down>Normal s}
            (Call p)
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof -
   {
     fix p Z \<sigma>
     assume defined: "p \<in> dom \<Gamma>"
     define Specs where "Specs = (\<Union>p\<in>dom \<Gamma>. \<Union>Z.
             {({s. s=Z \<and>
               \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal s},
              p,
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t})})"
     define Specs_wf where "Specs_wf p \<sigma> = (\<lambda>(P,q,Q,A).
                        (P \<inter> {s. ((s,q),\<sigma>,p) \<in> termi_call_steps \<Gamma>}, q, Q, A)) ` Specs" for p \<sigma>
     have "\<Gamma>,Specs_wf p \<sigma>
             \<turnstile>\<^sub>t\<^bsub>/F\<^esub>({\<sigma>} \<inter>
                  {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal s})
                 (the (\<Gamma> p))
                {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       apply (rule Call_lemma [rule_format])
       apply (rule hoaret.Asm)
       apply (clarsimp simp add: Specs_wf_def Specs_def image_Un_conv)
       apply (rule_tac x=q in bexI)
       apply (rule_tac x=Z in exI)
       apply (clarsimp simp add: CollInt_iff)
       apply auto
       done
     hence "\<Gamma>,Specs_wf p \<sigma>
             \<turnstile>\<^sub>t\<^bsub>/F\<^esub>({\<sigma>} \<inter>
                  {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>Call p\<down>Normal s})
                 (the (\<Gamma> p))
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (simp only: exec_Call_body' [OF defined]
                    noFaultStuck_Call_body' [OF defined]
                   terminates_Normal_Call_body [OF defined])
   } note bdy=this
   show ?thesis
     apply (intro ballI allI)
     apply (rule hoaret.CallRec [where Specs="(\<Union>p\<in>dom \<Gamma>. \<Union>Z.
             {({s. s=Z \<and>
               \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal s},
              p,
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t})})",
              OF _ wf_termi_call_steps [of \<Gamma>] refl])
     apply fastforce
     apply clarify
     apply (rule conjI)
     apply  fastforce
     apply (rule allI)
     apply (simp (no_asm_use) only : Un_empty_left)
     apply (rule bdy)
     apply auto
     done
 qed
 
 end
diff --git a/thys/Simpl/COPYRIGHT b/thys/Simpl/COPYRIGHT
deleted file mode 100644
--- a/thys/Simpl/COPYRIGHT
+++ /dev/null
@@ -1,423 +0,0 @@
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
-
-
-TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-
-
-0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License"). Each
-licensee is addressed as "you".
-
-
-
-A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
-
-The "Library", below, refers to any such software library or work
-which has been distributed under these terms. A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language. (Hereinafter, translation is
-included without limitation in the term "modification".)
-
-
-"Source code" for a work means the preferred form of the work for
-making modifications to it. For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control
-compilation and installation of the library.
-
-
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it). Whether that is true depends on what the Library does and
-what the program that uses the Library does.
-
-
-1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a
-fee.
-
-
-2. You may modify your copy or copies of the Library or any portion of
-it, thus forming a work based on the Library, and copy and distribute
-such modifications or work under the terms of Section 1 above,
-provided that you also meet all of these conditions:
-
-
-a) The modified work must itself be a software library.
-
-
-b) You must cause the files modified to carry prominent notices
-stating that you changed the files and the date of any change.
-
-
-
-c) You must cause the whole of the work to be licensed at no charge to
-all third parties under the terms of this License.
-
-
-d) If a facility in the modified Library refers to a function or a
-table of data to be supplied by an application program that uses the
-facility, other than as an argument passed when the facility is
-invoked, then you must make a good faith effort to ensure that, in the
-event an application does not supply such function or table, the
-facility still operates, and performs whatever part of its purpose
-remains meaningful.
-
-
-(For example, a function in a library to compute square roots has a
-purpose that is entirely well-defined independent of the
-application. Therefore, Subsection 2d requires that any
-application-supplied function or table used by this function must be
-optional: if the application does not supply it, the square root
-function must still compute square roots.)
-
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-
-3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library. To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License. (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.) Do not make any other change in
-these notices.
-
-
-Once this change is made in a given copy, it is irreversible for that
-copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
-
-This option is useful when you wish to copy part of the code of the
-Library into a program that is not a library.
-
-
-4. You may copy and distribute the Library (or a portion or derivative
-of it, under Section 2) in object code or executable form under the
-terms of Sections 1 and 2 above provided that you accompany it with
-the complete corresponding machine-readable source code, which must be
-distributed under the terms of Sections 1 and 2 above on a medium
-customarily used for software interchange.
-
-
-If distribution of object code is made by offering access to copy from
-a designated place, then offering equivalent access to copy the source
-code from the same place satisfies the requirement to distribute the
-source code, even though third parties are not compelled to copy the
-source along with the object code.
-
-
-
-5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library". Such a work,
-in isolation, is not a derivative work of the Library, and therefore
-falls outside the scope of this License.
-
-
-However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library". The executable is therefore covered by this License. Section
-6 states terms for distribution of such executables.
-
-
-When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is
-not. Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library. The
-threshold for this to be true is not precisely defined by law.
-
-
-If such an object file uses only numerical parameters, data structure
-layouts and accessors, and small macros and small inline functions
-(ten lines or less in length), then the use of the object file is
-unrestricted, regardless of whether it is legally a derivative
-work. (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
-
-Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section
-6. Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-
-
-6. As an exception to the Sections above, you may also combine or link
-a "work that uses the Library" with the Library to produce a work
-containing portions of the Library, and distribute that work under
-terms of your choice, provided that the terms permit modification of
-the work for the customer's own use and reverse engineering for
-debugging such modifications.
-
-
-You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License. You must supply a copy of this License. If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License. Also, you must do one
-of these things:
-
-
-a) Accompany the work with the complete corresponding machine-readable
-source code for the Library including whatever changes were used in
-the work (which must be distributed under Sections 1 and 2 above);
-and, if the work is an executable linked with the Library, with the
-complete machine-readable "work that uses the Library", as object code
-and/or source code, so that the user can modify the Library and then
-relink to produce a modified executable containing the modified
-Library. (It is understood that the user who changes the contents of
-definitions files in the Library will not necessarily be able to
-recompile the application to use the modified definitions.)
-
-
-b) Use a suitable shared library mechanism for linking with the
-Library. A suitable mechanism is one that (1) uses at run time a copy
-of the library already present on the user's computer system, rather
-than copying library functions into the executable, and (2) will
-operate properly with a modified version of the library, if the user
-installs one, as long as the modified version is interface-compatible
-with the version that the work was made with.
-
-
-c) Accompany the work with a written offer, valid for at least three
-years, to give the same user the materials specified in Subsection 6a,
-above, for a charge no more than the cost of performing this
-distribution.
-
-
-d) If distribution of the work is made by offering access to copy from
-a designated place, offer equivalent access to copy the above
-specified materials from the same place.
-
-
-e) Verify that the user has already received a copy of these materials
-or that you have already sent this user a copy.
-
-
-
-For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it. However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
-
-It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system. Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-
-
-7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
-
-a) Accompany the combined library with a copy of the same work based
-on the Library, uncombined with any other library facilities. This
-must be distributed under the terms of the Sections above.
-
-
-b) Give prominent notice with the combined library of the fact that
-part of it is a work based on the Library, and explaining where to
-find the accompanying uncombined form of the same work.
-
-
-
-8. You may not copy, modify, sublicense, link with, or distribute the
-Library except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense, link with, or distribute the
-Library is void, and will automatically terminate your rights under
-this License. However, parties who have received copies, or rights,
-from you under this License will not have their licenses terminated so
-long as such parties remain in full compliance.
-
-
-9. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Library or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
-
-10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted
-herein. You are not responsible for enforcing compliance by third
-parties with this License.
-
-
-11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all. For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply, and the section as a whole is intended to apply in other
-circumstances.
-
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-
-12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
-
-13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time. Such
-new versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns.
-
-
-
-Each version is given a distinguishing version number. If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation. If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-
-
-14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission. For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this. Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
-
-NO WARRANTY
-
-
-15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE
-LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS
-AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF
-ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-
-16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
-
-END OF TERMS AND CONDITIONS
\ No newline at end of file
diff --git a/thys/Simpl/DPC0Expressions.thy b/thys/Simpl/DPC0Expressions.thy
--- a/thys/Simpl/DPC0Expressions.thy
+++ b/thys/Simpl/DPC0Expressions.thy
@@ -1,23 +1,24 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
+
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>SHORTENED! Parallel expressions in DPC/Hoare.\<close>
 
 theory DPC0Expressions imports Main begin
 
 definition p_not :: "bool list => bool list"  ("\<not>\<^sub>p")
   where "p_not = map Not"
 
 definition elem_wise :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list"
   where "elem_wise f xs ys = map (\<lambda> (x, y). f x y) (zip xs ys)"
 
 definition p_and  :: "bool list => bool list => bool list"  (infixl "\<and>\<^sub>p"  35)
   where "p_and = elem_wise (&)"
 
 notation (ASCII)
   p_and  (infixl "pand"  35)
 
 end
diff --git a/thys/Simpl/DPC0Library.thy b/thys/Simpl/DPC0Library.thy
--- a/thys/Simpl/DPC0Library.thy
+++ b/thys/Simpl/DPC0Library.thy
@@ -1,104 +1,105 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
+
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>DPC0 standard library\<close>
 
 theory DPC0Library imports DPC0Expressions Vcg begin
 
 text \<open>This theory constitutes a standard library for DPC0 programs.  At
  first, it includes (indirectly) the C0 library and (directly) its extensions
  for DPC0 specific expressions.  Secondly, the Vcg of the verification
  environment is included and its syntax extended by the DPC0 specific
  statement constructs for contextualization.
 \<close>
 
 
 (* =================================================== *)
 section \<open>Auxiliary functions for the concrete syntax\<close>
 (* =================================================== *)
 
 
 primrec pfilter:: "bool list \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
 "pfilter c [] = []" |
 "pfilter c (v#vs) = (if hd c then v#pfilter (tl c) vs else pfilter (tl c) vs)"
 
 
 primrec pmask:: "nat \<Rightarrow> bool list \<Rightarrow> nat list"
 where
 "pmask i  [] = []" |
 "pmask i (b#bs) = (if b then i#(pmask (Suc i) bs) else pmask (Suc i) bs)"
 
 
 (* ============================================= *)
 section \<open>Concrete syntax for Contextualization\<close>
 (* ============================================= *)
 
 syntax
   "_In":: "[ident,'a,'a] \<Rightarrow> ('s,'p,'f) com"
                  ("(2 IN \<acute>_:/ _ :== _)" [1000,30,30] 21)
   "_Where":: "['a,ident,('s,'p,'f) com] \<Rightarrow> ('s,'p,'f) com"
                  ("(0 WHERE (_)/ FOR \<acute>_ DO/ _ EREHW)" [0,0,0] 71)
   "_WhereElse":: "['a,ident,('s,'p,'f) com,('s,'p,'f) com] \<Rightarrow> ('s,'p,'f) com"
                  ("(0 WHERE (_)/ FOR \<acute>_ DO/ _ ELSE _ EREHW)" [0,0,0,0] 71)
 
 
 translations
   "_In c (x!!i) y" => "x!!(pfilter \<acute>c i) :== pfilter \<acute>c y"
   "_In c x y" => "x!!(pmask 0 \<acute>c) :== pfilter \<acute>c y"
   "_Where m c s" => "_Loc (_locinit c (p_and \<acute>c m)) s"
   "_WhereElse m c s1 s2" => "(_Loc (_locinit c (p_and \<acute>c m)) s1);;
                              (_Loc (_locinit c (p_and \<acute>c (p_not m))) s2)"
 
 print_translation \<open>
   let
     fun in_tr'
           [Const (@{const_syntax list_multsel}, _) $ x $
             (Const (@{const_syntax pfilter}, _) $
               (Const (@{syntax_const "_antiquoteCur"}, _) $ c) $ i),
             Const (@{const_syntax pfilter}, _) $
               (Const (@{syntax_const "_antiquoteCur"}, _) $ c') $ y] =
           if c = c' then
             Syntax.const @{syntax_const "_In"} $ c $
               (Syntax.const @{const_syntax list_multsel} $ x $ i) $ y
           else raise Match
       | in_tr'
           [Const (@{const_syntax list_multsel}, _) $ x $
             (Const (@{const_syntax pmask}, _) $ z $
               (Const (@{syntax_const "_antiquoteCur"}, _) $ c)),
             Const (@{const_syntax pfilter}, _) $ (Const (@{syntax_const "_antiquoteCur"}, _) $ c') $ y] =
        if c = c' then Syntax.const @{syntax_const "_In"} $ c $ x $ y
        else raise Match
 
     fun where_tr'
           [Const (@{syntax_const "_locinit"}, _) $ Const (c, _) $
             (Const (@{const_syntax p_and}, _) $
               (Const (@{syntax_const "_antiquoteCur"}, _) $ Const (c', _)) $ m), s] =
           if c = c' then
             Syntax.const @{syntax_const "_Where"} $ m $
               Syntax.const c $ s
           else raise Match
       | where_tr' ts = raise Match
 
   in
    [(@{syntax_const "_Assign"}, K in_tr'),
     (@{syntax_const "_Loc"}, K where_tr')]
   end
 \<close>
 
 print_ast_translation \<open>
   let
     fun where_else_tr'
       [Appl [Constant @{syntax_const "_Where"}, m, c, s1],
         Appl [Constant @{syntax_const "_Where"},
         Appl [Constant @{const_syntax p_not}, m'], c', s2]] =
       if c = c' andalso m = m' then Appl [Constant @{syntax_const "_WhereElse"}, m, c, s1, s2]
       else raise Match
   in [(@{syntax_const "_seq"}, K where_else_tr')] end
 \<close>
 
 
 end
diff --git a/thys/Simpl/Generalise.thy b/thys/Simpl/Generalise.thy
--- a/thys/Simpl/Generalise.thy
+++ b/thys/Simpl/Generalise.thy
@@ -1,154 +1,133 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Generalise.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2005-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 theory Generalise imports "HOL-Statespace.DistinctTreeProver"
 begin
 
 lemma protectRefl: "PROP Pure.prop (PROP C) \<Longrightarrow> PROP Pure.prop (PROP C)"
   by (simp add: prop_def)
 
 lemma protectImp:
  assumes i: "PROP Pure.prop (PROP P \<Longrightarrow> PROP Q)"
  shows "PROP Pure.prop (PROP Pure.prop P \<Longrightarrow> PROP Pure.prop Q)"
 proof -
   {
     assume P: "PROP Pure.prop P"
     from i [unfolded prop_def, OF P [unfolded prop_def]]
     have "PROP Pure.prop Q"
       by (simp add: prop_def)
   }
   note i' = this
   show "PROP ?thesis"
     apply (rule protectI)
     apply (rule i')
     apply assumption
     done
 qed
 
 
 lemma generaliseConj:
   assumes i1: "PROP Pure.prop (PROP Pure.prop (Trueprop P) \<Longrightarrow> PROP Pure.prop (Trueprop Q))"
   assumes i2: "PROP Pure.prop (PROP Pure.prop (Trueprop P') \<Longrightarrow> PROP Pure.prop (Trueprop Q'))"
   shows "PROP Pure.prop (PROP Pure.prop (Trueprop (P \<and> P')) \<Longrightarrow> (PROP Pure.prop (Trueprop (Q \<and> Q'))))"
   using i1 i2
   by (auto simp add: prop_def)
 
 lemma generaliseAll:
  assumes i: "PROP Pure.prop (\<And>s. PROP Pure.prop (Trueprop (P s)) \<Longrightarrow> PROP Pure.prop (Trueprop (Q s)))"
  shows "PROP Pure.prop (PROP Pure.prop (Trueprop (\<forall>s. P s)) \<Longrightarrow> PROP Pure.prop (Trueprop (\<forall>s. Q s)))"
   using i
   by (auto simp add: prop_def)
 
 lemma generalise_all:
  assumes i: "PROP Pure.prop (\<And>s. PROP Pure.prop (PROP P s) \<Longrightarrow> PROP Pure.prop (PROP Q s))"
  shows "PROP Pure.prop ((PROP Pure.prop (\<And>s. PROP P s)) \<Longrightarrow> (PROP Pure.prop (\<And>s. PROP Q s)))"
   using i
   proof (unfold prop_def)
     assume i1: "\<And>s. (PROP P s) \<Longrightarrow> (PROP Q s)"
     assume i2: "\<And>s. PROP P s"
     show "\<And>s. PROP Q s"
       by (rule i1) (rule i2)
   qed
 
 lemma generaliseTrans:
   assumes i1: "PROP Pure.prop (PROP P \<Longrightarrow> PROP Q)"
   assumes i2: "PROP Pure.prop (PROP Q \<Longrightarrow> PROP R)"
   shows "PROP Pure.prop (PROP P \<Longrightarrow> PROP R)"
   using i1 i2
   proof (unfold prop_def)
     assume P_Q: "PROP P \<Longrightarrow> PROP Q"
     assume Q_R: "PROP Q \<Longrightarrow> PROP R"
     assume P: "PROP P"
     show "PROP R"
       by (rule Q_R [OF P_Q [OF P]])
   qed
 
 lemma meta_spec:
   assumes "\<And>x. PROP P x"
   shows "PROP P x" by fact
 
 lemma meta_spec_protect:
   assumes g: "\<And>x. PROP P x"
   shows "PROP Pure.prop (PROP P x)"
 using g
 by (auto simp add: prop_def)
 
 lemma generaliseImp:
   assumes i: "PROP Pure.prop (PROP Pure.prop (Trueprop P) \<Longrightarrow> PROP Pure.prop (Trueprop Q))"
   shows "PROP Pure.prop (PROP Pure.prop (Trueprop (X \<longrightarrow> P)) \<Longrightarrow> PROP Pure.prop (Trueprop (X \<longrightarrow> Q)))"
   using i
   by (auto simp add: prop_def)
 
 lemma generaliseEx:
  assumes i: "PROP Pure.prop (\<And>s. PROP Pure.prop (Trueprop (P s)) \<Longrightarrow> PROP Pure.prop (Trueprop (Q s)))"
  shows "PROP Pure.prop (PROP Pure.prop (Trueprop (\<exists>s. P s)) \<Longrightarrow> PROP Pure.prop (Trueprop (\<exists>s. Q s)))"
   using i
   by (auto simp add: prop_def)
 
 
 lemma generaliseRefl: "PROP Pure.prop (PROP Pure.prop (Trueprop P) \<Longrightarrow> PROP Pure.prop (Trueprop P))"
   by (auto simp add: prop_def)
 
 lemma generaliseRefl': "PROP Pure.prop (PROP P \<Longrightarrow> PROP P)"
   by (auto simp add: prop_def)
 
 lemma generaliseAllShift:
   assumes i: "PROP Pure.prop (\<And>s. P \<Longrightarrow> Q s)"
   shows "PROP Pure.prop (PROP Pure.prop (Trueprop P) \<Longrightarrow> PROP Pure.prop (Trueprop (\<forall>s. Q s)))"
   using i
   by (auto simp add: prop_def)
 
 lemma generalise_allShift:
   assumes i: "PROP Pure.prop (\<And>s. PROP P \<Longrightarrow> PROP Q s)"
   shows "PROP Pure.prop (PROP Pure.prop (PROP P) \<Longrightarrow> PROP Pure.prop (\<And>s. PROP Q s))"
   using i
   proof (unfold prop_def)
     assume P_Q: "\<And>s. PROP P \<Longrightarrow> PROP Q s"
     assume P: "PROP P"
     show "\<And>s. PROP Q s"
       by (rule P_Q [OF P])
   qed
 
 
 lemma generaliseImpl:
   assumes i: "PROP Pure.prop (PROP Pure.prop P \<Longrightarrow> PROP Pure.prop Q)"
   shows "PROP Pure.prop ((PROP Pure.prop (PROP X \<Longrightarrow> PROP P)) \<Longrightarrow> (PROP Pure.prop (PROP X \<Longrightarrow> PROP Q)))"
   using i
   proof (unfold prop_def)
     assume i1: "PROP P \<Longrightarrow> PROP Q"
     assume i2: "PROP X \<Longrightarrow> PROP P"
     assume X: "PROP X"
     show "PROP Q"
       by (rule i1 [OF i2 [OF X]])
   qed
 
 
 ML_file \<open>generalise_state.ML\<close>
 
 end
 
diff --git a/thys/Simpl/HeapList.thy b/thys/Simpl/HeapList.thy
--- a/thys/Simpl/HeapList.thy
+++ b/thys/Simpl/HeapList.thy
@@ -1,297 +1,276 @@
 (*  Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HeapList.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>Paths and Lists in the Heap\<close>
 theory HeapList
 imports Simpl_Heap
 begin
 
 text \<open>Adapted from 'HOL/Hoare/Heap.thy'.\<close>
 
 
 subsection "Paths in The Heap"
 
 primrec
  Path :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref \<Rightarrow>  ref list  \<Rightarrow> bool"
 where
 "Path x h y [] = (x = y)" |
 "Path x h y (p#ps) = (x = p \<and> x \<noteq> Null \<and> Path (h x) h y ps)"
 
 lemma Path_Null_iff [iff]: "Path Null h y xs  = (xs = [] \<and> y = Null)"
 apply(case_tac xs)
 apply fastforce
 apply fastforce
 done
 
 lemma Path_not_Null_iff [simp]: "p\<noteq>Null \<Longrightarrow>
   Path p h q as = (as = [] \<and> q = p  \<or>  (\<exists>ps. as = p#ps \<and> Path (h p) h q ps ))"
 apply(case_tac as)
 apply fastforce
 apply fastforce
 done
 
 lemma Path_append [simp]:
   "\<And>p. Path p f q (as@bs)  = (\<exists>y. Path p f y as \<and> Path y f q bs)"
 by(induct as, simp+)
 
 lemma notin_Path_update[simp]:
  "\<And>p. u \<notin> set ps \<Longrightarrow> Path p (f(u := v)) q ps  = Path p f q ps "
 by(induct ps, simp, simp add:eq_sym_conv)
 
 lemma Path_upd_same [simp]:
   "Path p (f(p:=p)) q qs =
       ((p=Null \<and> q=Null \<and> qs = []) \<or> (p\<noteq>Null \<and> q=p \<and> (\<forall>x\<in>set qs. x=p)))"
 by (induct qs) auto
 
 text \<open>@{thm[source] Path_upd_same} prevents
 @{term "p\<noteq>Null \<Longrightarrow> Path p (f(p:=p)) q qs = X"} from looping, because of
 @{thm[source] Path_not_Null_iff} and @{thm[source]fun_upd_apply}.
 \<close>
 
 lemma notin_Path_updateI [intro]:
  "\<lbrakk>Path p h q ps ; r \<notin> set ps\<rbrakk> \<Longrightarrow> Path p (h(r := y)) q ps "
 by simp
 
 lemma Path_update_new [simp]: "\<lbrakk>set ps \<subseteq> set alloc\<rbrakk>
      \<Longrightarrow> Path p (f(new (set alloc) := x)) q ps  = Path p f q ps "
   by (rule notin_Path_update) fastforce
 
 lemma Null_notin_Path [simp,intro]:
 "\<And>p. Path p f q ps \<Longrightarrow> Null \<notin> set ps"
 by(induct ps) auto
 
 lemma Path_snoc:
  "\<lbrakk>Path p (f(a := q)) a as ; a\<noteq>Null\<rbrakk> \<Longrightarrow> Path p (f(a := q)) q (as @ [a])"
 by simp
 
 subsection "Lists on The Heap"
 
 subsubsection "Relational Abstraction"
 
 definition
  List :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref list \<Rightarrow> bool" where
 "List p h ps = Path p h Null ps "
 
 lemma List_empty [simp]: "List p h [] = (p = Null)"
 by(simp add:List_def)
 
 lemma List_cons [simp]: "List p h (a#ps) = (p = a \<and> p\<noteq>Null \<and> List (h p) h ps)"
 by(simp add:List_def)
 
 lemma List_Null [simp]: "List Null h ps = (ps = [])"
 by(case_tac ps, simp_all)
 
 lemma List_not_Null [simp]: "p\<noteq>Null \<Longrightarrow>
   List p h as = (\<exists>ps. as = p#ps \<and> List (h p) h ps)"
 by(case_tac as, simp_all, fast)
 
 
 lemma Null_notin_List [simp,intro]: "\<And>p. List p h ps \<Longrightarrow> Null \<notin> set ps"
 by (simp add : List_def)
 
 
 theorem notin_List_update[simp]:
  "\<And>p. q \<notin> set ps \<Longrightarrow> List p (h(q := y)) ps = List p h ps"
 apply(induct ps)
 apply simp
 apply clarsimp
 done
 
 lemma List_upd_same_lemma: "\<And>p.  p \<noteq> Null \<Longrightarrow> \<not> List p (h(p := p)) ps"
 apply (induct ps)
 apply  simp
 apply (simp (no_asm_simp) del: fun_upd_apply)
 apply (simp (no_asm_simp) only: fun_upd_apply refl if_True)
 apply blast
 done
 
 lemma List_upd_same [simp]: "List p (h(p:=p)) ps = (p = Null \<and> ps = [])"
 apply (cases "p=Null")
 apply  simp
 apply (fast dest: List_upd_same_lemma)
 done
 
 text \<open>@{thm[source] List_upd_same} prevents
 @{term "p\<noteq>Null \<Longrightarrow> List p (h(p:=p)) as = X"} from looping, because of
 @{thm[source] List_not_Null} and @{thm[source] fun_upd_apply}.
 \<close>
 
 lemma  List_update_new [simp]: "\<lbrakk>set ps \<subseteq> set alloc\<rbrakk>
      \<Longrightarrow> List p (h(new (set alloc) := x)) ps = List p h ps"
 by (rule notin_List_update) fastforce
 
 lemma List_updateI [intro]:
  "\<lbrakk>List p h ps; q \<notin> set ps\<rbrakk> \<Longrightarrow> List p (h(q := y)) ps"
 by simp
 
 lemma List_unique: "\<And>p bs. List p h as \<Longrightarrow> List p h bs \<Longrightarrow> as = bs"
 by(induct as, simp, clarsimp)
 
 lemma List_unique1: "List p h as \<Longrightarrow> \<exists>!as. List p h as"
 by(blast intro:List_unique)
 
 lemma List_app: "\<And>p. List p h (as@bs) = (\<exists>y. Path p h y as \<and> List y h bs)"
 by(induct as, simp, clarsimp)
 
 lemma List_hd_not_in_tl[simp]: "List (h p) h ps \<Longrightarrow> p \<notin> set ps"
 apply (clarsimp simp add:in_set_conv_decomp)
 apply(frule List_app[THEN iffD1])
 apply(fastforce dest: List_unique)
 done
 
 lemma List_distinct[simp]: "\<And>p. List p h ps \<Longrightarrow> distinct ps"
 apply(induct ps, simp)
 apply(fastforce dest:List_hd_not_in_tl)
 done
 
 lemma heap_eq_List_eq:
   "\<And>p. \<forall>x \<in> set ps. h x = g x \<Longrightarrow> List p h ps = List p g ps"
   by (induct ps) auto
 
 
 lemma heap_eq_ListI:
   assumes list: "List p h ps"
   assumes hp_eq: "\<forall>x \<in> set ps. h x = g x"
   shows "List p g ps"
   using list
   by (simp add: heap_eq_List_eq [OF hp_eq])
 
 
 lemma heap_eq_ListI1:
   assumes list: "List p h ps"
   assumes hp_eq: "\<forall>x \<in> set ps. g x = h x"
   shows "List p g ps"
   using list
   by (simp add: heap_eq_List_eq [OF hp_eq])
 
 
 text \<open>The following lemmata are usefull for the simplifier to instantiate
 bound variables in the assumptions resp. conclusion, using the uniqueness
 of the List predicate\<close>
 
 lemma conj_impl_simp: "(P \<and> Q \<longrightarrow> K) = (P \<longrightarrow> Q \<longrightarrow> K)"
 by auto
 
 lemma  List_unique_all_impl_simp [simp]:
  "List p h ps \<Longrightarrow> (\<forall>ps. List p h ps \<longrightarrow> P ps) = P ps"
 by (auto dest: List_unique)
 
 (*
 lemma  List_unique_all_impl_simp1 [simp]:
  "List p h ps \<Longrightarrow> (\<forall>ps. Q ps \<longrightarrow> List p h ps \<longrightarrow> P ps) = Q ps \<longrightarrow> P ps"
 by (auto dest: List_unique)
 *)
 lemma List_unique_ex_conj_simp [simp]:
 "List p h ps \<Longrightarrow> (\<exists>ps. List p h ps \<and> P ps) = P ps"
 by (auto dest: List_unique)
 
 
 
 subsection "Functional abstraction"
 
 definition
  islist :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> bool" where
 "islist p h = (\<exists>ps. List p h ps)"
 
 definition
  list :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref list" where
 "list p h = (THE ps. List p h ps)"
 
 lemma List_conv_islist_list: "List p h ps = (islist p h \<and> ps = list p h)"
 apply(simp add:islist_def list_def)
 apply(rule iffI)
 apply(rule conjI)
 apply blast
 apply(subst the1_equality)
   apply(erule List_unique1)
  apply assumption
 apply(rule refl)
 apply simp
 apply (clarify)
 apply (rule theI)
 apply  assumption
 by (rule List_unique)
 
 
 lemma List_islist [intro]:
   "List p h ps \<Longrightarrow> islist p h"
   apply (simp add: List_conv_islist_list)
   done
 
 lemma List_list:
   "List p h ps \<Longrightarrow> list p h = ps"
   apply (simp only: List_conv_islist_list)
   done
 
 
 lemma [simp]: "islist Null h"
 by(simp add:islist_def)
 
 lemma [simp]: "p\<noteq>Null \<Longrightarrow> islist (h p) h = islist p h"
 by(simp add:islist_def)
 
 lemma [simp]: "list Null h = []"
 by(simp add:list_def)
 
 lemma list_Ref_conv[simp]:
  "\<lbrakk>islist (h p) h; p\<noteq>Null \<rbrakk> \<Longrightarrow> list p h = p # list (h p) h"
 apply(insert List_not_Null[of _ h])
 apply(fastforce simp:List_conv_islist_list)
 done
 
 lemma [simp]: "islist (h p) h \<Longrightarrow> p \<notin> set(list (h p) h)"
 apply(insert List_hd_not_in_tl[of h])
 apply(simp add:List_conv_islist_list)
 done
 
 lemma list_upd_conv[simp]:
  "islist p h \<Longrightarrow> y \<notin> set(list p h) \<Longrightarrow> list p (h(y := q)) = list p h"
 apply(drule notin_List_update[of _ _ p h q])
 apply(simp add:List_conv_islist_list)
 done
 
 lemma islist_upd[simp]:
  "islist p h \<Longrightarrow> y \<notin> set(list p h) \<Longrightarrow> islist p (h(y := q))"
 apply(frule notin_List_update[of _ _ p h q])
 apply(simp add:List_conv_islist_list)
 done
 
 lemma list_distinct[simp]: "islist p h \<Longrightarrow> distinct (list p h)"
 apply (clarsimp simp add: list_def islist_def)
 apply (frule List_unique1)
 apply (drule (1) the1_equality)
 apply simp
 done
 
 lemma Null_notin_list [simp,intro]: "islist p h \<Longrightarrow> Null \<notin> set (list p h)"
 apply (clarsimp simp add: list_def islist_def)
 apply (frule List_unique1)
 apply (drule (1) the1_equality)
 apply simp
 done
 
 end
diff --git a/thys/Simpl/Hoare.thy b/thys/Simpl/Hoare.thy
--- a/thys/Simpl/Hoare.thy
+++ b/thys/Simpl/Hoare.thy
@@ -1,424 +1,403 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Hoare.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>Auxiliary Definitions/Lemmas to Facilitate Hoare Logic\<close>
 theory Hoare imports HoarePartial HoareTotal begin
 
 
 syntax
 
 "_hoarep_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,
    'f set,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_,_/\<turnstile> (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoarep_emptyCtx"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_/\<turnstile>\<^bsub>'/_\<^esub> (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoarep_emptyCtx_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_/\<turnstile> (_/ (_)/ _,/_))" [61,1000,20,1000,1000]60)
 
 "_hoarep_noAbr"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'f set,
     's assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_,_/\<turnstile>\<^bsub>'/_\<^esub> (_/ (_)/ _))" [61,60,60,1000,20,1000]60)
 
 "_hoarep_noAbr_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'s assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_,_/\<turnstile> (_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoarep_emptyCtx_noAbr"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_/\<turnstile>\<^bsub>'/_\<^esub> (_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoarep_emptyCtx_noAbr_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_/\<turnstile> (_/ (_)/ _))" [61,1000,20,1000]60)
 
 
 
 "_hoaret_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,
     's assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_,_/\<turnstile>\<^sub>t (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoaret_emptyCtx"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_/\<turnstile>\<^sub>t\<^bsub>'/_\<^esub> (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoaret_emptyCtx_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_/\<turnstile>\<^sub>t (_/ (_)/ _,/_))" [61,1000,20,1000,1000]60)
 
 "_hoaret_noAbr"::
 "[('s,'p,'f) body,'f set, ('s,'p) quadruple set,
     's assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_,_/\<turnstile>\<^sub>t\<^bsub>'/_\<^esub> (_/ (_)/ _))" [61,60,60,1000,20,1000]60)
 
 "_hoaret_noAbr_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'s assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_,_/\<turnstile>\<^sub>t (_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoaret_emptyCtx_noAbr"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_/\<turnstile>\<^sub>t\<^bsub>'/_\<^esub> (_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoaret_emptyCtx_noAbr_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn] => bool"
     ("(3_/\<turnstile>\<^sub>t (_/ (_)/ _))" [61,1000,20,1000]60)
 
 
 syntax (ASCII)
 
 "_hoarep_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,
      's assn,('s,'p,'f) com, 's assn,'s assn] \<Rightarrow> bool"
    ("(3_,_/|- (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoarep_emptyCtx"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
    ("(3_/|-'/_ (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoarep_emptyCtx_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
    ("(3_/|-(_/ (_)/ _,/_))" [61,1000,20,1000,1000]60)
 
 "_hoarep_noAbr"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'f set,
    's assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_,_/|-'/_ (_/ (_)/ _))" [61,60,60,1000,20,1000]60)
 
 "_hoarep_noAbr_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'s assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_,_/|-(_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoarep_emptyCtx_noAbr"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_/|-'/_ (_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoarep_emptyCtx_noAbr_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_/|-(_/ (_)/ _))" [61,1000,20,1000]60)
 
 "_hoaret_emptyFault"::
 "[('s,'p,'f) body,('s,'p) quadruple set,
      's assn,('s,'p,'f) com, 's assn,'s assn] => bool"
    ("(3_,_/|-t (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoaret_emptyCtx"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
    ("(3_/|-t'/_ (_/ (_)/ _,/_))" [61,60,1000,20,1000,1000]60)
 
 "_hoaret_emptyCtx_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn,'s assn] => bool"
    ("(3_/|-t(_/ (_)/ _,/_))" [61,1000,20,1000,1000]60)
 
 "_hoaret_noAbr"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'f set,
    's assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_,_/|-t'/_ (_/ (_)/ _))" [61,60,60,1000,20,1000]60)
 
 "_hoaret_noAbr_emptyFaults"::
 "[('s,'p,'f) body,('s,'p) quadruple set,'s assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_,_/|-t(_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoaret_emptyCtx_noAbr"::
 "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_/|-t'/_ (_/ (_)/ _))" [61,60,1000,20,1000]60)
 
 "_hoaret_emptyCtx_noAbr_emptyFaults"::
 "[('s,'p,'f) body,'s assn,('s,'p,'f) com, 's assn] => bool"
    ("(3_/|-t(_/ (_)/ _))" [61,1000,20,1000]60)
 
 translations
 
 
  "\<Gamma>\<turnstile> P c Q,A"  == "\<Gamma>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
  "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"  == "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 
  "\<Gamma>,\<Theta>\<turnstile> P c Q"  == "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q"
  "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q"  == "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,{}"
  "\<Gamma>,\<Theta>\<turnstile> P c Q,A" == "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 
  "\<Gamma>\<turnstile> P c Q"    ==  "\<Gamma>\<turnstile>\<^bsub>/{}\<^esub> P c Q"
  "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> P c Q"  == "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q"
  "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> P c Q"  <=  "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> P c Q,{}"
  "\<Gamma>\<turnstile> P c Q"    <=  "\<Gamma>\<turnstile> P c Q,{}"
 
 
 
 
  "\<Gamma>\<turnstile>\<^sub>t P c Q,A"   == "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
  "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"  == "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 
  "\<Gamma>,\<Theta>\<turnstile>\<^sub>t P c Q"   == "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q"
  "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q" == "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,{}"
  "\<Gamma>,\<Theta>\<turnstile>\<^sub>t P c Q,A"   == "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 
  "\<Gamma>\<turnstile>\<^sub>t P c Q"    == "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q"
  "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q"  == "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q"
  "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q"  <=  "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,{}"
  "\<Gamma>\<turnstile>\<^sub>t P c Q"    <=  "\<Gamma>\<turnstile>\<^sub>t P c Q,{}"
 
 
 term "\<Gamma>\<turnstile> P c Q"
 term "\<Gamma>\<turnstile> P c Q,A"
 
 term "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> P c Q"
 term "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 
 term "\<Gamma>,\<Theta>\<turnstile> P c Q"
 term "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q"
 
 term "\<Gamma>,\<Theta>\<turnstile> P c Q,A"
 term "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 
 
 term "\<Gamma>\<turnstile>\<^sub>t P c Q"
 term "\<Gamma>\<turnstile>\<^sub>t P c Q,A"
 
 term "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q"
 term "\<Gamma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 
 term "\<Gamma>,\<Theta>\<turnstile> P c Q"
 term "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q"
 
 term "\<Gamma>,\<Theta>\<turnstile> P c Q,A"
 term "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 
 
 locale hoare =
   fixes \<Gamma>::"('s,'p,'f) body"
 
 
 primrec assoc:: "('a \<times>'b) list \<Rightarrow> 'a \<Rightarrow> 'b "
 where
 "assoc [] x = undefined" |
 "assoc (p#ps) x = (if fst p = x then (snd p) else assoc ps x)"
 
 lemma conjE_simp: "(P \<and> Q \<Longrightarrow> PROP R) \<equiv> (P \<Longrightarrow> Q \<Longrightarrow> PROP R)"
   by rule simp_all
 
 lemma CollectInt_iff: "{s. P s} \<inter> {s. Q s} = {s. P s \<and> Q s}"
   by auto
 
 lemma Compl_Collect:"-(Collect b) = {x. \<not>(b x)}"
   by fastforce
 
 lemma Collect_False: "{s. False} = {}"
   by simp
 
 lemma Collect_True: "{s. True} = UNIV"
   by simp
 
 lemma triv_All_eq: "\<forall>x. P \<equiv> P"
   by simp
 
 lemma triv_Ex_eq: "\<exists>x. P \<equiv> P"
   by simp
 
 lemma Ex_True: "\<exists>b. b"
    by blast
 
 lemma Ex_False: "\<exists>b. \<not>b"
   by blast
 
 definition mex::"('a \<Rightarrow> bool) \<Rightarrow> bool"
   where "mex P = Ex P"
 
 definition meq::"'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "meq s Z = (s = Z)"
 
 lemma subset_unI1: "A \<subseteq> B \<Longrightarrow> A \<subseteq> B \<union> C"
   by blast
 
 lemma subset_unI2: "A \<subseteq> C \<Longrightarrow> A \<subseteq> B \<union> C"
   by blast
 
 lemma split_paired_UN: "(\<Union>p. (P p)) = (\<Union>a b. (P (a,b)))"
   by auto
 
 lemma in_insert_hd: "f \<in> insert f X"
   by simp
 
 lemma lookup_Some_in_dom: "\<Gamma> p = Some bdy \<Longrightarrow> p \<in> dom \<Gamma>"
   by auto
 
 lemma unit_object: "(\<forall>u::unit. P u) = P ()"
   by auto
 
 lemma unit_ex: "(\<exists>u::unit. P u) = P ()"
   by auto
 
 lemma unit_meta: "(\<And>(u::unit). PROP P u) \<equiv> PROP P ()"
   by auto
 
 lemma unit_UN: "(\<Union>z::unit. P z) = P ()"
   by auto
 
 lemma subset_singleton_insert1: "y = x \<Longrightarrow> {y} \<subseteq> insert x A"
   by auto
 
 lemma subset_singleton_insert2: "{y} \<subseteq> A \<Longrightarrow> {y} \<subseteq> insert x A"
   by auto
 
 lemma in_Specs_simp: "(\<forall>x\<in>\<Union>Z. {(P Z, p, Q Z, A Z)}. Prop x) =
        (\<forall>Z. Prop (P Z,p,Q Z,A Z))"
   by auto
 
 lemma in_set_Un_simp: "(\<forall>x\<in>A \<union> B. P x) = ((\<forall>x \<in> A. P x) \<and> (\<forall>x \<in> B. P x))"
   by auto
 
 lemma split_all_conj: "(\<forall>x. P x \<and> Q x) = ((\<forall>x. P x) \<and> (\<forall>x. Q x))"
   by blast
 
 lemma image_Un_single_simp: "f ` (\<Union>Z. {P Z}) = (\<Union>Z. {f (P Z)}) "
   by auto
 
 
 
 lemma measure_lex_prod_def':
   "f <*mlex*> r \<equiv> ({(x,y). (x,y) \<in> measure f \<or> f x=f y \<and> (x,y) \<in>  r})"
   by (auto simp add: mlex_prod_def inv_image_def)
 
 lemma in_measure_iff: "(x,y) \<in> measure f = (f x < f y)"
   by (simp add: measure_def inv_image_def)
 
 lemma in_lex_iff:
   "((a,b),(x,y)) \<in> r <*lex*> s = ((a,x) \<in> r \<or> (a=x \<and> (b,y)\<in>s))"
   by (simp add: lex_prod_def)
 
 lemma in_mlex_iff:
   "(x,y) \<in> f <*mlex*> r = (f x < f y \<or> (f x=f y \<and> (x,y) \<in> r))"
   by (simp add: measure_lex_prod_def' in_measure_iff)
 
 lemma in_inv_image_iff: "(x,y) \<in> inv_image r f = ((f x, f y) \<in> r)"
   by (simp add: inv_image_def)
 
 text \<open>This is actually the same as @{thm [source] wf_mlex}. However, this basic
 proof took me so long that I'm not willing to delete it.
 \<close>
 lemma wf_measure_lex_prod [simp,intro]:
   assumes wf_r: "wf r"
   shows "wf (f <*mlex*> r)"
 proof (rule ccontr)
   assume " \<not> wf (f <*mlex*> r)"
   then
   obtain g where "\<forall>i. (g (Suc i), g i) \<in> f <*mlex*> r"
     by (auto simp add: wf_iff_no_infinite_down_chain)
   hence g: "\<forall>i. (g (Suc i), g i) \<in> measure f \<or>
     f (g (Suc i)) = f (g i) \<and> (g (Suc i), g i) \<in> r"
     by (simp add: measure_lex_prod_def')
   hence le_g: "\<forall>i. f (g (Suc i)) \<le> f (g i)"
     by (auto simp add: in_measure_iff order_le_less)
   have "wf (measure f)"
     by simp
   hence " \<forall>Q. (\<exists>x. x \<in> Q) \<longrightarrow> (\<exists>z\<in>Q. \<forall>y. (y, z) \<in> measure f \<longrightarrow> y \<notin> Q)"
     by (simp add: wf_eq_minimal)
   from this [rule_format, of "g ` UNIV"]
   have "\<exists>z. z \<in> range g \<and> (\<forall>y. (y, z) \<in> measure f \<longrightarrow> y \<notin> range g)"
     by auto
   then obtain z where
     z: "z \<in> range g" and
     min_z: "\<forall>y. f y < f z \<longrightarrow> y \<notin> range g"
     by (auto simp add: in_measure_iff)
   from z obtain k where
     k: "z = g k"
     by auto
   have "\<forall>i. k \<le> i \<longrightarrow> f (g i) = f (g k)"
   proof (intro allI impI)
     fix i
     assume "k \<le> i" then show "f (g i) = f (g k)"
     proof (induct i)
       case 0
       have "k \<le> 0" by fact hence "k = 0" by simp
       thus "f (g 0) = f (g k)"
         by simp
     next
       case (Suc n)
       have k_Suc_n: "k \<le> Suc n" by fact
       then show "f (g (Suc n)) = f (g k)"
       proof (cases "k = Suc n")
         case True
         thus ?thesis by simp
       next
         case False
         with k_Suc_n
         have "k \<le> n"
           by simp
         with Suc.hyps
         have n_k: "f (g n) = f (g k)" by simp
         from le_g have le: "f (g (Suc n)) \<le> f (g n)"
           by simp
         show ?thesis
         proof (cases "f (g (Suc n)) = f (g n)")
           case True with n_k show ?thesis by simp
         next
           case False
           with le have "f (g (Suc n)) < f (g n)"
             by simp
           with n_k k have "f (g (Suc n)) < f z"
             by simp
           with min_z have "g (Suc n) \<notin> range g"
             by blast
           hence False by simp
           thus ?thesis
             by simp
         qed
       qed
     qed
   qed
   with k [symmetric] have "\<forall>i. k \<le> i \<longrightarrow> f (g i) = f z"
     by simp
   hence "\<forall>i. k \<le> i \<longrightarrow> f (g (Suc i)) = f (g i)"
     by simp
   with g have "\<forall>i. k \<le> i \<longrightarrow> (g (Suc i),(g i)) \<in> r"
     by (auto simp add: in_measure_iff order_less_le )
   hence "\<forall>i. (g (Suc (i+k)),(g (i+k))) \<in> r"
     by simp
   then
   have "\<exists>f. \<forall>i. (f (Suc i), f i) \<in> r"
     by - (rule exI [where x="\<lambda>i. g (i+k)"],simp)
   with wf_r show False
     by (simp add: wf_iff_no_infinite_down_chain)
 qed
 
 lemmas all_imp_to_ex = all_simps (5)
 (*"\<And>P Q. (\<forall>x. P x \<longrightarrow> Q) = ((\<exists>x. P x) \<longrightarrow> Q)"
 
  Avoid introduction of existential quantification of states on negative
  position.
 *)
 
 lemma all_imp_eq_triv: "(\<forall>x. x = k \<longrightarrow> Q) = Q"
                        "(\<forall>x. k = x \<longrightarrow> Q) = Q"
   by auto
 
 end
diff --git a/thys/Simpl/HoarePartial.thy b/thys/Simpl/HoarePartial.thy
--- a/thys/Simpl/HoarePartial.thy
+++ b/thys/Simpl/HoarePartial.thy
@@ -1,1212 +1,1420 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HoarePartial.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>Derived Hoare Rules for Partial Correctness\<close>
 
 theory HoarePartial imports HoarePartialProps begin
 
 lemma conseq_no_aux:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A';
     \<forall>s. s \<in> P \<longrightarrow> (s\<in>P' \<and> (Q' \<subseteq> Q) \<and> (A' \<subseteq> A))\<rbrakk>
   \<Longrightarrow>
   \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (rule conseq [where P'="\<lambda>Z. P'" and Q'="\<lambda>Z. Q'" and A'="\<lambda>Z. A'"]) auto
 
 
 lemma conseq_exploit_pre:
              "\<lbrakk>\<forall>s \<in> P. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s} \<inter> P) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (rule Conseq)
   apply clarify
   apply (rule_tac x="{s} \<inter> P" in exI)
   apply (rule_tac x="Q" in exI)
   apply (rule_tac x="A" in exI)
   by simp
 
 
 lemma conseq:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
               \<forall>s. s \<in> P \<longrightarrow> (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A))\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (rule Conseq') blast
 
 lemma Lem: "\<lbrakk>\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
              P \<subseteq> {s. \<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A)}\<rbrakk>
              \<Longrightarrow>
              \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (lem x c) Q,A"
   apply (unfold lem_def)
   apply (erule conseq)
   apply blast
   done
 
 lemma LemAnno:
 assumes conseq:  "P \<subseteq> {s. \<exists>Z. s\<in>P' Z \<and>
                      (\<forall>t. t \<in> Q' Z \<longrightarrow> t \<in> Q) \<and> (\<forall>t. t \<in> A' Z \<longrightarrow> t \<in> A)}"
 assumes lem: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (lem x c) Q,A"
   apply (rule Lem [OF lem])
   using conseq
   by blast
 
 lemma LemAnnoNoAbrupt:
 assumes conseq:  "P \<subseteq>  {s. \<exists>Z. s\<in>P' Z \<and> (\<forall>t. t \<in> Q' Z \<longrightarrow> t \<in> Q)}"
 assumes lem: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),{}"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (lem x c) Q,{}"
   apply (rule Lem [OF lem])
   using conseq
   by blast
 
 lemma TrivPost: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)
                  \<Longrightarrow>
                  \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c UNIV,UNIV"
 apply (rule allI)
 apply (erule conseq)
 apply auto
 done
 
 lemma TrivPostNoAbr: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),{}
                  \<Longrightarrow>
                  \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c UNIV,{}"
 apply (rule allI)
 apply (erule conseq)
 apply auto
 done
 
 lemma conseq_under_new_pre:"\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P' c Q',A';
         \<forall>s \<in> P. s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A\<rbrakk>
 \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P c Q,A"
 apply (rule conseq)
 apply (rule allI)
 apply assumption
 apply auto
 done
 
 lemma conseq_Kleymann:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
               \<forall>s \<in> P. (\<exists>Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A))\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (rule Conseq') blast
 
 lemma DynComConseq:
   assumes "P \<subseteq> {s. \<exists>P' Q' A'.  \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P' (c s) Q',A' \<and> P \<subseteq> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P DynCom c Q,A"
   using assms
   apply -
   apply (rule DynCom)
   apply clarsimp
   apply (rule Conseq)
   apply clarsimp
   apply blast
   done
 
 lemma SpecAnno:
  assumes consequence: "P \<subseteq> {s. (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A))}"
  assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) (c Z) (Q' Z),(A' Z)"
  assumes bdy_constant:  "\<forall>Z. c Z = c undefined"
  shows   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (specAnno P' c Q' A') Q,A"
 proof -
   from spec bdy_constant
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ((P' Z)) (c undefined) (Q' Z),(A' Z)"
     apply -
     apply (rule allI)
     apply (erule_tac x=Z in allE)
     apply (erule_tac x=Z in allE)
     apply simp
     done
   with consequence show ?thesis
     apply (simp add: specAnno_def)
     apply (erule conseq)
     apply blast
     done
 qed
 
 lemma SpecAnno':
  "\<lbrakk>P \<subseteq> {s.  \<exists> Z. s\<in>P' Z \<and>
             (\<forall>t. t \<in> Q' Z \<longrightarrow>  t \<in> Q) \<and> (\<forall>t. t \<in> A' Z \<longrightarrow> t \<in>  A)};
    \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) (c Z) (Q' Z),(A' Z);
    \<forall>Z. c Z = c undefined
   \<rbrakk> \<Longrightarrow>
     \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (specAnno P' c Q' A') Q,A"
 apply (simp only: subset_iff [THEN sym])
 apply (erule (1) SpecAnno)
 apply assumption
 done
 
 
 lemma SpecAnnoNoAbrupt:
  "\<lbrakk>P \<subseteq> {s.  \<exists> Z. s\<in>P' Z \<and>
             (\<forall>t. t \<in> Q' Z \<longrightarrow>  t \<in> Q)};
    \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) (c Z) (Q' Z),{};
    \<forall>Z. c Z = c undefined
   \<rbrakk> \<Longrightarrow>
     \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (specAnno P' c Q' (\<lambda>s. {})) Q,A"
 apply (rule SpecAnno')
 apply auto
 done
 
 lemma Skip: "P \<subseteq> Q \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Skip Q,A"
   by (rule hoarep.Skip [THEN conseqPre],simp)
 
 lemma Basic: "P \<subseteq> {s. (f s) \<in> Q} \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Basic f) Q,A"
   by (rule hoarep.Basic [THEN conseqPre])
 
 lemma BasicCond:
   "\<lbrakk>P \<subseteq> {s. (b s \<longrightarrow> f s\<in>Q) \<and> (\<not> b s \<longrightarrow> g s\<in>Q)}\<rbrakk> \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Basic (\<lambda>s. if b s then f s else g s) Q,A"
   apply (rule Basic)
   apply auto
   done
 
 lemma Spec: "P \<subseteq> {s. (\<forall>t. (s,t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s,t) \<in> r)}
             \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Spec r) Q,A"
 by (rule hoarep.Spec [THEN conseqPre])
 
 lemma SpecIf:
   "\<lbrakk>P \<subseteq> {s. (b s \<longrightarrow> f s \<in> Q) \<and> (\<not> b s \<longrightarrow> g s \<in> Q \<and> h s \<in> Q)}\<rbrakk> \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Spec (if_rel b f g h) Q,A"
   apply (rule Spec)
   apply (auto simp add: if_rel_def)
   done
 
 
 lemma Seq [trans, intro?]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Seq c\<^sub>1 c\<^sub>2) Q,A"
   by (rule hoarep.Seq)
 
+lemma SeqSame:
+  "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> Q c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Seq c\<^sub>1 c\<^sub>2) Q,A"
+  by (rule hoarep.Seq)
+
+
 lemma SeqSwap:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c2 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c1 R,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Seq c1 c2) Q,A"
   by (rule Seq)
 
 lemma BSeq:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (bseq c\<^sub>1 c\<^sub>2) Q,A"
   by (unfold bseq_def) (rule Seq)
 
+lemma BSeqSame:
+  "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> Q c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (bseq c\<^sub>1 c\<^sub>2) Q,A"
+  by (rule BSeq)
 
 lemma Cond:
   assumes wp: "P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P\<^sub>1 c\<^sub>1 Q,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P\<^sub>2 c\<^sub>2 Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 proof (rule hoarep.Cond [THEN conseqPre])
   from deriv_c1
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. (s \<in> b \<longrightarrow> s \<in> P\<^sub>1) \<and> (s \<notin> b \<longrightarrow> s \<in> P\<^sub>2)} \<inter> b) c\<^sub>1 Q,A"
     by (rule conseqPre) blast
 next
   from deriv_c2
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. (s \<in> b \<longrightarrow> s \<in> P\<^sub>1) \<and> (s \<notin> b \<longrightarrow> s \<in> P\<^sub>2)} \<inter> - b) c\<^sub>2 Q,A"
     by (rule conseqPre) blast
 next
   show "P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}" by (rule wp)
 qed
 
 
 lemma CondSwap:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P1 c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P2 c2 Q,A; P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P1) \<and> (s\<notin>b \<longrightarrow> s\<in>P2)}\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c1 c2) Q,A"
   by (rule Cond)
 
 lemma Cond':
   "\<lbrakk>P \<subseteq> {s. (b \<subseteq> P1) \<and> (- b \<subseteq> P2)};\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P1 c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P2 c2 Q,A\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c1 c2) Q,A"
   by (rule CondSwap) blast+
 
 lemma CondInv:
   assumes wp: "P \<subseteq> Q"
   assumes inv: "Q \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P\<^sub>1 c\<^sub>1 Q,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P\<^sub>2 c\<^sub>2 Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 proof -
   from wp inv
   have "P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
     by blast
   from Cond [OF this deriv_c1 deriv_c2]
   show ?thesis .
 qed
 
 lemma CondInv':
   assumes wp: "P \<subseteq> I"
   assumes inv: "I \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
   assumes wp': "I \<subseteq> Q"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P\<^sub>1 c\<^sub>1 I,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P\<^sub>2 c\<^sub>2 I,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 proof -
   from CondInv [OF wp inv deriv_c1 deriv_c2]
   have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) I,A".
   from conseqPost [OF this wp' subset_refl]
   show ?thesis .
 qed
 
 
 lemma switchNil:
   "P \<subseteq> Q \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P (switch v []) Q,A"
   by (simp add: Skip)
 
 lemma switchCons:
   "\<lbrakk>P \<subseteq> {s. (v s \<in> V \<longrightarrow> s \<in> P\<^sub>1) \<and> (v s \<notin> V \<longrightarrow> s \<in> P\<^sub>2)};
         \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P\<^sub>1 c Q,A;
         \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P\<^sub>2 (switch v vs) Q,A\<rbrakk>
 \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P (switch v ((V,c)#vs)) Q,A"
   by (simp add: Cond)
 
 lemma Guard:
  "\<lbrakk>P \<subseteq> g \<inter> R; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 apply (rule Guard [THEN conseqPre, of _ _ _ _ R])
 apply (erule conseqPre)
 apply auto
 done
 
 lemma GuardSwap:
  "\<lbrakk> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> g \<inter> R\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
   by (rule Guard)
 
 lemma Guarantee:
  "\<lbrakk>P \<subseteq> {s. s \<in> g \<longrightarrow> s \<in> R}; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 apply (rule Guarantee [THEN conseqPre, of _ _ _ _ _ "{s. s \<in> g \<longrightarrow> s \<in> R}"])
 apply   assumption
 apply  (erule conseqPre)
 apply auto
 done
 
 lemma GuaranteeSwap:
  "\<lbrakk> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> {s. s \<in> g \<longrightarrow> s \<in> R}; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
   by (rule Guarantee)
 
 lemma GuardStrip:
  "\<lbrakk>P \<subseteq> R; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 apply (rule Guarantee [THEN conseqPre])
 apply auto
 done
 
+lemma GuardStripSame:
+ "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A; f \<in> F\<rbrakk>
+  \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
+  by (rule GuardStrip [OF subset_refl])
+
 lemma GuardStripSwap:
  "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> R; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
   by (rule GuardStrip)
 
 lemma GuaranteeStrip:
  "\<lbrakk>P \<subseteq> R; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guaranteeStrip f g c) Q,A"
   by (unfold guaranteeStrip_def) (rule GuardStrip)
 
 lemma GuaranteeStripSwap:
  "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> R; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guaranteeStrip f g c) Q,A"
   by (unfold guaranteeStrip_def) (rule GuardStrip)
 
 lemma GuaranteeAsGuard:
  "\<lbrakk>P \<subseteq> g \<inter> R; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guaranteeStrip f g c) Q,A"
   by (unfold guaranteeStrip_def) (rule Guard)
 
 
 lemma GuaranteeAsGuardSwap:
  "\<lbrakk> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> g \<inter> R\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guaranteeStrip f g c) Q,A"
   by (rule GuaranteeAsGuard)
 
 lemma GuardsNil:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guards [] c) Q,A"
   by simp
 
 lemma GuardsCons:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Guard f g (guards gs c) Q,A \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guards ((f,g)#gs) c) Q,A"
   by simp
 
 lemma GuardsConsGuaranteeStrip:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P guaranteeStrip f g (guards gs c) Q,A \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guards (guaranteeStripPair f g#gs) c) Q,A"
   by (simp add: guaranteeStripPair_def guaranteeStrip_def)
 
 lemma While:
   assumes P_I: "P \<subseteq> I"
   assumes deriv_body: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I \<inter> b) c I,A"
   assumes I_Q: "I \<inter> -b \<subseteq> Q"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnno b I V c) Q,A"
 proof -
   from deriv_body P_I I_Q
   show ?thesis
     apply (simp add: whileAnno_def)
     apply (erule conseqPrePost [OF HoarePartialDef.While])
     apply simp_all
     done
 qed
 
 text \<open>@{term "J"} will be instantiated by tactic with @{term "gs' \<inter> I"} for
   those guards that are not stripped.\<close>
 lemma  WhileAnnoG:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guards gs
                     (whileAnno  b J V (Seq c (guards gs Skip)))) Q,A
         \<Longrightarrow>
         \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoG gs b I V c) Q,A"
   by (simp add: whileAnnoG_def whileAnno_def while_def)
 
 
 text \<open>This form stems from @{term "strip_guards F (whileAnnoG gs b I V c)"}\<close>
 
 lemma WhileNoGuard':
   assumes P_I: "P \<subseteq> I"
   assumes deriv_body: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I \<inter> b) c I,A"
   assumes I_Q: "I \<inter> -b \<subseteq> Q"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnno b I V (Seq c Skip)) Q,A"
   apply (rule While [OF P_I _ I_Q])
   apply (rule Seq)
   apply  (rule deriv_body)
   apply (rule hoarep.Skip)
   done
 
 lemma WhileAnnoFix:
 assumes consequence: "P \<subseteq> {s. (\<exists> Z. s\<in>I Z \<and> (I Z \<inter> -b \<subseteq> Q)) }"
 assumes bdy: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I Z \<inter> b) (c Z) (I Z),A"
 assumes bdy_constant:  "\<forall>Z. c Z = c undefined"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoFix b I V c) Q,A"
 proof -
   from bdy bdy_constant
   have bdy': "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I Z \<inter> b) (c undefined) (I Z),A"
     apply -
     apply (rule allI)
     apply (erule_tac x=Z in allE)
     apply (erule_tac x=Z in allE)
     apply simp
     done
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I Z) (whileAnnoFix b I V c) (I Z \<inter> -b),A"
     apply rule
     apply (unfold whileAnnoFix_def)
     apply (rule hoarep.While)
     apply (rule bdy' [rule_format])
     done
   then
   show ?thesis
     apply (rule conseq)
     using consequence
     by blast
 qed
 
 lemma WhileAnnoFix':
 assumes consequence: "P \<subseteq> {s. (\<exists> Z. s\<in>I Z \<and>
                                (\<forall>t. t \<in> I Z \<inter> -b \<longrightarrow> t \<in> Q)) }"
 assumes bdy: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I Z \<inter> b) (c Z) (I Z),A"
 assumes bdy_constant:  "\<forall>Z. c Z = c undefined"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoFix b I V c) Q,A"
   apply (rule WhileAnnoFix [OF _ bdy bdy_constant])
   using consequence by blast
 
 lemma WhileAnnoGFix:
 assumes whileAnnoFix:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (guards gs
                 (whileAnnoFix  b J V (\<lambda>Z. (Seq (c Z) (guards gs Skip))))) Q,A"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoGFix gs b I V c) Q,A"
   using whileAnnoFix
   by (simp add: whileAnnoGFix_def whileAnnoFix_def while_def)
 
 lemma Bind:
   assumes adapt: "P \<subseteq> {s. s \<in> P' s}"
   assumes c: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) (c (e s)) Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (bind e c) Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. s=Z \<and> s \<in> P' Z}" and Q'="\<lambda>Z. Q" and
 A'="\<lambda>Z. A"])
 apply  (rule allI)
 apply  (unfold bind_def)
 apply  (rule DynCom)
 apply  (rule ballI)
 apply  simp
 apply  (rule conseqPre)
 apply   (rule c [rule_format])
 apply  blast
 using adapt
 apply blast
 done
 
-lemma Block:
+lemma Block_exn:
 assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
-assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. return s t \<in> A}"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. result_exn (return s t) t \<in> A}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block_exn init bdy return result_exn c) Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. s=Z \<and> init s \<in> P' Z}" and Q'="\<lambda>Z. Q" and
 A'="\<lambda>Z. A"])
 prefer 2
 using adapt
 apply  blast
 apply (rule allI)
-apply (unfold block_def)
+apply (unfold block_exn_def)
 apply (rule DynCom)
 apply (rule ballI)
 apply clarsimp
 apply (rule_tac R="{t. return Z t \<in> R Z t}" in SeqSwap )
 apply  (rule_tac  P'="\<lambda>Z'. {t. t=Z' \<and> return Z t \<in> R Z t}" and
           Q'="\<lambda>Z'. Q" and A'="\<lambda>Z'. A" in conseq)
 prefer 2 apply simp
 apply  (rule allI)
 apply  (rule DynCom)
 apply  (clarsimp)
 apply  (rule SeqSwap)
 apply   (rule c [rule_format])
 apply  (rule Basic)
 apply  clarsimp
-apply (rule_tac R="{t. return Z t \<in> A}" in Catch)
+apply (rule_tac R="{t. result_exn (return Z t) t \<in> A}" in Catch)
 apply  (rule_tac R="{i. i \<in> P' Z}" in Seq)
 apply   (rule Basic)
 apply   clarsimp
 apply  simp
 apply  (rule bdy [rule_format])
 apply (rule SeqSwap)
 apply  (rule Throw)
 apply (rule Basic)
 apply simp
 done
 
+lemma Block:
+assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. return s t \<in> A}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+  unfolding block_def
+  by (rule Block_exn [OF adapt bdy c])
+
 
 lemma BlockSwap:
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. return s t \<in> A}"
 assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
 using adapt bdy c
   by (rule Block)
 
 
-lemma BlockSpec:
+lemma Block_exnSpec:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
-                             (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}"
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> (result_exn (return s t) t) \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes bdy: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) bdy (Q' Z),(A' Z)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block_exn init bdy return result_exn c) Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
-                             (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}" and Q'="\<lambda>Z. Q" and
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> (result_exn (return s t) t) \<in> A)}" and Q'="\<lambda>Z. Q" and
 A'="\<lambda>Z. A"])
 prefer 2
 using adapt
 apply  blast
 apply (rule allI)
-apply (unfold block_def)
+apply (unfold block_exn_def)
 apply (rule DynCom)
 apply (rule ballI)
 apply clarsimp
 apply (rule_tac R="{t. return s t \<in> R s t}" in SeqSwap )
 apply  (rule_tac  P'="\<lambda>Z'. {t. t=Z' \<and> return s t \<in> R s t}" and
           Q'="\<lambda>Z'. Q" and A'="\<lambda>Z'. A" in conseq)
 prefer 2 apply simp
 apply  (rule allI)
 apply  (rule DynCom)
 apply  (clarsimp)
 apply  (rule SeqSwap)
 apply   (rule c [rule_format])
 apply  (rule Basic)
 apply  clarsimp
-apply (rule_tac R="{t. return s t \<in> A}" in Catch)
+apply (rule_tac R="{t. (result_exn (return s t) t) \<in> A}" in Catch)
 apply  (rule_tac R="{i. i \<in> P' Z}" in Seq)
 apply   (rule Basic)
 apply   clarsimp
 apply  simp
 apply  (rule conseq [OF bdy])
 apply  clarsimp
 apply  blast
 apply (rule SeqSwap)
 apply  (rule Throw)
 apply (rule Basic)
 apply simp
-done
+  done
+
+lemma BlockSpec:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes bdy: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) bdy (Q' Z),(A' Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+  unfolding block_def
+  by (rule Block_exnSpec [OF adapt c bdy])
+
 
 lemma Throw: "P \<subseteq> A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Throw Q,A"
   by (rule hoarep.Throw [THEN conseqPre])
 
 lemmas Catch = hoarep.Catch
 lemma CatchSwap: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,R\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
   by (rule hoarep.Catch)
 
+lemma CatchSame: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> A c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
+  by (rule hoarep.Catch)
+
 lemma raise: "P \<subseteq> {s. f s \<in> A} \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P raise f Q,A"
   apply (simp add: raise_def)
   apply (rule Seq)
   apply  (rule Basic)
   apply  (assumption)
   apply (rule Throw)
   apply (rule subset_refl)
   done
 
 lemma condCatch: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,((b \<inter> R) \<union> (-b \<inter> A));\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk>
                   \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P condCatch c\<^sub>1 b c\<^sub>2 Q,A"
   apply (simp add: condCatch_def)
   apply (rule Catch)
   apply  assumption
   apply (rule CondSwap)
   apply   (assumption)
   apply  (rule hoarep.Throw)
   apply blast
   done
 
 lemma condCatchSwap: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A;\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,((b \<inter> R) \<union> (-b \<inter> A))\<rbrakk>
                   \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P condCatch c\<^sub>1 b c\<^sub>2 Q,A"
   by (rule condCatch)
 
+lemma condCatchSame:
+  assumes c1: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,A"
+  assumes c2: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> A c\<^sub>2 Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P condCatch c\<^sub>1 b c\<^sub>2 Q,A"
+proof -
+  have eq: "((b \<inter> A) \<union> (-b \<inter> A)) = A" by blast
+  show ?thesis
+    apply (rule condCatch [OF _ c2])
+    apply (simp add: eq)
+    apply (rule c1)
+    done
+qed
 
 lemma ProcSpec:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
                              (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 using adapt c p
 apply (unfold call_def)
 by (rule BlockSpec)
 
+lemma Proc_exnSpec:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+using adapt c p
+apply (unfold call_exn_def)
+  by (rule Block_exnSpec)
+
 lemma ProcSpec':
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t \<in> Q' Z. return s t \<in> R s t) \<and>
                              (\<forall>t \<in> A' Z. return s t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 apply (rule ProcSpec [OF _ c p])
 apply (insert adapt)
 apply clarsimp
 apply (drule (1) subsetD)
 apply (clarsimp)
 apply (rule_tac x=Z in exI)
 apply blast
 done
 
+lemma Proc_exnSpecNoAbrupt:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule Proc_exnSpec [OF _ c p])
+using adapt
+apply simp
+  done
+
 lemma ProcSpecNoAbrupt:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),{}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 apply (rule ProcSpec [OF _ c p])
 using adapt
 apply simp
 done
 
 lemma FCall:
 "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return (\<lambda>s t. c (result t))) Q,A
 \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (fcall init p return result c) Q,A"
   by (simp add: fcall_def)
 
 
 lemma ProcRec:
   assumes deriv_bodies:
    "\<forall>p\<in>Procs.
     \<forall>Z. \<Gamma>,\<Theta>\<union>(\<Union>p\<in>Procs. \<Union>Z. {(P p Z,p,Q p Z,A p Z)})
         \<turnstile>\<^bsub>/F\<^esub> (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   assumes Procs_defined: "Procs \<subseteq> dom \<Gamma>"
   shows "\<forall>p\<in>Procs. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>(P p Z) Call p (Q p Z),(A p Z)"
   by (intro strip)
      (rule CallRec'
      [OF _   Procs_defined deriv_bodies],
      simp_all)
 
 lemma ProcRec':
   assumes ctxt: "\<Theta>' = \<Theta>\<union>(\<Union>p\<in>Procs. \<Union>Z. {(P p Z,p,Q p Z,A p Z)})"
   assumes deriv_bodies:
    "\<forall>p\<in>Procs. \<forall>Z. \<Gamma>,\<Theta>'\<turnstile>\<^bsub>/F\<^esub> (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   assumes Procs_defined: "Procs \<subseteq> dom \<Gamma>"
   shows "\<forall>p\<in>Procs. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>(P p Z) Call p (Q p Z),(A p Z)"
   using ctxt deriv_bodies
   apply simp
   apply (erule ProcRec [OF _ Procs_defined])
   done
 
 
 lemma ProcRecList:
   assumes deriv_bodies:
    "\<forall>p\<in>set Procs.
     \<forall>Z. \<Gamma>,\<Theta>\<union>(\<Union>p\<in>set Procs. \<Union>Z. {(P p Z,p,Q p Z,A p Z)})
         \<turnstile>\<^bsub>/F\<^esub> (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   assumes dist: "distinct Procs"
   assumes Procs_defined: "set Procs \<subseteq> dom \<Gamma>"
   shows "\<forall>p\<in>set Procs. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>(P p Z) Call p (Q p Z),(A p Z)"
   using deriv_bodies Procs_defined
   by (rule ProcRec)
 
 lemma  ProcRecSpecs:
   "\<lbrakk>\<forall>(P,p,Q,A) \<in> Specs. \<Gamma>,\<Theta>\<union>Specs\<turnstile>\<^bsub>/F\<^esub> P (the (\<Gamma> p)) Q,A;
     \<forall>(P,p,Q,A) \<in> Specs. p \<in> dom \<Gamma>\<rbrakk>
   \<Longrightarrow> \<forall>(P,p,Q,A) \<in> Specs. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
 apply (auto intro: CallRec)
 done
 
 
 lemma ProcRec1:
   assumes deriv_body:
    "\<forall>Z. \<Gamma>,\<Theta>\<union>(\<Union>Z. {(P Z,p,Q Z,A Z)})\<turnstile>\<^bsub>/F\<^esub> (P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
   assumes p_defined: "p \<in> dom \<Gamma>"
   shows "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P Z) Call p (Q Z),(A Z)"
 proof -
   from deriv_body p_defined
   have "\<forall>p\<in>{p}. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P Z) Call p (Q Z),(A Z)"
     by - (rule ProcRec [where A="\<lambda>p. A" and P="\<lambda>p. P" and Q="\<lambda>p. Q"],
           simp_all)
   thus ?thesis
     by simp
 qed
 
 lemma ProcNoRec1:
   assumes deriv_body:
    "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
   assumes p_def: "p \<in> dom \<Gamma>"
   shows "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P Z) Call p (Q Z),(A Z)"
 proof -
 from deriv_body
   have "\<forall>Z. \<Gamma>,\<Theta>\<union>(\<Union>Z. {(P Z,p,Q Z,A Z)})
              \<turnstile>\<^bsub>/F\<^esub> (P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
     by (blast intro: hoare_augment_context)
   from this p_def
   show ?thesis
     by (rule ProcRec1)
 qed
 
 lemma ProcBody:
  assumes WP: "P \<subseteq> P'"
  assumes deriv_body: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' body Q,A"
  assumes body: "\<Gamma> p = Some body"
  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Call p Q,A"
 apply (rule conseqPre [OF _ WP])
 apply (rule ProcNoRec1 [rule_format, where P="\<lambda>Z. P'" and Q="\<lambda>Z. Q" and A="\<lambda>Z. A"])
 apply  (insert body)
 apply  simp
 apply  (rule hoare_augment_context [OF deriv_body])
 apply  blast
 apply fastforce
 done
 
 lemma CallBody:
 assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
 assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) body {t. return s t \<in> R s t},{t. return s t \<in> A}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes body: "\<Gamma> p = Some body"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 apply (unfold call_def)
 apply (rule Block [OF adapt _ c])
 apply (rule allI)
 apply (rule ProcBody [where \<Gamma>=\<Gamma>, OF _ bdy [rule_format] body])
 apply simp
 done
 
+lemma Call_exnBody:
+assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s) body {t. return s t \<in> R s t},{t. result_exn (return s t) t \<in> A}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes body: "\<Gamma> p = Some body"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (unfold call_exn_def)
+apply (rule Block_exn [OF adapt _ c])
+apply (rule allI)
+apply (rule ProcBody [where \<Gamma>=\<Gamma>, OF _ bdy [rule_format] body])
+apply simp
+done
+
 lemmas ProcModifyReturn = HoarePartialProps.ProcModifyReturn
 lemmas ProcModifyReturnSameFaults = HoarePartialProps.ProcModifyReturnSameFaults
+lemmas Proc_exnModifyReturn = HoarePartialProps.Proc_exnModifyReturn
+lemmas Proc_exnModifyReturnSameFaults = HoarePartialProps.Proc_exnModifyReturnSameFaults
+
+lemma Proc_exnModifyReturnNoAbr:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes result_conform:
+      "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+  by (rule Proc_exnModifyReturn [OF spec result_conform _ modifies_spec]) simp
 
 lemma ProcModifyReturnNoAbr:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes result_conform:
       "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 by (rule ProcModifyReturn [OF spec result_conform _ modifies_spec]) simp
 
+lemma Proc_exnModifyReturnNoAbrSameFaults:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes result_conform:
+      "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+  by (rule Proc_exnModifyReturnSameFaults [OF spec result_conform _ modifies_spec]) simp
+
 lemma ProcModifyReturnNoAbrSameFaults:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes result_conform:
       "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 by (rule ProcModifyReturnSameFaults [OF spec result_conform _ modifies_spec]) simp
 
-
-lemma DynProc:
+lemma DynProc_exn:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
                           (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
-                          (\<forall>t. t \<in> A' s Z \<longrightarrow> return s t \<in> A)}"
+                          (\<forall>t. t \<in> A' s Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall init p return c Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall_exn f UNIV init p return result_exn c Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. s=Z \<and> s \<in> P}"
   and Q'="\<lambda>Z. Q" and A'="\<lambda>Z. A"])
 prefer 2
 using adapt
 apply  blast
 apply (rule allI)
-apply (unfold dynCall_def call_def block_def)
+apply (unfold dynCall_exn_def call_exn_def maybe_guard_UNIV block_exn_def guards.simps)
 apply (rule DynCom)
 apply clarsimp
 apply (rule DynCom)
 apply clarsimp
 apply (frule in_mono [rule_format, OF adapt])
 apply clarsimp
 apply (rename_tac Z')
 apply (rule_tac R="Q' Z Z'" in Seq)
 apply  (rule CatchSwap)
 apply   (rule SeqSwap)
 apply    (rule Throw)
 apply    (rule subset_refl)
 apply   (rule Basic)
 apply   (rule subset_refl)
 apply  (rule_tac R="{i. i \<in> P' Z Z'}" in Seq)
 apply   (rule Basic)
 apply   clarsimp
 apply  simp
 apply  (rule_tac Q'="Q' Z Z'" and A'="A' Z Z'" in conseqPost)
 using p
 apply    clarsimp
 apply   simp
 apply  clarsimp
 apply  (rule_tac  P'="\<lambda>Z''. {t. t=Z'' \<and> return Z t \<in> R Z t}" and
           Q'="\<lambda>Z''. Q" and A'="\<lambda>Z''. A" in conseq)
 prefer 2 apply simp
 apply (rule allI)
 apply (rule DynCom)
 apply clarsimp
 apply (rule SeqSwap)
 apply  (rule c [rule_format])
 apply (rule Basic)
 apply clarsimp
-done
+  done
+
+lemma DynProc_exn_guards_cons:
+  assumes p: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall_exn f UNIV init p return result_exn c Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (g \<inter> P) dynCall_exn f g init p return result_exn c Q,A"
+  using p apply (clarsimp simp add: dynCall_exn_def maybe_guard_def)
+  apply (rule Guard)
+   apply (rule subset_refl)
+  apply assumption
+  done
+
+lemma DynProc:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
+                          (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
+                          (\<forall>t. t \<in> A' s Z \<longrightarrow> return s t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall init p return c Q,A"
+  using adapt c p unfolding dynCall_dynCall_exn by (rule DynProc_exn)
+
+lemma DynProc_exn':
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
+                          (\<forall>t \<in> Q' s Z. return s t \<in> R s t) \<and>
+                          (\<forall>t \<in> A' s Z. result_exn (return s t) t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall_exn f UNIV init p return result_exn c Q,A"
+proof -
+  from adapt have "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
+                          (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
+                          (\<forall>t. t \<in> A' s Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
+    by blast
+  from this c p show ?thesis
+    by (rule DynProc_exn)
+qed
 
 lemma DynProc':
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
                           (\<forall>t \<in> Q' s Z. return s t \<in> R s t) \<and>
                           (\<forall>t \<in> A' s Z. return s t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall init p return c Q,A"
-proof -
-  from adapt have "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
-                          (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
-                          (\<forall>t. t \<in> A' s Z \<longrightarrow> return s t \<in> A)}"
-    by blast
-  from this c p show ?thesis
-    by (rule DynProc)
-qed
+  using adapt c p unfolding dynCall_dynCall_exn by (rule DynProc_exn')
 
-
-lemma DynProcStaticSpec:
+lemma DynProc_exnStaticSpec:
 assumes adapt: "P \<subseteq> {s. s \<in> S \<and> (\<exists>Z. init s \<in> P' Z  \<and>
                             (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
-                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> return s \<tau> \<in> A))}"
+                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> result_exn (return s \<tau>) \<tau> \<in> A))}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>s\<in>S. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call (p s) (Q' Z),(A' Z)"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f UNIV init p return result_exn c) Q,A"
 proof -
   from adapt have P_S: "P \<subseteq> S"
     by blast
-  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> S) (dynCall init p return c) Q,A"
-    apply (rule DynProc [where P'="\<lambda>s Z. P' Z" and Q'="\<lambda>s Z. Q' Z"
+  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> S) (dynCall_exn f UNIV init p return result_exn c) Q,A"
+    apply (rule DynProc_exn [where P'="\<lambda>s Z. P' Z" and Q'="\<lambda>s Z. Q' Z"
                          and A'="\<lambda>s Z. A' Z", OF _ c])
     apply  clarsimp
     apply  (frule in_mono [rule_format, OF adapt])
     apply  clarsimp
     using spec
     apply clarsimp
     done
   thus ?thesis
     by (rule conseqPre) (insert P_S,blast)
 qed
 
+lemma DynProcStaticSpec:
+assumes adapt: "P \<subseteq> {s. s \<in> S \<and> (\<exists>Z. init s \<in> P' Z  \<and>
+                            (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
+                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> return s \<tau> \<in> A))}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes spec: "\<forall>s\<in>S. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call (p s) (Q' Z),(A' Z)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using adapt c spec unfolding dynCall_dynCall_exn by (rule DynProc_exnStaticSpec)
+
+lemma DynProc_exnProcPar:
+assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
+                            (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
+                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> result_exn (return s \<tau>) \<tau> \<in> A))}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),(A' Z)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f UNIV init p return result_exn c) Q,A"
+  apply (rule DynProc_exnStaticSpec [where S="{s. p s = q}",simplified, OF adapt c])
+  using spec
+  apply simp
+  done
 
 lemma DynProcProcPar:
 assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
                             (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
                             (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> return s \<tau> \<in> A))}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),(A' Z)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
   apply (rule DynProcStaticSpec [where S="{s. p s = q}",simplified, OF adapt c])
   using spec
   apply simp
   done
 
-
-lemma DynProcProcParNoAbrupt:
+lemma DynProc_exnProcParNoAbrupt:
 assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
                             (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>))}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),{}"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f UNIV init p return result_exn c) Q,A"
 proof -
   have "P \<subseteq> {s. p s = q \<and> (\<exists> Z. init s \<in> P' Z \<and>
                       (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
-                      (\<forall>t. t \<in> {} \<longrightarrow> return s t \<in> A))}"
+                      (\<forall>t. t \<in> {} \<longrightarrow> result_exn (return s t) t \<in> A))}"
     (is "P \<subseteq> ?P'")
   proof
     fix s
     assume P: "s\<in>P"
     with adapt obtain Z where
       Pre: "p s = q \<and> init s \<in> P' Z" and
       adapt_Norm: "\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>"
       by blast
     from  adapt_Norm
     have "\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t"
       by auto
     then
     show "s\<in>?P'"
       using Pre by blast
   qed
   note P = this
   show ?thesis
     apply -
-    apply (rule DynProcStaticSpec [where S="{s. p s = q}",simplified, OF P c])
+    apply (rule DynProc_exnStaticSpec [where S="{s. p s = q}",simplified, OF P c])
     apply (insert spec)
     apply auto
     done
 qed
 
+lemma DynProcProcParNoAbrupt:
+assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
+                            (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>))}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),{}"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using adapt c spec unfolding dynCall_dynCall_exn by (rule DynProc_exnProcParNoAbrupt)
 
-lemma DynProcModifyReturnNoAbr:
-  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return' c) Q,A"
+lemma DynProc_exnModifyReturnNoAbr:
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return' result_exn c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
             "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s)  (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
   from ret_nrm_modif
   have "\<forall>s t. t  \<in> (Modif (init s))
         \<longrightarrow> return' s t = return s t"
     by iprover
   then
   have ret_nrm_modif': "\<forall>s t. t \<in> (Modif (init s))
                       \<longrightarrow> return' s t = return s t"
     by simp
   have ret_abr_modif': "\<forall>s t. t \<in> {}
-                        \<longrightarrow> return' s t = return s t"
+                        \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
     by simp
   from to_prove ret_nrm_modif' ret_abr_modif' modif_clause show ?thesis
-    by (rule dynProcModifyReturn)
+    by (rule dynProc_exnModifyReturn)
 qed
 
-
-lemma ProcDynModifyReturnNoAbrSameFaults:
+lemma DynProcModifyReturnNoAbr:
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
+            "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s)  (Modif \<sigma>),{}"
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule DynProc_exnModifyReturnNoAbr)
+
+lemma ProcDyn_exnModifyReturnNoAbrSameFaults:
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
             "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
   from ret_nrm_modif
   have "\<forall>s t. t  \<in> (Modif (init s))
         \<longrightarrow> return' s t = return s t"
     by iprover
   then
   have ret_nrm_modif': "\<forall>s t. t \<in> (Modif (init s))
                       \<longrightarrow> return' s t = return s t"
     by simp
   have ret_abr_modif': "\<forall>s t. t \<in> {}
-                        \<longrightarrow> return' s t = return s t"
+                        \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
     by simp
-  from to_prove ret_nrm_modif' ret_abr_modif' modif_clause show ?thesis
-    by (rule dynProcModifyReturnSameFaults)
+   from to_prove ret_nrm_modif' ret_abr_modif' modif_clause show ?thesis
+     by (rule dynProc_exnModifyReturnSameFaults)
+qed
+
+lemma ProcDynModifyReturnNoAbrSameFaults:
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return' c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
+            "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),{}"
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule ProcDyn_exnModifyReturnNoAbrSameFaults)
+
+lemma Proc_exnProcParModifyReturn:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
+         @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
+                            \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  assumes modif_clause:
+          "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+proof -
+  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
+    by (rule conseqPre) blast
+  from this ret_nrm_modif
+       ret_abr_modif
+  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule dynProc_exnModifyReturn) (insert modif_clause,auto)
+  from this q show ?thesis
+    by (rule conseqPre)
 qed
 
 
 lemma ProcProcParModifyReturn:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
          @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
           "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+        shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif ret_abr_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturn)
+
+lemma Proc_exnProcParModifyReturnSameFaults:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
+         @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
+                            \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  assumes modif_clause:
+          "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call q (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
-  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
+  from to_prove
+  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
     by (rule conseqPre) blast
   from this ret_nrm_modif
        ret_abr_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule dynProcModifyReturn) (insert modif_clause,auto)
+  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule dynProc_exnModifyReturnSameFaults) (insert modif_clause,auto)
   from this q show ?thesis
     by (rule conseqPre)
 qed
 
-
 lemma ProcProcParModifyReturnSameFaults:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
          @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
           "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call q (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+        shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif ret_abr_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturnSameFaults)
+
+lemma Proc_exnProcParModifyReturnNoAbr:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
+      first conjunction in @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
+            "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
-  from to_prove
-  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
+  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
     by (rule conseqPre) blast
   from this ret_nrm_modif
-       ret_abr_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule dynProcModifyReturnSameFaults) (insert modif_clause,auto)
+  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule DynProc_exnModifyReturnNoAbr) (insert modif_clause,auto)
   from this q show ?thesis
     by (rule conseqPre)
 qed
 
-
 lemma ProcProcParModifyReturnNoAbr:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
       first conjunction in @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
             "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturnNoAbr)
+
+lemma Proc_exnProcParModifyReturnNoAbrSameFaults:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
+      first conjunction in @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
+            "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
-  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
+  from to_prove have
+    "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
     by (rule conseqPre) blast
   from this ret_nrm_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule DynProcModifyReturnNoAbr) (insert modif_clause,auto)
+  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule ProcDyn_exnModifyReturnNoAbrSameFaults) (insert modif_clause,auto)
   from this q show ?thesis
     by (rule conseqPre)
 qed
 
 lemma ProcProcParModifyReturnNoAbrSameFaults:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
       first conjunction in @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
             "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-proof -
-  from to_prove have
-    "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
-    by (rule conseqPre) blast
-  from this ret_nrm_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule ProcDynModifyReturnNoAbrSameFaults) (insert modif_clause,auto)
-  from this q show ?thesis
-    by (rule conseqPre)
-qed
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturnNoAbrSameFaults)
+
 
 lemma MergeGuards_iff: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P merge_guards c Q,A = \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (auto intro: MergeGuardsI MergeGuardsD)
 
 lemma CombineStrip':
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c' Q,A"
   assumes deriv_strip_triv: "\<Gamma>,{}\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
   assumes c'': "c''= mark_guards False (strip_guards (-F) c')"
   assumes c: "merge_guards c = merge_guards (mark_guards False c')"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 proof -
   from deriv_strip_triv have deriv_strip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
     by (auto intro: hoare_augment_context)
   from deriv_strip [simplified c'']
   have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P (strip_guards (- F) c') UNIV,UNIV"
     by (rule MarkGuardsD)
   with deriv
   have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c' Q,A"
     by (rule CombineStrip)
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P mark_guards False c' Q,A"
     by (rule MarkGuardsI)
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P merge_guards (mark_guards False c') Q,A"
     by (rule MergeGuardsI)
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P merge_guards c Q,A"
     by (simp add: c)
   thus ?thesis
     by (rule MergeGuardsD)
 qed
 
 lemma CombineStrip'':
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{True}\<^esub> P c' Q,A"
   assumes deriv_strip_triv: "\<Gamma>,{}\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
   assumes c'': "c''= mark_guards False (strip_guards ({False}) c')"
   assumes c: "merge_guards c = merge_guards (mark_guards False c')"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
   apply (rule CombineStrip' [OF deriv deriv_strip_triv _ c])
   apply (insert c'')
   apply (subgoal_tac "- {True} = {False}")
   apply auto
   done
 
 lemma AsmUN:
   "(\<Union>Z. {(P Z, p, Q Z,A Z)}) \<subseteq> \<Theta>
   \<Longrightarrow>
   \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P Z) (Call p) (Q Z),(A Z)"
   by (blast intro: hoarep.Asm)
 
 lemma augment_context':
   "\<lbrakk>\<Theta> \<subseteq> \<Theta>'; \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P Z)  p (Q Z),(A Z)\<rbrakk>
    \<Longrightarrow> \<forall>Z. \<Gamma>,\<Theta>'\<turnstile>\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)"
   by (iprover intro: hoare_augment_context)
 
 
 lemma hoarep_strip:
  "\<lbrakk>\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z); F' \<subseteq> -F\<rbrakk> \<Longrightarrow>
     \<forall>Z. strip F' \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)"
   by (iprover intro: hoare_strip_\<Gamma>)
 
 lemma augment_emptyFaults:
  "\<lbrakk>\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/{}\<^esub> (P Z) p (Q Z),(A Z)\<rbrakk> \<Longrightarrow>
     \<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)"
   by (blast intro: augment_Faults)
 
 lemma augment_FaultsUNIV:
  "\<lbrakk>\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)\<rbrakk> \<Longrightarrow>
     \<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/UNIV\<^esub> (P Z) p (Q Z),(A Z)"
   by (blast intro: augment_Faults)
 
 lemma PostConjI [trans]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c R,B\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
   by (rule PostConjI)
 
 lemma PostConjI' :
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c R,B\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
   by (rule PostConjI) iprover+
 
 lemma PostConjE [consumes 1]:
   assumes conj: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
   assumes E: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c R,B\<rbrakk> \<Longrightarrow> S"
   shows "S"
 proof -
   from conj have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A" by (rule conseqPost) blast+
   moreover
   from conj have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c R,B" by (rule conseqPost) blast+
   ultimately show "S"
     by (rule E)
 qed
 
 
 subsection \<open>Rules for Single-Step Proof \label{sec:hoare-isar}\<close>
 
 text \<open>
  We are now ready to introduce a set of Hoare rules to be used in
  single-step structured proofs in Isabelle/Isar.
 
  \medskip Assertions of Hoare Logic may be manipulated in
  calculational proofs, with the inclusion expressed in terms of sets
  or predicates.  Reversed order is supported as well.
 \<close>
 
 lemma annotateI [trans]:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P anno Q,A; c = anno\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P c Q,A"
   by simp
 
 lemma annotate_normI:
   assumes deriv_anno: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P anno Q,A"
   assumes norm_eq: "normalize c = normalize anno"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P c Q,A"
 proof -
   from NormalizeI [OF deriv_anno] norm_eq
   have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P normalize c Q,A"
     by simp
   from NormalizeD [OF this]
   show ?thesis .
 qed
 
 lemma annotateWhile:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoG gs b I V c) Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (while gs b c) Q,A"
   by (simp add: whileAnnoG_def)
 
 
 lemma reannotateWhile:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoG gs b I V c) Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnnoG gs b J V c) Q,A"
   by (simp add: whileAnnoG_def)
 
 lemma reannotateWhileNoGuard:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnno b I V c) Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnno b J V c) Q,A"
   by (simp add: whileAnno_def)
 
 lemma [trans] : "P' \<subseteq> P \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q,A"
   by (rule conseqPre)
 
 lemma [trans]: "Q \<subseteq> Q' \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q',A"
   by (rule conseqPost) blast+
 
 lemma [trans]:
     "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s} c Q,A \<Longrightarrow> (\<And>s. P' s \<longrightarrow> P s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P' s} c Q,A"
   by (rule conseqPre) auto
 
 lemma [trans]:
     "(\<And>s. P' s \<longrightarrow> P s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s} c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P' s} c Q,A"
   by (rule conseqPre) auto
 
 lemma [trans]:
     "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P c {s. Q s},A \<Longrightarrow> (\<And>s. Q s \<longrightarrow> Q' s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P c {s. Q' s},A"
   by (rule conseqPost) auto
 
 lemma [trans]:
     "(\<And>s. Q s \<longrightarrow> Q' s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P c {s. Q s},A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>P c {s. Q' s},A"
   by (rule conseqPost) auto
 
 lemma [intro?]: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Skip P,A"
   by (rule Skip) auto
 
 lemma CondInt [trans,intro?]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> - b) c2 Q,A\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c1 c2) Q,A"
   by (rule Cond) auto
 
 lemma CondConj [trans, intro?]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s \<and> b s} c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s \<and> \<not> b s} c2 Q,A\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s} (Cond {s. b s} c1 c2) Q,A"
   by (rule Cond) auto
 
 lemma WhileInvInt [intro?]:
     "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c P,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnno b P V c) (P \<inter> -b),A"
   by (rule While) auto
 
 lemma WhileInt [intro?]:
     "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c P,A
     \<Longrightarrow>
     \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (whileAnno b {s. undefined} V c) (P \<inter> -b),A"
   by (unfold whileAnno_def)
      (rule HoarePartialDef.While [THEN conseqPrePost],auto)
 
 lemma WhileInvConj [intro?]:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s \<and> b s} c {s. P s},A
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s} (whileAnno {s. b s} {s. P s} V c) {s. P s \<and> \<not> b s},A"
   by (simp add: While Collect_conj_eq Collect_neg_eq)
 
 lemma WhileConj [intro?]:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s \<and> b s} c {s. P s},A
     \<Longrightarrow>
 \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. P s} (whileAnno {s. b s} {s. undefined} V c) {s. P s \<and> \<not> b s},A"
   by (unfold whileAnno_def)
      (simp add: HoarePartialDef.While [THEN conseqPrePost]
       Collect_conj_eq Collect_neg_eq)
 
-(* FIXME: Add rules for guarded while *)
+(* fixme: Add rules for guarded while *)
 
 end
diff --git a/thys/Simpl/HoarePartialDef.thy b/thys/Simpl/HoarePartialDef.thy
--- a/thys/Simpl/HoarePartialDef.thy
+++ b/thys/Simpl/HoarePartialDef.thy
@@ -1,434 +1,413 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HoarePartialDef.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>Hoare Logic for Partial Correctness\<close>
 theory HoarePartialDef imports Semantic begin
 
 type_synonym ('s,'p) quadruple = "('s assn \<times> 'p \<times> 's assn \<times> 's assn)"
 
 subsection \<open>Validity of Hoare Tuples: \<open>\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A\<close>\<close>
 
 definition
   valid :: "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com,'s assn,'s assn] => bool"
                 ("_\<Turnstile>\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60,1000, 20, 1000,1000] 60)
 where
  "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A \<equiv> \<forall>s t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<longrightarrow> s \<in> Normal ` P \<longrightarrow> t \<notin> Fault ` F
                       \<longrightarrow>  t \<in>  Normal ` Q \<union> Abrupt ` A"
 
 definition
   cvalid::
   "[('s,'p,'f) body,('s,'p) quadruple set,'f set,
       's assn,('s,'p,'f) com,'s assn,'s assn] =>bool"
                 ("_,_\<Turnstile>\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60,60,1000, 20, 1000,1000] 60)
 where
  "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A \<equiv> (\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A) \<longrightarrow> \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
 
 
 definition
   nvalid :: "[('s,'p,'f) body,nat,'f set,
                 's assn,('s,'p,'f) com,'s assn,'s assn] => bool"
                 ("_\<Turnstile>_:\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60,60,1000, 20, 1000,1000] 60)
 where
  "\<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A \<equiv> \<forall>s t. \<Gamma>\<turnstile>\<langle>c,s \<rangle> =n\<Rightarrow> t \<longrightarrow> s \<in> Normal ` P \<longrightarrow> t \<notin> Fault ` F
                         \<longrightarrow> t \<in>  Normal ` Q \<union> Abrupt ` A"
 
 
 definition
   cnvalid::
   "[('s,'p,'f) body,('s,'p) quadruple set,nat,'f set,
      's assn,('s,'p,'f) com,'s assn,'s assn] \<Rightarrow> bool"
                 ("_,_\<Turnstile>_:\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60,60,60,1000, 20, 1000,1000] 60)
 where
  "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A \<equiv> (\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A) \<longrightarrow> \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 
 
 notation (ASCII)
   valid  ("_|='/_/ _ _ _,_"  [61,60,1000, 20, 1000,1000] 60) and
   cvalid  ("_,_|='/_/ _ _ _,_"  [61,60,60,1000, 20, 1000,1000] 60) and
   nvalid  ("_|=_:'/_/ _ _ _,_"  [61,60,60,1000, 20, 1000,1000] 60) and
   cnvalid  ("_,_|=_:'/_/ _ _ _,_"  [61,60,60,60,1000, 20, 1000,1000] 60)
 
 
 subsection \<open>Properties of Validity\<close>
 
 lemma valid_iff_nvalid: "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A = (\<forall>n. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A)"
   apply (simp only: valid_def nvalid_def exec_iff_execn )
   apply (blast dest: exec_final_notin_to_execn)
   done
 
 lemma cnvalid_to_cvalid: "(\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A) \<Longrightarrow> \<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (unfold cvalid_def cnvalid_def valid_iff_nvalid [THEN eq_reflection])
   apply fast
   done
 
 lemma nvalidI:
  "\<lbrakk>\<And>s t. \<lbrakk>\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> =n\<Rightarrow> t;s \<in> P; t\<notin> Fault ` F\<rbrakk> \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A\<rbrakk>
   \<Longrightarrow> \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   by (auto simp add: nvalid_def)
 
 lemma validI:
  "\<lbrakk>\<And>s t. \<lbrakk>\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t;s \<in> P; t\<notin>Fault ` F\<rbrakk> \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A\<rbrakk>
   \<Longrightarrow> \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (auto simp add: valid_def)
 
 lemma cvalidI:
  "\<lbrakk>\<And>s t. \<lbrakk>\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A;\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t;s \<in> P;t\<notin>Fault ` F\<rbrakk>
           \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (auto simp add: cvalid_def valid_def)
 
 lemma cvalidD:
  "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A;\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A;\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t;s \<in> P;t\<notin>Fault ` F\<rbrakk>
   \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A"
   by (auto simp add: cvalid_def valid_def)
 
 lemma cnvalidI:
  "\<lbrakk>\<And>s t. \<lbrakk>\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A;
    \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> =n\<Rightarrow> t;s \<in> P;t\<notin>Fault ` F\<rbrakk>
           \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   by (auto simp add: cnvalid_def nvalid_def)
 
 
 lemma cnvalidD:
  "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A;\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A;
    \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> =n\<Rightarrow> t;s \<in> P;
    t\<notin>Fault ` F\<rbrakk>
   \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A"
   by (auto simp add: cnvalid_def nvalid_def)
 
 lemma nvalid_augment_Faults:
   assumes validn:"\<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   assumes F': "F \<subseteq> F'"
   shows "\<Gamma>\<Turnstile>n:\<^bsub>/F'\<^esub> P c Q,A"
 proof (rule nvalidI)
   fix s t
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume F: "t \<notin> Fault ` F'"
   with F' have "t \<notin> Fault ` F"
     by blast
   with exec P validn
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
     by (auto simp add: nvalid_def)
 qed
 
 lemma valid_augment_Faults:
   assumes validn:"\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes F': "F \<subseteq> F'"
   shows "\<Gamma>\<Turnstile>\<^bsub>/F'\<^esub> P c Q,A"
 proof (rule validI)
   fix s t
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume F: "t \<notin> Fault ` F'"
   with F' have "t \<notin> Fault ` F"
     by blast
   with exec P validn
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
     by (auto simp add: valid_def)
 qed
 
 lemma nvalid_to_nvalid_strip:
   assumes validn:"\<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   assumes F': "F' \<subseteq> -F"
   shows "strip F' \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 proof (rule nvalidI)
   fix s t
   assume exec_strip: "strip F' \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume F: "t \<notin> Fault ` F"
   from exec_strip obtain t' where
     exec: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> =n\<Rightarrow> t'" and
     t': "t' \<in> Fault ` (-F') \<longrightarrow> t'=t" "\<not> isFault t' \<longrightarrow> t'=t"
     by (blast dest: execn_strip_to_execn)
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases "t' \<in> Fault ` F")
     case True
     with t' F F' have False
       by blast
     thus ?thesis ..
   next
     case False
     with exec P validn
     have *: "t' \<in> Normal ` Q \<union> Abrupt ` A"
       by (auto simp add: nvalid_def)
     with t' have "t'=t"
       by auto
     with * show ?thesis
       by simp
   qed
 qed
 
 
 lemma valid_to_valid_strip:
   assumes valid:"\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes F': "F' \<subseteq> -F"
   shows "strip F' \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
 proof (rule validI)
   fix s t
   assume exec_strip: "strip F' \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume F: "t \<notin> Fault ` F"
   from exec_strip obtain t' where
     exec: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t'" and
     t': "t' \<in> Fault ` (-F') \<longrightarrow> t'=t" "\<not> isFault t' \<longrightarrow> t'=t"
     by (blast dest: exec_strip_to_exec)
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases "t' \<in> Fault ` F")
     case True
     with t' F F' have False
       by blast
     thus ?thesis ..
   next
     case False
     with exec P valid
     have *: "t' \<in> Normal ` Q \<union> Abrupt ` A"
       by (auto simp add: valid_def)
     with t' have "t'=t"
       by auto
     with * show ?thesis
       by simp
   qed
 qed
 
 
 subsection \<open>The Hoare Rules: \<open>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A\<close>\<close>
 
 lemma mono_WeakenContext: "A \<subseteq> B \<Longrightarrow>
         (\<lambda>(P, c, Q, A'). (\<Gamma>, \<Theta>, F, P, c, Q, A') \<in> A) x \<longrightarrow>
         (\<lambda>(P, c, Q, A'). (\<Gamma>, \<Theta>, F, P, c, Q, A') \<in> B) x"
 apply blast
 done
 
 
 inductive "hoarep"::"[('s,'p,'f) body,('s,'p) quadruple set,'f set,
     's assn,('s,'p,'f) com, 's assn,'s assn] => bool"
     ("(3_,_/\<turnstile>\<^bsub>'/_ \<^esub>(_/ (_)/ _,/_))" [60,60,60,1000,20,1000,1000]60)
   for \<Gamma>::"('s,'p,'f) body"
 where
   Skip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> Q Skip Q,A"
 
 | Basic: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. f s \<in> Q} (Basic f) Q,A"
 
 | Spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. (\<forall>t. (s,t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s,t) \<in> r)} (Spec r) Q,A"
 
 | Seq: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk>
         \<Longrightarrow>
         \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Seq c\<^sub>1 c\<^sub>2) Q,A"
 
 | Cond: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c\<^sub>1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> - b) c\<^sub>2 Q,A\<rbrakk>
          \<Longrightarrow>
          \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 
 | While: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c P,A
           \<Longrightarrow>
           \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (While b c) (P \<inter> - b),A"
 
 | Guard: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (g \<inter> P) c Q,A
           \<Longrightarrow>
           \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (g \<inter> P) (Guard f g c) Q,A"
 
 | Guarantee: "\<lbrakk>f \<in> F; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (g \<inter> P) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 
 | CallRec:
   "\<lbrakk>(P,p,Q,A) \<in> Specs;
     \<forall>(P,p,Q,A) \<in> Specs. p \<in> dom \<Gamma> \<and> \<Gamma>,\<Theta>\<union>Specs\<turnstile>\<^bsub>/F\<^esub> P (the (\<Gamma> p)) Q,A \<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
 
 | DynCom:
       "\<forall>s \<in> P. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (c s) Q,A
       \<Longrightarrow>
       \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (DynCom c) Q,A"
 
 | Throw: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> A Throw Q,A"
 
 | Catch: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,R; \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
 
 | Conseq: "\<forall>s \<in> P. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<and> s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A
            \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 
 
 | Asm: "\<lbrakk>(P,p,Q,A) \<in> \<Theta>\<rbrakk>
          \<Longrightarrow>
          \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
 
 
 | ExFalso: "\<lbrakk>\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A; \<not> \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   \<comment> \<open>This is a hack rule that enables us to derive completeness for
         an arbitrary context \<open>\<Theta>\<close>, from completeness for an empty context.\<close>
 
 
 
 text \<open>Does not work, because of rule ExFalso, the context \<open>\<Theta>\<close> is to blame.
  A weaker version with empty context can be derived from soundness
  and completeness later on.\<close>
 lemma hoare_strip_\<Gamma>:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
   shows "strip (-F) \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
 using deriv
 proof induct
   case Skip thus ?case by (iprover intro: hoarep.Skip)
 next
   case Basic thus ?case by (iprover intro: hoarep.Basic)
 next
   case Spec thus ?case by (iprover intro: hoarep.Spec)
 next
   case Seq thus ?case by (iprover intro: hoarep.Seq)
 next
   case Cond thus ?case by (iprover intro: hoarep.Cond)
 next
   case While thus ?case by (iprover intro: hoarep.While)
 next
   case Guard thus ?case by (iprover intro: hoarep.Guard)
 (*next
   case CallSpec thus ?case by (iprover intro: hoarep.CallSpec)
 next
   case (CallRec A Abr Abr' Init P Post Pre Procs Q R Result Return Z \<Gamma> \<Theta> init p
          result return )
   from CallRec.hyps
   have "\<forall>p\<in>Procs. \<forall>Z. (strip \<Gamma>),\<Theta> \<union>
              (\<Union>\<^bsub>p\<in>Procs\<^esub>
                  \<Union>\<^bsub>Z\<^esub> {(Pre p Z, Call (Init p) p (Return p) (Result p),
                       Post p Z, Abr p Z)})\<turnstile>
             (Pre p Z) (the (\<Gamma> p)) (R p Z),(Abr' p Z)" by blast
   hence "\<forall>p\<in>Procs. \<forall>Z. (strip \<Gamma>),\<Theta> \<union>
              (\<Union>\<^bsub>p\<in>Procs\<^esub>
                  \<Union>\<^bsub>Z\<^esub> {(Pre p Z, Call (Init p) p (Return p) (Result p),
                       Post p Z, Abr p Z)})\<turnstile>
             (Pre p Z) (the ((strip \<Gamma>) p)) (R p Z),(Abr' p Z)"
     by (auto intro: hoarep.StripI)
   then show ?case
     apply -
     apply (rule hoarep.CallRec)
     apply (assumption | simp only:dom_strip)+
     done*)
 next
   case DynCom
   thus ?case
     by - (rule hoarep.DynCom,best  elim!: ballE exE)
 next
   case Throw thus ?case by (iprover intro: hoarep.Throw)
 next
   case Catch thus ?case by (iprover intro: hoarep.Catch)
 (*next
   case CONSEQ thus ?case apply (auto intro: hoarep.CONSEQ)*)
 next
   case Asm thus ?case by (iprover intro: hoarep.Asm)
 next
   case ExFalso
   thus ?case
     oops
 
 lemma hoare_augment_context:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
   shows "\<And>\<Theta>'. \<Theta> \<subseteq> \<Theta>' \<Longrightarrow> \<Gamma>,\<Theta>'\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
 using deriv
 proof (induct)
   case CallRec
   case (CallRec P p Q A Specs \<Theta> F \<Theta>')
   from CallRec.prems
   have "\<Theta>\<union>Specs
        \<subseteq> \<Theta>'\<union>Specs"
     by blast
   with CallRec.hyps (2)
   have "\<forall>(P,p,Q,A)\<in>Specs.  p \<in> dom \<Gamma> \<and> \<Gamma>,\<Theta>'\<union>Specs \<turnstile>\<^bsub>/F\<^esub> P  (the (\<Gamma> p)) Q,A"
     by fastforce
 
   with CallRec show ?case by - (rule hoarep.CallRec)
 next
   case DynCom thus ?case by (blast intro: hoarep.DynCom)
 next
   case (Conseq P \<Theta> F c Q A \<Theta>')
   from Conseq
   have "\<forall>s \<in> P.
          (\<exists>P' Q' A'. \<Gamma>,\<Theta>' \<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<and> s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A)"
     by blast
   with Conseq show ?case by - (rule hoarep.Conseq)
 next
   case (ExFalso \<Theta> F P c Q A \<Theta>')
   have valid_ctxt: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A" "\<Theta> \<subseteq> \<Theta>'" by fact+
   hence "\<forall>n. \<Gamma>,\<Theta>'\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
     by (simp add: cnvalid_def) blast
   moreover have invalid: "\<not> \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"  by fact
   ultimately show ?case
     by (rule hoarep.ExFalso)
 qed (blast intro: hoarep.intros)+
 
 
 subsection \<open>Some Derived Rules\<close>
 
 lemma  Conseq': "\<forall>s. s \<in> P \<longrightarrow>
             (\<exists>P' Q' A'.
               (\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)) \<and>
                     (\<exists>Z. s \<in> P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A)))
            \<Longrightarrow>
            \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 apply (rule Conseq)
 apply (rule ballI)
 apply (erule_tac x=s in allE)
 apply (clarify)
 apply (rule_tac x="P' Z" in exI)
 apply (rule_tac x="Q' Z" in exI)
 apply (rule_tac x="A' Z" in exI)
 apply blast
 done
 
 lemma conseq:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
               \<forall>s. s \<in> P \<longrightarrow> (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A))\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (rule Conseq) blast
 
 theorem conseqPrePost [trans]:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<Longrightarrow> P \<subseteq> P' \<Longrightarrow>  Q' \<subseteq> Q \<Longrightarrow> A' \<subseteq> A \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (rule conseq [where ?P'="\<lambda>Z. P'" and ?Q'="\<lambda>Z. Q'"]) auto
 
 lemma conseqPre [trans]: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q,A \<Longrightarrow> P \<subseteq> P' \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 by (rule conseq) auto
 
 lemma conseqPost [trans]: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q',A' \<Longrightarrow> Q' \<subseteq> Q \<Longrightarrow> A' \<subseteq> A
  \<Longrightarrow>   \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (rule conseq) auto
 
 
 lemma CallRec':
   "\<lbrakk>p\<in>Procs; Procs \<subseteq> dom \<Gamma>;
    \<forall>p\<in>Procs.
     \<forall>Z. \<Gamma>,\<Theta> \<union> (\<Union>p\<in>Procs. \<Union>Z. {((P p Z),p,Q p Z,A p Z)})
         \<turnstile>\<^bsub>/F\<^esub> (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P p Z) (Call p) (Q p Z),(A p Z)"
 apply (rule CallRec [where Specs="\<Union>p\<in>Procs. \<Union>Z. {((P p Z),p,Q p Z,A p Z)}"])
 apply  blast
 apply blast
 done
 
 end
diff --git a/thys/Simpl/HoarePartialProps.thy b/thys/Simpl/HoarePartialProps.thy
--- a/thys/Simpl/HoarePartialProps.thy
+++ b/thys/Simpl/HoarePartialProps.thy
@@ -1,2399 +1,2538 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HoarePartialProps.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>Properties of Partial Correctness Hoare Logic\<close>
 
 theory HoarePartialProps imports HoarePartialDef begin
 
 subsection \<open>Soundness\<close>
 
 lemma hoare_cnvalid:
  assumes hoare: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
  shows "\<And>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 using hoare
 proof (induct)
   case (Skip \<Theta> F P A)
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P Skip P,A"
   proof (rule cnvalidI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> =n\<Rightarrow> t" "s \<in> P"
     thus "t \<in> Normal ` P \<union> Abrupt ` A"
       by cases auto
   qed
 next
   case (Basic \<Theta> F f P A)
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> {s. f s \<in> P} (Basic f) P,A"
   proof (rule cnvalidI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> =n\<Rightarrow> t" "s \<in> {s. f s \<in> P}"
     thus "t \<in> Normal ` P \<union> Abrupt ` A"
       by cases auto
   qed
 next
   case (Spec \<Theta> F r Q A)
   show "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {s. (\<forall>t. (s, t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s, t) \<in> r)} Spec r Q,A"
   proof (rule cnvalidI)
     fix s t
     assume exec: "\<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> =n\<Rightarrow> t"
     assume P: "s \<in> {s. (\<forall>t. (s, t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s, t) \<in> r)}"
     from exec P
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by cases auto
   qed
 next
   case (Seq \<Theta> F P c1 R A c2 Q)
   have valid_c1: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P c1 R,A" by fact
   have valid_c2: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> R c2 Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P Seq c1 c2 Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> =n\<Rightarrow> t"
     assume t_notin_F: "t \<notin> Fault ` F"
     assume P: "s \<in> P"
     from exec P obtain r where
       exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> r" and exec_c2:  "\<Gamma>\<turnstile>\<langle>c2,r\<rangle> =n\<Rightarrow> t"
       by cases auto
     with t_notin_F have "r \<notin> Fault ` F"
       by (auto dest: execn_Fault_end)
     with valid_c1 ctxt exec_c1 P
     have r: "r\<in>Normal ` R \<union> Abrupt ` A"
       by (rule cnvalidD)
     show "t\<in>Normal ` Q \<union> Abrupt ` A"
     proof (cases r)
       case (Normal r')
       with exec_c2 r
       show "t\<in>Normal ` Q \<union> Abrupt ` A"
         apply -
         apply (rule cnvalidD [OF valid_c2 ctxt _ _ t_notin_F])
         apply auto
         done
     next
       case (Abrupt r')
       with exec_c2 have "t=Abrupt r'"
         by (auto elim: execn_elim_cases)
       with Abrupt r show ?thesis
         by auto
     next
       case Fault with r show ?thesis by blast
     next
       case Stuck with r show ?thesis by blast
     qed
   qed
 next
   case (Cond \<Theta> F P b c1 Q A c2)
   have valid_c1: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> (P \<inter> b) c1 Q,A" by fact
   have valid_c2: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> (P \<inter> - b) c2 Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P Cond b c1 c2 Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> =n\<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof (cases "s\<in>b")
       case True
       with exec have "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> t"
         by cases auto
       with P True
       show ?thesis
         by - (rule cnvalidD [OF valid_c1 ctxt _ _ t_notin_F],auto)
     next
       case False
       with exec P have "\<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> =n\<Rightarrow> t"
         by cases auto
       with P False
       show ?thesis
         by - (rule cnvalidD [OF valid_c2 ctxt _ _ t_notin_F],auto)
     qed
   qed
 next
   case (While \<Theta> F P b c A n)
   have valid_c: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> (P \<inter> b) c P,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P While b c (P \<inter> - b),A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> =n\<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     show "t \<in> Normal ` (P \<inter> - b) \<union> Abrupt ` A"
     proof (cases "s \<in> b")
       case True
       {
         fix d::"('b,'a,'c) com" fix s t
         assume exec: "\<Gamma>\<turnstile>\<langle>d,s\<rangle> =n\<Rightarrow> t"
         assume d: "d=While b c"
         assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
         from exec d ctxt
         have "\<lbrakk>s \<in> Normal ` P; t \<notin> Fault ` F\<rbrakk>
                \<Longrightarrow> t \<in> Normal ` (P \<inter> - b) \<union> Abrupt`A"
         proof (induct)
           case (WhileTrue s b' c' n r t)
           have t_notin_F: "t \<notin> Fault ` F" by fact
           have eqs: "While b' c' = While b c" by fact
           note valid_c
           moreover have ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A" by fact
           moreover from WhileTrue
           obtain "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> r" and
             "\<Gamma>\<turnstile>\<langle>While b c,r\<rangle> =n\<Rightarrow> t" and
             "Normal s \<in> Normal `(P \<inter> b)" by auto
           moreover with t_notin_F have "r \<notin> Fault ` F"
             by (auto dest: execn_Fault_end)
           ultimately
           have r: "r \<in> Normal ` P \<union> Abrupt ` A"
             by - (rule cnvalidD,auto)
           from this _ ctxt
           show "t \<in> Normal ` (P \<inter> - b) \<union> Abrupt ` A "
           proof (cases r)
             case (Normal r')
             with r ctxt eqs t_notin_F
             show ?thesis
               by - (rule WhileTrue.hyps,auto)
           next
             case (Abrupt r')
             have "\<Gamma>\<turnstile>\<langle>While b' c',r\<rangle> =n\<Rightarrow> t" by fact
             with Abrupt have "t=r"
               by (auto dest: execn_Abrupt_end)
             with r Abrupt show ?thesis
               by blast
           next
             case Fault with r show ?thesis by blast
           next
             case Stuck with r show ?thesis by blast
           qed
         qed auto
       }
       with exec ctxt P t_notin_F
       show ?thesis
         by auto
     next
       case False
       with exec P have "t=Normal s"
         by cases auto
       with P False
       show ?thesis
         by auto
     qed
   qed
 next
   case (Guard \<Theta> F g P c Q A f)
   have valid_c: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> (g \<inter> P) c Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> (g \<inter> P) Guard f g c  Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> =n\<Rightarrow> t"
     assume t_notin_F: "t \<notin> Fault ` F"
     assume P:"s \<in> (g \<inter> P)"
     from exec P have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
       by cases auto
     from valid_c ctxt this P t_notin_F
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by (rule cnvalidD)
   qed
 next
   case (Guarantee f F \<Theta> g P c Q A)
   have valid_c: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> (g \<inter> P) c Q,A" by fact
   have f_F: "f \<in> F" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P Guard f g c  Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> =n\<Rightarrow> t"
     assume t_notin_F: "t \<notin> Fault ` F"
     assume P:"s \<in> P"
     from exec f_F t_notin_F have g: "s \<in> g"
       by cases auto
     with P have P': "s \<in> g \<inter> P"
       by blast
     from exec P g have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
       by cases auto
     from valid_c ctxt this P' t_notin_F
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by (rule cnvalidD)
   qed
 next
   case (CallRec P p Q A Specs \<Theta> F)
   have p: "(P,p,Q,A) \<in> Specs" by fact
   have valid_body:
     "\<forall>(P,p,Q,A) \<in> Specs. p \<in> dom \<Gamma> \<and> (\<forall>n. \<Gamma>,\<Theta> \<union> Specs \<Turnstile>n:\<^bsub>/F\<^esub> P (the (\<Gamma> p)) Q,A)"
     using CallRec.hyps by blast
   show "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P Call p Q,A"
   proof -
     {
       fix n
       have "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A
         \<Longrightarrow> \<forall>(P,p,Q,A) \<in>Specs. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
       proof (induct n)
         case 0
         show "\<forall>(P,p,Q,A) \<in>Specs. \<Gamma>\<Turnstile>0:\<^bsub>/F\<^esub> P (Call p) Q,A"
           by (fastforce elim!: execn_elim_cases simp add: nvalid_def)
       next
         case (Suc m)
         have hyp: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>m:\<^bsub>/F\<^esub> P (Call p) Q,A
               \<Longrightarrow> \<forall>(P,p,Q,A) \<in>Specs. \<Gamma>\<Turnstile>m:\<^bsub>/F\<^esub> P (Call p) Q,A" by fact
         have "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>Suc m:\<^bsub>/F\<^esub> P (Call p) Q,A" by fact
         hence ctxt_m: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>m:\<^bsub>/F\<^esub> P (Call p) Q,A"
           by (fastforce simp add: nvalid_def intro: execn_Suc)
         hence valid_Proc:
           "\<forall>(P,p,Q,A) \<in>Specs. \<Gamma>\<Turnstile>m:\<^bsub>/F\<^esub> P (Call p) Q,A"
           by (rule hyp)
         let ?\<Theta>'= "\<Theta> \<union> Specs"
         from valid_Proc ctxt_m
         have "\<forall>(P, p, Q, A)\<in>?\<Theta>'. \<Gamma> \<Turnstile>m:\<^bsub>/F\<^esub> P (Call p) Q,A"
           by fastforce
         with valid_body
         have valid_body_m:
           "\<forall>(P,p,Q,A) \<in>Specs. \<forall>n. \<Gamma> \<Turnstile>m:\<^bsub>/F\<^esub> P (the (\<Gamma> p)) Q,A"
           by (fastforce simp add: cnvalid_def)
         show "\<forall>(P,p,Q,A) \<in>Specs. \<Gamma> \<Turnstile>Suc m:\<^bsub>/F\<^esub> P (Call p) Q,A"
         proof (clarify)
           fix P p Q A assume p: "(P,p,Q,A) \<in> Specs"
           show "\<Gamma> \<Turnstile>Suc m:\<^bsub>/F\<^esub> P (Call p) Q,A"
           proof (rule nvalidI)
             fix s t
             assume exec_call:
               "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> =Suc m\<Rightarrow> t"
             assume Pre: "s \<in> P"
             assume t_notin_F: "t \<notin> Fault ` F"
             from exec_call
             show "t \<in> Normal ` Q \<union> Abrupt ` A"
             proof (cases)
               fix bdy m'
               assume m: "Suc m = Suc m'"
               assume bdy: "\<Gamma> p = Some bdy"
               assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =m'\<Rightarrow> t"
               from Pre valid_body_m exec_body bdy m p t_notin_F
               show ?thesis
                 by (fastforce simp add: nvalid_def)
             next
               assume "\<Gamma> p = None"
               with valid_body p have False by auto
               thus ?thesis ..
             qed
           qed
         qed
       qed
     }
     with p show ?thesis
       by (fastforce simp add: cnvalid_def)
   qed
 next
   case (DynCom P \<Theta> F c Q A)
   hence valid_c: "\<forall>s\<in>P. (\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P (c s) Q,A)" by auto
   show "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P DynCom c Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> =n\<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_Fault: "t \<notin> Fault ` F"
     from exec show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof (cases)
       assume "\<Gamma>\<turnstile>\<langle>c s,Normal s\<rangle> =n\<Rightarrow> t"
       from cnvalidD [OF valid_c [rule_format, OF P] ctxt this P t_notin_Fault]
       show ?thesis .
     qed
   qed
 next
   case (Throw \<Theta> F A Q)
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> A Throw Q,A"
   proof (rule cnvalidI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> =n\<Rightarrow> t" "s \<in> A"
     then show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by cases simp
   qed
 next
   case (Catch \<Theta> F P c\<^sub>1 Q R c\<^sub>2 A)
   have valid_c1: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P c\<^sub>1 Q,R" by fact
   have valid_c2: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> R c\<^sub>2 Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> =n\<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_Fault: "t \<notin> Fault ` F"
     from exec show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof (cases)
       fix s'
       assume exec_c1: "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'"
       assume exec_c2: "\<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s'\<rangle> =n\<Rightarrow> t"
       from cnvalidD [OF valid_c1 ctxt exec_c1 P ]
       have "Abrupt s' \<in> Abrupt ` R"
         by auto
       with cnvalidD [OF valid_c2 ctxt _ _ t_notin_Fault] exec_c2
       show ?thesis
         by fastforce
     next
       assume exec_c1: "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> t"
       assume notAbr: "\<not> isAbr t"
       from cnvalidD [OF valid_c1 ctxt exec_c1 P t_notin_Fault]
       have "t \<in> Normal ` Q \<union> Abrupt ` R" .
       with notAbr
       show ?thesis
         by auto
     qed
   qed
 next
   case (Conseq P \<Theta> F c Q A)
   hence adapt: "\<forall>s \<in> P. (\<exists>P' Q' A'. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P' c Q',A'  \<and>
                           s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A)"
     by blast
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt:"\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof -
       from P adapt obtain P' Q' A' Z  where
         spec: "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P' c Q',A'" and
         P': "s \<in> P'"  and  strengthen: "Q' \<subseteq> Q \<and> A' \<subseteq> A"
         by auto
       from spec [rule_format] ctxt exec P' t_notin_F
       have "t \<in> Normal ` Q' \<union> Abrupt ` A'"
         by (rule cnvalidD)
       with strengthen show ?thesis
         by blast
     qed
   qed
 next
   case (Asm P p Q A \<Theta> F)
   have asm: "(P, p, Q, A) \<in> \<Theta>" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   proof (rule cnvalidI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> =n\<Rightarrow> t"
     from asm ctxt have "\<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P Call p Q,A" by auto
     moreover
     assume "s \<in> P" "t \<notin> Fault ` F"
     ultimately
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
       using exec
       by (auto simp add: nvalid_def)
   qed
 next
   case ExFalso thus ?case by iprover
 qed
 
 theorem hoare_sound: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (iprover intro: cnvalid_to_cvalid hoare_cnvalid)
 
 subsection \<open>Completeness\<close>
 
 lemma MGT_valid:
 "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union>  Fault ` (-F))} c
    {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t}, {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof (rule validI)
   fix s t
   assume "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
          "s \<in> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union>  Fault ` (-F))}"
          "t \<notin> Fault ` F"
   thus "t \<in> Normal ` {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t} \<union>
             Abrupt ` {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (cases t) (auto simp add: final_notin_def)
 qed
 
 text \<open>The consequence rule where the existential @{term Z} is instantiated
 to @{term s}. Usefull in proof of \<open>MGT_lemma\<close>.\<close>
 lemma ConseqMGT:
   assumes modif: "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)"
   assumes impl: "\<And>s. s \<in> P \<Longrightarrow> s \<in> P' s \<and> (\<forall>t. t \<in> Q' s \<longrightarrow> t \<in> Q) \<and>
                                             (\<forall>t. t \<in> A' s \<longrightarrow> t \<in> A)"
   shows "\<Gamma>,\<Theta> \<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 using impl
 by -  (rule conseq [OF modif],blast)
 
 
 lemma Seq_NoFaultStuckD1:
   assumes noabort: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
   shows "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
 proof (rule final_notinI)
   fix t
   assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> t"
   show "t \<notin> {Stuck} \<union> Fault `  F"
   proof
     assume "t \<in> {Stuck} \<union> Fault `  F"
     moreover
     {
       assume "t = Stuck"
       with exec_c1
       have "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow> Stuck"
         by (auto intro: exec_Seq')
       with noabort have False
         by (auto simp add: final_notin_def)
       hence False ..
     }
     moreover
     {
       assume "t \<in> Fault ` F"
       then obtain f where
       t: "t=Fault f" and f: "f \<in> F"
         by auto
       from t exec_c1
       have "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec_Seq')
       with noabort f have False
         by (auto simp add: final_notin_def)
       hence False ..
     }
     ultimately show False by auto
   qed
 qed
 
 lemma Seq_NoFaultStuckD2:
   assumes noabort: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
   shows "\<forall>t. \<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> t \<longrightarrow> t\<notin> ({Stuck} \<union> Fault `  F) \<longrightarrow>
              \<Gamma>\<turnstile>\<langle>c2,t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
 using noabort
 by (auto simp add: final_notin_def intro: exec_Seq')
 
 
 lemma MGT_implies_complete:
   assumes MGT: "\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union>  Fault ` (-F))} c
                            {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                            {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   assumes valid: "\<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,{} \<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   using MGT
   apply (rule ConseqMGT)
   apply (insert valid)
   apply (auto simp add: valid_def intro!: final_notinI)
   done
 
 text \<open>Equipped only with the classic consequence rule @{thm "conseqPrePost"}
         we can only derive this syntactically more involved version
         of completeness. But semantically it is equivalent to the "real" one
         (see below)\<close>
 lemma MGT_implies_complete':
   assumes MGT: "\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub>
                        {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union>  Fault ` (-F))} c
                            {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                            {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   assumes valid: "\<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,{} \<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> s \<in> P} c {t. Z \<in> P \<longrightarrow> t \<in> Q},{t. Z \<in> P \<longrightarrow> t \<in> A}"
   using MGT [rule_format, of Z]
   apply (rule conseqPrePost)
   apply (insert valid)
   apply   (fastforce simp add: valid_def final_notin_def)
   apply  (fastforce simp add: valid_def)
   apply (fastforce simp add: valid_def)
   done
 
 text \<open>Semantic equivalence of both kind of formulations\<close>
 lemma valid_involved_to_valid:
   assumes valid:
     "\<forall>Z. \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> s \<in> P} c {t. Z \<in> P \<longrightarrow> t \<in> Q},{t. Z \<in> P \<longrightarrow> t \<in> A}"
   shows "\<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   using valid
   apply (simp add: valid_def)
   apply clarsimp
   apply (erule_tac x="x" in allE)
   apply (erule_tac x="Normal x" in allE)
   apply (erule_tac x=t in allE)
   apply fastforce
   done
 
 text \<open>The sophisticated consequence rule allow us to do this
         semantical transformation on the hoare-level, too.
         The magic is, that it allow us to
         choose the instance of @{term Z} under the assumption of an state @{term "s \<in> P"}\<close>
 lemma
   assumes deriv:
     "\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> s \<in> P} c {t. Z \<in> P \<longrightarrow> t \<in> Q},{t. Z \<in> P \<longrightarrow> t \<in> A}"
   shows "\<Gamma>,{} \<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (rule ConseqMGT [OF deriv])
   apply auto
   done
 
 lemma valid_to_valid_involved:
   "\<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow>
    \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> s \<in> P} c {t. Z \<in> P \<longrightarrow> t \<in> Q},{t. Z \<in> P \<longrightarrow> t \<in> A}"
 by (simp add: valid_def Collect_conv_if)
 
 lemma
   assumes deriv: "\<Gamma>,{} \<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> s \<in> P} c {t. Z \<in> P \<longrightarrow> t \<in> Q},{t. Z \<in> P \<longrightarrow> t \<in> A}"
   apply (rule conseqPrePost [OF deriv])
   apply auto
   done
 
 lemma conseq_extract_state_indep_prop:
   assumes state_indep_prop:"\<forall>s \<in> P. R"
   assumes to_show: "R \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (rule Conseq)
   apply (clarify)
   apply (rule_tac x="P" in exI)
   apply (rule_tac x="Q" in exI)
   apply (rule_tac x="A" in exI)
   using state_indep_prop to_show
   by blast
 
 
 lemma MGT_lemma:
   assumes MGT_Calls:
     "\<forall>p\<in>dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^bsub>/F\<^esub>
        {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
         (Call p)
        {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
        {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   shows "\<And>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c
              {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof (induct c)
   case Skip
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} Skip
            {t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoarep.Skip [THEN conseqPre])
        (auto elim: exec_elim_cases simp add: final_notin_def intro: exec.intros)
 next
   case (Basic f)
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} Basic f
            {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Normal t},
            {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoarep.Basic [THEN conseqPre])
        (auto elim: exec_elim_cases simp add: final_notin_def intro: exec.intros)
 next
   case (Spec r)
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} Spec r
            {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Normal t},
            {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (rule hoarep.Spec [THEN conseqPre])
     apply (clarsimp simp add: final_notin_def)
     apply (case_tac "\<exists>t. (Z,t) \<in> r")
     apply (auto elim: exec_elim_cases simp add: final_notin_def intro: exec.intros)
     done
 next
   case (Seq c1 c2)
   have hyp_c1: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c1
                            {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                            {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   have hyp_c2: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c2
                           {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                           {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   from hyp_c1
   have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c1
               {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t \<and>
                   \<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))},
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (auto dest: Seq_NoFaultStuckD1 [simplified] Seq_NoFaultStuckD2 [simplified]
              intro: exec.Seq)
   thus "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                    Seq c1 c2
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule hoarep.Seq )
     show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t \<and>
                       \<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                    c2
                  {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF hyp_c2],safe)
       fix r t
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal r" "\<Gamma>\<turnstile>\<langle>c2,Normal r\<rangle> \<Rightarrow> Normal t"
       then show "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t"
         by (iprover intro: exec.intros)
     next
       fix r t
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal r" "\<Gamma>\<turnstile>\<langle>c2,Normal r\<rangle> \<Rightarrow> Abrupt t"
       then show "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
         by (iprover intro: exec.intros)
     qed
   qed
 next
   case (Cond b c1 c2)
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c1
                  {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}\<inter>b)
                    c1
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (fastforce intro: exec.CondTrue simp add: final_notin_def)
   moreover
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c2
                     {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                     {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}\<inter>-b)
                   c2
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (fastforce intro: exec.CondFalse simp add: final_notin_def)
   ultimately
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                  Cond b c1 c2
               {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoarep.Cond)
 next
   case (While b c)
   let ?unroll = "({(s,t). s\<in>b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t})\<^sup>*"
   let ?P' = "\<lambda>Z. {t. (Z,t)\<in>?unroll \<and>
                     (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                          \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                              (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u))}"
   let ?A' = "\<lambda>Z. {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                 While b c
               {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [where ?P'="?P'"
                          and ?Q'="\<lambda>Z. ?P' Z \<inter> - b" and ?A'="?A'"])
     show "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (?P' Z) (While b c) (?P' Z \<inter> - b),(?A' Z)"
     proof (rule allI, rule hoarep.While)
       fix Z
       from While
       have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c
                         {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                         {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}" by iprover
       then show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (?P' Z  \<inter> b) c (?P' Z),(?A' Z)"
       proof (rule ConseqMGT)
         fix s
         assume  "s\<in> {t. (Z, t) \<in> ?unroll \<and>
                       (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u))}
                    \<inter> b"
         then obtain
           Z_s_unroll: "(Z,s) \<in> ?unroll" and
           noabort:"\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" and
           s_in_b: "s\<in>b"
           by blast
         show "s \<in> {t. t = s \<and> \<Gamma>\<turnstile>\<langle>c,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} \<and>
         (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t} \<longrightarrow>
              t \<in> {t. (Z, t) \<in> ?unroll \<and>
                   (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow>  e\<in>b
                        \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                            (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u))}) \<and>
          (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t} \<longrightarrow>
              t \<in> {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t})"
           (is "?C1 \<and> ?C2 \<and> ?C3")
         proof (intro conjI)
           from Z_s_unroll noabort s_in_b show ?C1 by blast
         next
           {
             fix t
             assume s_t: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t"
             moreover
             from Z_s_unroll s_t s_in_b
             have "(Z, t) \<in> ?unroll"
               by (blast intro: rtrancl_into_rtrancl)
             moreover note noabort
             ultimately
             have "(Z, t) \<in> ?unroll \<and>
                   (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u))"
               by iprover
           }
           then show ?C2 by blast
         next
           {
             fix t
             assume s_t:  "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t"
             from Z_s_unroll noabort s_t s_in_b
             have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
               by blast
           } thus ?C3 by simp
         qed
       qed
     qed
   next
     fix s
     assume P: "s \<in> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}"
     hence WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by auto
     show "s \<in> ?P' s \<and>
     (\<forall>t. t\<in>(?P' s \<inter> - b)\<longrightarrow>
          t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t})\<and>
     (\<forall>t. t\<in>?A' s \<longrightarrow> t\<in>?A' Z)"
     proof (intro conjI)
       {
         fix e
         assume "(Z,e) \<in> ?unroll" "e \<in> b"
         from this WhileNoFault
         have "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" (is "?Prop Z e")
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           assume e_in_b: "e \<in> b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           with e_in_b WhileNoFault
           have cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           moreover
           {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with e_in_b have "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           ultimately
           show "?Prop e e"
             by iprover
         next
           fix Z r
           assume e_in_b: "e\<in>b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           assume hyp: "\<lbrakk>e\<in>b;\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))\<rbrakk>
                        \<Longrightarrow> ?Prop r e"
           assume Z_r:
             "(Z, r) \<in> {(Z, r). Z \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r}"
           with WhileNoFault
           have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           from hyp [OF e_in_b this] obtain
             cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))" and
             Abrupt_r: "\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u \<longrightarrow>
                             \<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u"
             by simp
 
            {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with Abrupt_r have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u" by simp
             moreover from  Z_r obtain
               "Z \<in> b"  "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by simp
             ultimately have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           with cNoFault show "?Prop Z e"
             by iprover
         qed
       }
       with P show "s \<in> ?P' s"
         by blast
     next
       {
         fix t
         assume "termination": "t \<notin> b"
         assume "(Z, t) \<in> ?unroll"
         hence "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           from "termination"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal t\<rangle> \<Rightarrow> Normal t"
             by (blast intro: exec.WhileFalse)
         next
           fix Z r
           assume first_body:
                  "(Z, r) \<in> {(s, t). s \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
           assume "(r, t) \<in> ?unroll"
           assume rest_loop: "\<Gamma>\<turnstile>\<langle>While b c, Normal r\<rangle> \<Rightarrow> Normal t"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
           proof -
             from first_body obtain
               "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by fast
             moreover
             from rest_loop have
               "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Normal t"
               by fast
             ultimately show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
               by (rule exec.WhileTrue)
           qed
         qed
       }
       with P
       show "(\<forall>t. t\<in>(?P' s \<inter> - b)
             \<longrightarrow>t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t})"
         by blast
     next
       from P show "\<forall>t. t\<in>?A' s \<longrightarrow> t\<in>?A' Z" by simp
     qed
   qed
 next
   case (Call p)
   let ?P = "{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}"
   from noStuck_Call have "\<forall>s \<in> ?P. p \<in> dom \<Gamma>"
     by (fastforce simp add: final_notin_def )
   then show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ?P (Call p)
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule conseq_extract_state_indep_prop)
     assume p_definied: "p \<in> dom \<Gamma>"
     with MGT_Calls show
       "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s=Z \<and>
                  \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                   (Call p)
                  {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>Call  p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (auto)
   qed
 next
   case (DynCom c)
   have hyp:
     "\<And>s'. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c s',Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c s'
       {t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using DynCom by simp
   have hyp':
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s = Z \<and> \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c Z
         {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT [OF hyp])
        (fastforce simp add: final_notin_def intro: exec.intros)
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s = Z \<and> \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                DynCom c
              {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (rule hoarep.DynCom)
     apply (clarsimp)
     apply (rule hyp' [simplified])
     done
 next
   case (Guard f g c)
   have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c
                     {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                     {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Guard by iprover
   show ?case
   proof (cases "f \<in> F")
     case True
     from hyp_c
     have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>(g \<inter> {s. s = Z \<and>
                     \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (- F))})
              c
            {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Normal t},
            {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       apply (rule ConseqMGT)
       apply (insert True)
       apply (auto simp add: final_notin_def intro: exec.intros)
       done
     from True this
     show ?thesis
       by (rule conseqPre [OF Guarantee]) auto
   next
     case False
     from hyp_c
     have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>
            (g \<inter> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))})
            c
            {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Normal t},
            {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       apply (rule ConseqMGT)
       apply clarify
       apply (frule Guard_noFaultStuckD [OF _ False])
       apply (auto simp add: final_notin_def intro: exec.intros)
       done
     then show ?thesis
       apply (rule conseqPre [OF hoarep.Guard])
       apply clarify
       apply (frule Guard_noFaultStuckD [OF _ False])
       apply auto
       done
   qed
 next
   case Throw
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} Throw
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule conseqPre [OF hoarep.Throw]) (blast intro: exec.intros)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c\<^sub>1
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c\<^sub>1
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t \<and>
                    \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}"
     by (rule ConseqMGT)
        (fastforce intro: exec.intros simp add: final_notin_def)
   moreover
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))} c\<^sub>2
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow>Abrupt s \<and>
                    \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                c\<^sub>2
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (fastforce intro: exec.intros  simp add: final_notin_def)
   ultimately
   show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                    Catch c\<^sub>1 c\<^sub>2
               {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoarep.Catch)
 qed
 
 lemma MGT_Calls:
  "\<forall>p\<in>dom \<Gamma>. \<forall>Z.
      \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
             (Call p)
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof -
   {
     fix p Z
     assume defined: "p \<in> dom \<Gamma>"
     have
       "\<Gamma>,(\<Union>p\<in>dom \<Gamma>. \<Union>Z.
           {({s. s=Z \<and>
              \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))},
              p,
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t})})
        \<turnstile>\<^bsub>/F\<^esub>{s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
           (the (\<Gamma> p))
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       (is "\<Gamma>,?\<Theta> \<turnstile>\<^bsub>/F\<^esub> (?Pre p Z) (the (\<Gamma> p)) (?Post p Z),(?Abr p Z)")
     proof -
       have MGT_Calls:
        "\<forall>p\<in>dom \<Gamma>. \<forall>Z. \<Gamma>,?\<Theta> \<turnstile>\<^bsub>/F\<^esub>
         {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
          (Call p)
         {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
         {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
         by (intro ballI allI, rule HoarePartialDef.Asm,auto)
       have "\<forall>Z. \<Gamma>,?\<Theta>\<turnstile>\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>the (\<Gamma> p) ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault`(-F))}
                         (the (\<Gamma> p))
                         {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Normal t},
                         {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Abrupt t}"
         by (iprover intro: MGT_lemma [OF MGT_Calls])
       thus "\<Gamma>,?\<Theta>\<turnstile>\<^bsub>/F\<^esub> (?Pre p Z) (the (\<Gamma> p)) (?Post p Z),(?Abr p Z)"
         apply (rule ConseqMGT)
         apply (clarify,safe)
       proof -
         assume "\<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         with defined show "\<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           by (fastforce simp add: final_notin_def
                 intro: exec.intros)
       next
         fix t
         assume "\<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Normal t"
         with defined
         show "\<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow>Normal t"
           by  (auto intro: exec.Call)
       next
         fix t
         assume "\<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Abrupt t"
         with defined
         show "\<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow>Abrupt t"
           by  (auto intro: exec.Call)
       qed
     qed
   }
   then show ?thesis
     apply -
     apply (intro ballI allI)
     apply (rule CallRec' [where Procs="dom \<Gamma>"  and
       P="\<lambda>p Z. {s. s=Z \<and>
                   \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}"and
       Q="\<lambda>p Z.
         {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t}" and
       A="\<lambda>p Z.
         {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"] )
     apply simp+
     done
 qed
 
 theorem hoare_complete: "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   by (iprover intro: MGT_implies_complete MGT_lemma [OF MGT_Calls])
 
 lemma hoare_complete':
   assumes cvalid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   shows  "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 proof (cases "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A")
   case True
   hence "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
     by (rule hoare_complete)
   thus "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P c Q,A"
     by (rule hoare_augment_context) simp
 next
   case False
   with cvalid
   show ?thesis
     by (rule ExFalso)
 qed
 
 
 lemma hoare_strip_\<Gamma>:
   assumes deriv: "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
   assumes F': "F' \<subseteq> -F"
   shows "strip F' \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
 proof (rule hoare_complete)
   from hoare_sound [OF deriv] have "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P p Q,A"
     by (simp add: cvalid_def)
   from this F'
   show "strip F' \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P p Q,A"
     by (rule valid_to_valid_strip)
 qed
 
 
 subsection \<open>And Now: Some Useful Rules\<close>
 
 subsubsection \<open>Consequence\<close>
 
 
 lemma LiberalConseq_sound:
 fixes F::"'f set"
 assumes cons: "\<forall>s \<in> P. \<forall>(t::('s,'f) xstate). \<exists>P' Q' A'. (\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P' c Q',A') \<and>
                 ((s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A')
                               \<longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A)"
 shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A "
 proof (rule cnvalidI)
   fix s t
   assume ctxt:"\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from P cons obtain P' Q' A' where
       spec: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P' c Q',A'" and
       adapt: "(s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A')
                               \<longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A"
       apply -
       apply (drule (1) bspec)
       apply (erule_tac x=t in allE)
       apply (elim exE conjE)
       apply iprover
       done
     from exec spec ctxt t_notin_F
     have "s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A'"
       by (simp add: cnvalid_def nvalid_def)
     with adapt show ?thesis
       by simp
   qed
 qed
 
 lemma LiberalConseq:
 fixes F:: "'f set"
 assumes cons: "\<forall>s \<in> P.  \<forall>(t::('s,'f) xstate). \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<and>
                 ((s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A')
                               \<longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A "
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule LiberalConseq_sound)
 using cons
 apply (clarify)
 apply (drule (1) bspec)
 apply (erule_tac x=t in allE)
 apply clarify
 apply (rule_tac x=P' in exI)
 apply (rule_tac x=Q' in exI)
 apply (rule_tac x=A' in exI)
 apply (rule conjI)
 apply (blast intro: hoare_cnvalid)
 apply assumption
 done
 
 lemma "\<forall>s \<in> P. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<and> s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A
            \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (rule LiberalConseq)
   apply (rule ballI)
   apply (drule (1) bspec)
   apply clarify
   apply (rule_tac x=P' in exI)
   apply (rule_tac x=Q' in exI)
   apply (rule_tac x=A' in exI)
   apply auto
   done
 
 lemma
 fixes F:: "'f set"
 assumes cons: "\<forall>s \<in> P.  \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<and>
                 (\<forall>(t::('s,'f) xstate). (s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A')
                               \<longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A "
   apply (rule Conseq)
   apply (rule ballI)
   apply (insert cons)
   apply (drule (1) bspec)
   apply clarify
   apply (rule_tac x=P' in exI)
   apply (rule_tac x=Q' in exI)
   apply (rule_tac x=A' in exI)
   apply (rule conjI)
   apply  assumption
   (* no way to get s \<in> P' *)
   oops
 
 lemma LiberalConseq':
 fixes F:: "'f set"
 assumes cons: "\<forall>s \<in> P.  \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' c Q',A' \<and>
                 (\<forall>(t::('s,'f) xstate). (s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A')
                               \<longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A "
 apply (rule LiberalConseq)
 apply (rule ballI)
 apply (rule allI)
 apply (insert cons)
 apply (drule (1) bspec)
 apply clarify
 apply (rule_tac x=P' in exI)
 apply (rule_tac x=Q' in exI)
 apply (rule_tac x=A' in exI)
 apply iprover
 done
 
 lemma LiberalConseq'':
 fixes F:: "'f set"
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)"
 assumes cons: "\<forall>s (t::('s,'f) xstate).
                  (\<forall>Z. s \<in> P' Z \<longrightarrow> t \<in> Normal ` Q' Z \<union> Abrupt ` A' Z)
                   \<longrightarrow> (s \<in> P \<longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A "
 apply (rule LiberalConseq)
 apply (rule ballI)
 apply (rule allI)
 apply (insert cons)
 apply (erule_tac x=s in allE)
 apply (erule_tac x=t in allE)
 apply (case_tac "t \<in> Normal ` Q \<union> Abrupt ` A")
 apply (insert spec)
 apply  iprover
 apply auto
 done
 
 primrec procs:: "('s,'p,'f) com \<Rightarrow> 'p set"
 where
 "procs Skip = {}" |
 "procs (Basic f) = {}" |
 "procs (Seq c\<^sub>1 c\<^sub>2)  = (procs c\<^sub>1 \<union> procs c\<^sub>2)" |
 "procs (Cond b c\<^sub>1 c\<^sub>2) = (procs c\<^sub>1 \<union> procs c\<^sub>2)" |
 "procs (While b c) = procs c" |
 "procs (Call p) = {p}" |
 "procs (DynCom c) = (\<Union>s. procs (c s))" |
 "procs (Guard f g c) = procs c" |
 "procs Throw = {}" |
 "procs (Catch c\<^sub>1 c\<^sub>2) = (procs c\<^sub>1 \<union> procs c\<^sub>2)"
 
 primrec noSpec:: "('s,'p,'f) com \<Rightarrow> bool"
 where
 "noSpec Skip = True" |
 "noSpec (Basic f) = True" |
 "noSpec (Spec r) = False" |
 "noSpec (Seq c\<^sub>1 c\<^sub>2)  = (noSpec c\<^sub>1 \<and> noSpec c\<^sub>2)" |
 "noSpec (Cond b c\<^sub>1 c\<^sub>2) = (noSpec c\<^sub>1 \<and> noSpec c\<^sub>2)" |
 "noSpec (While b c) = noSpec c" |
 "noSpec (Call p) = True" |
 "noSpec (DynCom c) = (\<forall>s. noSpec (c s))" |
 "noSpec (Guard f g c) = noSpec c" |
 "noSpec Throw = True" |
 "noSpec (Catch c\<^sub>1 c\<^sub>2) = (noSpec c\<^sub>1 \<and> noSpec c\<^sub>2)"
 
 lemma exec_noSpec_no_Stuck:
  assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes noSpec_c: "noSpec c"
  assumes noSpec_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noSpec (the (\<Gamma> p))"
  assumes procs_subset: "procs c \<subseteq> dom \<Gamma>"
  assumes procs_subset_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. procs (the (\<Gamma> p)) \<subseteq> dom \<Gamma>"
  assumes s_no_Stuck: "s\<noteq>Stuck"
  shows "t\<noteq>Stuck"
 using exec noSpec_c procs_subset s_no_Stuck proof induct
   case (Call p bdy s t) with noSpec_\<Gamma> procs_subset_\<Gamma> show ?case
     by (auto dest!: bspec [of _ _ p])
 next
   case (DynCom c s t) then show ?case
    by auto blast
 qed auto
 
 lemma execn_noSpec_no_Stuck:
  assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes noSpec_c: "noSpec c"
  assumes noSpec_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noSpec (the (\<Gamma> p))"
  assumes procs_subset: "procs c \<subseteq> dom \<Gamma>"
  assumes procs_subset_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. procs (the (\<Gamma> p)) \<subseteq> dom \<Gamma>"
  assumes s_no_Stuck: "s\<noteq>Stuck"
  shows "t\<noteq>Stuck"
 using exec noSpec_c procs_subset s_no_Stuck proof induct
   case (Call p bdy n s t) with noSpec_\<Gamma> procs_subset_\<Gamma> show ?case
     by (auto dest!: bspec [of _ _ p])
 next
   case (DynCom c s t) then show ?case
     by auto blast
 qed auto
 
 lemma LiberalConseq_noguards_nothrows_sound:
 assumes spec: "\<forall>Z. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)"
 assumes cons: "\<forall>s t. (\<forall>Z. s \<in> P' Z \<longrightarrow> t \<in>  Q' Z )
                   \<longrightarrow> (s \<in> P \<longrightarrow> t \<in> Q )"
 assumes noguards_c: "noguards c"
 assumes noguards_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noguards (the (\<Gamma> p))"
 assumes nothrows_c: "nothrows c"
 assumes nothrows_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. nothrows (the (\<Gamma> p))"
 assumes noSpec_c: "noSpec c"
 assumes noSpec_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noSpec (the (\<Gamma> p))"
 assumes procs_subset: "procs c \<subseteq> dom \<Gamma>"
 assumes procs_subset_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. procs (the (\<Gamma> p)) \<subseteq> dom \<Gamma>"
 shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A "
 proof (rule cnvalidI)
   fix s t
   assume ctxt:"\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from execn_noguards_no_Fault [OF exec noguards_c noguards_\<Gamma>]
      execn_nothrows_no_Abrupt [OF exec nothrows_c nothrows_\<Gamma> ]
      execn_noSpec_no_Stuck [OF exec
               noSpec_c  noSpec_\<Gamma> procs_subset
       procs_subset_\<Gamma>]
     obtain t' where t: "t=Normal t'"
       by (cases t) auto
     with exec spec ctxt
     have "(\<forall>Z. s \<in> P' Z \<longrightarrow> t' \<in>  Q' Z)"
       by (unfold  cnvalid_def nvalid_def) blast
     with cons P t show ?thesis
       by simp
   qed
 qed
 
 
 lemma LiberalConseq_noguards_nothrows:
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)"
 assumes cons: "\<forall>s t. (\<forall>Z. s \<in> P' Z \<longrightarrow> t \<in>  Q' Z )
                   \<longrightarrow> (s \<in> P \<longrightarrow> t \<in> Q )"
 assumes noguards_c: "noguards c"
 assumes noguards_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noguards (the (\<Gamma> p))"
 assumes nothrows_c: "nothrows c"
 assumes nothrows_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. nothrows (the (\<Gamma> p))"
 assumes noSpec_c: "noSpec c"
 assumes noSpec_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noSpec (the (\<Gamma> p))"
 assumes procs_subset: "procs c \<subseteq> dom \<Gamma>"
 assumes procs_subset_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. procs (the (\<Gamma> p)) \<subseteq> dom \<Gamma>"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A "
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule LiberalConseq_noguards_nothrows_sound
              [OF _ cons noguards_c noguards_\<Gamma> nothrows_c nothrows_\<Gamma>
                  noSpec_c noSpec_\<Gamma>
                  procs_subset procs_subset_\<Gamma>])
 apply (insert spec)
 apply (intro allI)
 apply (erule_tac x=Z in allE)
 by (rule hoare_cnvalid)
 
 lemma
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s=fst Z \<and> P s (snd Z)} c {t. Q (fst Z) (snd Z) t},{}"
 assumes noguards_c: "noguards c"
 assumes noguards_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noguards (the (\<Gamma> p))"
 assumes nothrows_c: "nothrows c"
 assumes nothrows_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. nothrows (the (\<Gamma> p))"
 assumes noSpec_c: "noSpec c"
 assumes noSpec_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noSpec (the (\<Gamma> p))"
 assumes procs_subset: "procs c \<subseteq> dom \<Gamma>"
 assumes procs_subset_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. procs (the (\<Gamma> p)) \<subseteq> dom \<Gamma>"
 shows "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub>{s. s=\<sigma>} c {t. \<forall>l. P \<sigma> l \<longrightarrow> Q \<sigma> l t},{}"
 apply (rule allI)
 apply (rule LiberalConseq_noguards_nothrows
               [OF spec _ noguards_c noguards_\<Gamma> nothrows_c nothrows_\<Gamma>
                   noSpec_c noSpec_\<Gamma>
                   procs_subset procs_subset_\<Gamma>])
 apply auto
 done
 
 subsubsection \<open>Modify Return\<close>
 
-lemma ProcModifyReturn_sound:
-  assumes valid_call: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P call init p return' c Q,A"
+lemma Proc_exnModifyReturn_sound:
+  assumes valid_call: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P call_exn init p return' result_exn c Q,A"
   assumes valid_modif:
     "\<forall>\<sigma>. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
   assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s)
            \<longrightarrow> return' s t = return s t"
   assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
-                             \<longrightarrow> return' s t = return s t"
-  shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+                             \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
     by (auto intro: nvalid_augment_Faults)
-  assume exec: "\<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =n\<Rightarrow> t"
+  assume exec: "\<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from exec
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: execn_call_Normal_elim)
+  proof (cases rule: execn_call_exn_Normal_elim)
     fix bdy m t'
     assume bdy: "\<Gamma> p = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Normal t'"
     assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
     assume n: "n = Suc m"
     from exec_body n bdy
     have "\<Gamma>\<turnstile>\<langle>Call p,Normal (init s)\<rangle> =n\<Rightarrow> Normal t'"
       by (auto simp add: intro: execn.Call)
     from cnvalidD [OF valid_modif [rule_format, of n "init s"] ctxt' this] P
     have "t' \<in> Modif (init s)"
       by auto
     with ret_modif have "Normal (return' s t') =
       Normal (return s t')"
       by simp
     with exec_body exec_c bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_call)
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exn)
     from cnvalidD [OF valid_call [rule_format] ctxt this] P t_notin_F
     show ?thesis
       by simp
   next
     fix bdy m t'
     assume bdy: "\<Gamma> p = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Abrupt t'"
     assume n: "n = Suc m"
-    assume t: "t = Abrupt (return s t')"
+    assume t: "t = Abrupt (result_exn (return s t') t')"
     also from exec_body n bdy
     have "\<Gamma>\<turnstile>\<langle>Call p,Normal (init s)\<rangle> =n\<Rightarrow> Abrupt t'"
       by (auto simp add: intro: execn.intros)
     from cnvalidD [OF valid_modif [rule_format, of n "init s"] ctxt' this] P
     have "t' \<in> ModifAbr (init s)"
       by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
+    with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
       by simp
-    finally have "t = Abrupt (return' s t')"  .
+    finally have "t = Abrupt (result_exn (return' s t') t')"  .
     with exec_body bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callAbrupt)
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnAbrupt)
     from cnvalidD [OF valid_call [rule_format] ctxt this] P t_notin_F
     show ?thesis
       by simp
   next
     fix bdy m f
     assume bdy: "\<Gamma> p = Some bdy"
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Fault f" "n = Suc m"
       "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callFault)
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnFault)
     from valid_call [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   next
     fix bdy m
     assume bdy: "\<Gamma> p = Some bdy"
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Stuck" "n = Suc m"
       "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callStuck)
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnStuck)
     from valid_call [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   next
     fix m
     assume "\<Gamma> p = None"
     and  "n = Suc m" "t = Stuck"
-    then have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callUndefined)
+    then have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnUndefined)
     from valid_call [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   qed
 qed
 
+lemma ProcModifyReturn_sound:
+  assumes valid_call: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P call init p return' c Q,A"
+  assumes valid_modif:
+    "\<forall>\<sigma>. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
+  assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s)
+           \<longrightarrow> return' s t = return s t"
+  assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
+                             \<longrightarrow> return' s t = return s t"
+  shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using valid_call valid_modif ret_modif ret_modifAbr
+  unfolding call_call_exn
+  by (rule Proc_exnModifyReturn_sound)
+
+lemma Proc_exnModifyReturn:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes result_conform:
+      "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes return_conform:
+      "\<forall>s t. t \<in> ModifAbr (init s)
+             \<longrightarrow> (result_exn (return' s t) t) = (result_exn (return s t) t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule hoare_complete')
+apply (rule allI)
+apply (rule Proc_exnModifyReturn_sound
+          [where Modif=Modif and ModifAbr=ModifAbr,
+            OF _ _ result_conform return_conform] )
+using spec
+apply (blast intro: hoare_cnvalid)
+using modifies_spec
+apply (blast intro: hoare_cnvalid)
+done
 
 lemma ProcModifyReturn:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes result_conform:
       "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes return_conform:
       "\<forall>s t. t \<in> ModifAbr (init s)
              \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
-apply (rule hoare_complete')
-apply (rule allI)
-apply (rule ProcModifyReturn_sound
-          [where Modif=Modif and ModifAbr=ModifAbr,
-            OF _ _ result_conform return_conform] )
-using spec
-apply (blast intro: hoare_cnvalid)
-using modifies_spec
-apply (blast intro: hoare_cnvalid)
-done
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using spec result_conform return_conform modifies_spec
+  unfolding call_call_exn
+  by (rule Proc_exnModifyReturn)
 
-lemma ProcModifyReturnSameFaults_sound:
-  assumes valid_call: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P call init p return' c Q,A"
+lemma Proc_exnModifyReturnSameFaults_sound:
+  assumes valid_call: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P call_exn init p return' result_exn c Q,A"
   assumes valid_modif:
     "\<forall>\<sigma>. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
   assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s)
            \<longrightarrow> return' s t = return s t"
   assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
-                             \<longrightarrow> return' s t = return s t"
-  shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+                             \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
-  assume exec: "\<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =n\<Rightarrow> t"
+  assume exec: "\<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from exec
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: execn_call_Normal_elim)
+  proof (cases rule: execn_call_exn_Normal_elim)
     fix bdy m t'
     assume bdy: "\<Gamma> p = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Normal t'"
     assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
     assume n: "n = Suc m"
     from exec_body n bdy
     have "\<Gamma>\<turnstile>\<langle>Call p,Normal (init s)\<rangle> =n\<Rightarrow> Normal t'"
       by (auto simp add: intro: execn.intros)
     from cnvalidD [OF valid_modif [rule_format, of n "init s"] ctxt this] P
     have "t' \<in> Modif (init s)"
       by auto
     with ret_modif have "Normal (return' s t') =
       Normal (return s t')"
       by simp
     with exec_body exec_c bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_call)
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exn)
     from cnvalidD [OF valid_call [rule_format] ctxt this] P t_notin_F
     show ?thesis
       by simp
   next
     fix bdy m t'
     assume bdy: "\<Gamma> p = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Abrupt t'"
     assume n: "n = Suc m"
-    assume t: "t = Abrupt (return s t')"
+    assume t: "t = Abrupt (result_exn (return s t') t')"
     also
     from exec_body n bdy
     have "\<Gamma>\<turnstile>\<langle>Call p,Normal (init s)\<rangle> =n \<Rightarrow> Abrupt t'"
       by (auto simp add: intro: execn.intros)
     from cnvalidD [OF valid_modif [rule_format, of n "init s"] ctxt this] P
     have "t' \<in> ModifAbr (init s)"
       by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
+    with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
       by simp
-    finally have "t = Abrupt (return' s t')" .
+    finally have "t = Abrupt (result_exn (return' s t') t')" .
     with exec_body bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callAbrupt)
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnAbrupt)
     from cnvalidD [OF valid_call [rule_format] ctxt this] P t_notin_F
     show ?thesis
       by simp
   next
     fix bdy m f
     assume bdy: "\<Gamma> p = Some bdy"
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Fault f" "n = Suc m"  and
       t: "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callFault)
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnFault)
     from cnvalidD [OF valid_call [rule_format] ctxt this P] t t_notin_F
     show ?thesis
       by simp
   next
     fix bdy m
     assume bdy: "\<Gamma> p = Some bdy"
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Stuck" "n = Suc m"
       "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callStuck)
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnStuck)
     from valid_call [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   next
     fix m
     assume "\<Gamma> p = None"
     and  "n = Suc m" "t = Stuck"
-    then have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callUndefined)
+    then have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+      by (auto intro: execn_call_exnUndefined)
     from valid_call [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   qed
 qed
 
+lemma ProcModifyReturnSameFaults_sound:
+  assumes valid_call: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P call init p return' c Q,A"
+  assumes valid_modif:
+    "\<forall>\<sigma>. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
+  assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s)
+           \<longrightarrow> return' s t = return s t"
+  assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
+                             \<longrightarrow> return' s t = return s t"
+  shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using valid_call valid_modif ret_modif ret_modifAbr
+  unfolding call_call_exn
+  by (rule Proc_exnModifyReturnSameFaults_sound)
+
+
+lemma Proc_exnModifyReturnSameFaults:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes result_conform:
+      "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes return_conform:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> (result_exn (return' s t) t) = (result_exn (return s t) t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule hoare_complete')
+apply (rule allI)
+apply (rule Proc_exnModifyReturnSameFaults_sound
+          [where Modif=Modif and ModifAbr=ModifAbr,
+         OF _ _ result_conform return_conform])
+using spec
+apply (blast intro: hoare_cnvalid)
+using modifies_spec
+apply (blast intro: hoare_cnvalid)
+done
+
 
 lemma ProcModifyReturnSameFaults:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes result_conform:
       "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes return_conform:
   "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
-apply (rule hoare_complete')
-apply (rule allI)
-apply (rule ProcModifyReturnSameFaults_sound
-          [where Modif=Modif and ModifAbr=ModifAbr,
-         OF _ _ result_conform return_conform])
-using spec
-apply (blast intro: hoare_cnvalid)
-using modifies_spec
-apply (blast intro: hoare_cnvalid)
-done
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using spec result_conform return_conform modifies_spec
+  unfolding call_call_exn
+  by (rule Proc_exnModifyReturnSameFaults)
+
 
 subsubsection \<open>DynCall\<close>
 
+
+
+lemma dynProc_exnModifyReturn_sound:
+assumes valid_call: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes valid_modif:
+    "\<forall>s \<in> P. \<forall>\<sigma>. \<forall>n.
+       \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s)
+           \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
+                             \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+proof (rule cnvalidI)
+  fix s t
+  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
+  then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
+    by (auto intro: nvalid_augment_Faults)
+  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+  assume t_notin_F: "t \<notin> Fault ` F"
+  assume P: "s \<in> P"
+  with valid_modif
+  have valid_modif': "\<forall>\<sigma>. \<forall>n.
+       \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+    by blast
+  from exec thm execn_Normal_elim_cases
+  have exec_call: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (call_exn init (p s) return result_exn c),Normal s\<rangle> =n\<Rightarrow> t"
+    by (cases rule: execn_dynCall_exn_Normal_elim)
+  then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+  proof (cases rule: execn_maybe_guard_Normal_elim_cases)
+    case noFault
+    from noFault have guards_ok: "s \<in> g" by simp
+    from noFault have "\<Gamma>\<turnstile> \<langle>call_exn init (p s) return result_exn c,Normal s\<rangle> =n\<Rightarrow> t" by simp
+    then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+    proof (cases rule: execn_call_exn_Normal_elim)
+      fix bdy m t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Normal t'"
+      assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
+      assume n: "n = Suc m"
+      from exec_body n bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n\<Rightarrow> Normal t'"
+        by (auto simp add: intro: execn.intros)
+      from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt' this] P
+      have "t' \<in> Modif (init s)"
+        by auto
+      with ret_modif have "Normal (return' s t') = Normal (return s t')"
+        by simp
+      with exec_body exec_c bdy n
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exn)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from cnvalidD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy m t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Abrupt t'"
+      assume n: "n = Suc m"
+      assume t: "t = Abrupt (result_exn (return s t') t')"
+      also from exec_body n bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n\<Rightarrow> Abrupt t'"
+        by (auto simp add: intro: execn.intros)
+      from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt' this] P
+      have "t' \<in> ModifAbr (init s)"
+        by auto
+      with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
+        by simp
+      finally have "t = Abrupt (result_exn (return' s t') t')" .
+      with exec_body bdy n
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnAbrupt)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from cnvalidD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy m f'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Fault f'" "n = Suc m"
+        "t = Fault f'"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnFault)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cnvalidD)
+    next
+      fix bdy m
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Stuck" "n = Suc m"
+        "t = Stuck"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnStuck)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cnvalidD)
+    next
+      fix m
+      assume "\<Gamma> (p s) = None"
+      and  "n = Suc m" "t = Stuck"
+      hence "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnUndefined)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cnvalidD)
+    qed
+  next
+    case (someFault)
+    then obtain guards_fail:"s \<notin> g"
+      and t: "t = Fault f" by simp
+    from execn_maybe_guard_Fault [OF guards_fail] t
+    have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+    from cnvalidD [OF valid_call ctxt this] P t_notin_F
+    show ?thesis by simp
+  qed
+qed
+
 lemma dynProcModifyReturn_sound:
 assumes valid_call: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes valid_modif:
     "\<forall>s \<in> P. \<forall>\<sigma>. \<forall>n.
        \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s)
            \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
                              \<longrightarrow> return' s t = return s t"
 shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-proof (rule cnvalidI)
-  fix s t
-  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
-  then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
-    by (auto intro: nvalid_augment_Faults)
-  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> =n\<Rightarrow> t"
-  assume t_notin_F: "t \<notin> Fault ` F"
-  assume P: "s \<in> P"
-  with valid_modif
-  have valid_modif': "\<forall>\<sigma>. \<forall>n.
-       \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
-    by blast
-  from exec
-  have "\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> =n\<Rightarrow> t"
-    by (cases rule: execn_dynCall_Normal_elim)
-  then show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: execn_call_Normal_elim)
-    fix bdy m t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Normal t'"
-    assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
-    assume n: "n = Suc m"
-    from exec_body n bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n\<Rightarrow> Normal t'"
-      by (auto simp add: intro: execn.intros)
-    from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt' this] P
-    have "t' \<in> Modif (init s)"
-      by auto
-    with ret_modif have "Normal (return' s t') = Normal (return s t')"
-      by simp
-    with exec_body exec_c bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_call)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from cnvalidD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy m t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Abrupt t'"
-    assume n: "n = Suc m"
-    assume t: "t = Abrupt (return s t')"
-    also from exec_body n bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n\<Rightarrow> Abrupt t'"
-      by (auto simp add: intro: execn.intros)
-    from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt' this] P
-    have "t' \<in> ModifAbr (init s)"
-      by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
-      by simp
-    finally have "t = Abrupt (return' s t')" .
-    with exec_body bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callAbrupt)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from cnvalidD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy m f
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Fault f" "n = Suc m"
-      "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callFault)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cnvalidD)
-  next
-    fix bdy m
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Stuck" "n = Suc m"
-      "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callStuck)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cnvalidD)
-  next
-    fix m
-    assume "\<Gamma> (p s) = None"
-    and  "n = Suc m" "t = Stuck"
-    hence "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callUndefined)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cnvalidD)
-  qed
-qed
+  using valid_call valid_modif ret_modif ret_modifAbr
+  unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturn_sound)
+
+
+lemma dynProc_exnModifyReturn:
+assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s)
+           \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
+                             \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+assumes modif:
+    "\<forall>s \<in> P. \<forall>\<sigma>.
+       \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+apply (rule hoare_complete')
+apply (rule allI)
+apply (rule dynProc_exnModifyReturn_sound [where Modif=Modif and ModifAbr=ModifAbr,
+          OF hoare_cnvalid [OF dyn_call] _ ret_modif ret_modifAbr])
+apply (intro ballI allI)
+apply (rule hoare_cnvalid [OF modif [rule_format]])
+apply assumption
+done
 
 lemma dynProcModifyReturn:
 assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s)
            \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
                              \<longrightarrow> return' s t = return s t"
 assumes modif:
     "\<forall>s \<in> P. \<forall>\<sigma>.
        \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-apply (rule hoare_complete')
-apply (rule allI)
-apply (rule dynProcModifyReturn_sound [where Modif=Modif and ModifAbr=ModifAbr,
-          OF hoare_cnvalid [OF dyn_call] _ ret_modif ret_modifAbr])
-apply (intro ballI allI)
-apply (rule hoare_cnvalid [OF modif [rule_format]])
-apply assumption
-done
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using dyn_call ret_modif ret_modifAbr modif
+  unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturn)
+
+lemma dynProc_exnModifyReturnSameFaults_sound:
+assumes valid_call: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes valid_modif:
+    "\<forall>s \<in> P. \<forall>\<sigma>. \<forall>n.
+       \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+proof (rule cnvalidI)
+  fix s t
+  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
+  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+  assume t_notin_F: "t \<notin> Fault ` F"
+  assume P: "s \<in> P"
+  with valid_modif
+  have valid_modif': "\<forall>\<sigma>. \<forall>n.
+    \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+    by blast
+  from exec
+  have exec_call: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (call_exn init (p s) return result_exn c),Normal s\<rangle> =n\<Rightarrow> t"
+    by (cases rule: execn_dynCall_exn_Normal_elim)
+  then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+  proof (cases rule: execn_maybe_guard_Normal_elim_cases)
+    case noFault
+    from noFault have guards_ok: "s \<in> g" by simp
+    from noFault have "\<Gamma>\<turnstile> \<langle>call_exn init (p s) return result_exn c,Normal s\<rangle> =n\<Rightarrow> t" by simp
+    then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+
+    proof (cases rule: execn_call_exn_Normal_elim)
+      fix bdy m t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Normal t'"
+      assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
+      assume n: "n = Suc m"
+      from exec_body n bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n \<Rightarrow> Normal t'"
+        by (auto simp add: intro: execn.Call)
+      from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt this] P
+      have "t' \<in> Modif (init s)"
+        by auto
+      with ret_modif have "Normal (return' s t') = Normal (return s t')"
+        by simp
+      with exec_body exec_c bdy n
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exn)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from cnvalidD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy m t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Abrupt t'"
+      assume n: "n = Suc m"
+      assume t: "t = Abrupt (result_exn (return s t') t')"
+      also from exec_body n bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n \<Rightarrow> Abrupt t'"
+        by (auto simp add: intro: execn.intros)
+      from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt this] P
+      have "t' \<in> ModifAbr (init s)"
+        by auto
+      with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
+        by simp
+      finally have "t = Abrupt (result_exn (return' s t') t')" .
+      with exec_body bdy n
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnAbrupt)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from cnvalidD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy m f'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Fault f'" "n = Suc m"  and
+        t: "t = Fault f'"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnFault)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from cnvalidD [OF valid_call ctxt this P] t t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy m
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Stuck" "n = Suc m"
+        "t = Stuck"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnStuck)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cnvalidD)
+    next
+      fix m
+      assume "\<Gamma> (p s) = None"
+      and  "n = Suc m" "t = Stuck"
+      hence "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> =n\<Rightarrow> t"
+        by (auto intro: execn_call_exnUndefined)
+      from execn_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+        by (simp add: dynCall_exn_def execn_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cnvalidD)
+    qed
+  next
+    case (someFault)
+    then obtain guards_fail:"s \<notin> g"
+      and t: "t = Fault f" by simp
+    from execn_maybe_guard_Fault [OF guards_fail] t
+    have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (simp add: dynCall_exn_def execn_guards_DynCom)
+    from cnvalidD [OF valid_call ctxt this] P t_notin_F
+    show ?thesis by simp
+  qed
+qed
+
 
 lemma dynProcModifyReturnSameFaults_sound:
 assumes valid_call: "\<And>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes valid_modif:
     "\<forall>s \<in> P. \<forall>\<sigma>. \<forall>n.
        \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
 shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-proof (rule cnvalidI)
-  fix s t
-  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
-  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> =n\<Rightarrow> t"
-  assume t_notin_F: "t \<notin> Fault ` F"
-  assume P: "s \<in> P"
-  with valid_modif
-  have valid_modif': "\<forall>\<sigma>. \<forall>n.
-    \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
-    by blast
-  from exec
-  have "\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> =n\<Rightarrow> t"
-    by (cases rule: execn_dynCall_Normal_elim)
-  then show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: execn_call_Normal_elim)
-    fix bdy m t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Normal t'"
-    assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
-    assume n: "n = Suc m"
-    from exec_body n bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n \<Rightarrow> Normal t'"
-      by (auto simp add: intro: execn.Call)
-    from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt this] P
-    have "t' \<in> Modif (init s)"
-      by auto
-    with ret_modif have "Normal (return' s t') = Normal (return s t')"
-      by simp
-    with exec_body exec_c bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_call)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from cnvalidD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy m t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Abrupt t'"
-    assume n: "n = Suc m"
-    assume t: "t = Abrupt (return s t')"
-    also from exec_body n bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> =n \<Rightarrow> Abrupt t'"
-      by (auto simp add: intro: execn.intros)
-    from cnvalidD [OF valid_modif' [rule_format, of n "init s"] ctxt this] P
-    have "t' \<in> ModifAbr (init s)"
-      by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
-      by simp
-    finally have "t = Abrupt (return' s t')" .
-    with exec_body bdy n
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callAbrupt)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from cnvalidD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy m f
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Fault f" "n = Suc m"  and
-      t: "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callFault)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from cnvalidD [OF valid_call ctxt this P] t t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy m
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =m\<Rightarrow> Stuck" "n = Suc m"
-      "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callStuck)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cnvalidD)
-  next
-    fix m
-    assume "\<Gamma> (p s) = None"
-    and  "n = Suc m" "t = Stuck"
-    hence "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> =n\<Rightarrow> t"
-      by (auto intro: execn_callUndefined)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> =n\<Rightarrow> t"
-      by (rule execn_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cnvalidD)
-  qed
-qed
+  using valid_call valid_modif ret_modif ret_modifAbr
+  unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturnSameFaults_sound)
+
+lemma dynProc_exnModifyReturnSameFaults:
+assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s)
+           \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
+                             \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+assumes modif:
+    "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+apply (rule hoare_complete')
+apply (rule allI)
+apply (rule dynProc_exnModifyReturnSameFaults_sound
+        [where Modif=Modif and ModifAbr=ModifAbr,
+           OF hoare_cnvalid [OF dyn_call] _ ret_modif ret_modifAbr])
+apply (intro ballI allI)
+apply (rule hoare_cnvalid [OF modif [rule_format]])
+apply assumption
+  done
 
 lemma dynProcModifyReturnSameFaults:
 assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s)
            \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
                              \<longrightarrow> return' s t = return s t"
 assumes modif:
     "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-apply (rule hoare_complete')
-apply (rule allI)
-apply (rule dynProcModifyReturnSameFaults_sound
-        [where Modif=Modif and ModifAbr=ModifAbr,
-           OF hoare_cnvalid [OF dyn_call] _ ret_modif ret_modifAbr])
-apply (intro ballI allI)
-apply (rule hoare_cnvalid [OF modif [rule_format]])
-apply assumption
-done
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using dyn_call ret_modif ret_modifAbr modif
+  unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturnSameFaults)
 
 
 subsubsection \<open>Conjunction of Postcondition\<close>
 
 lemma PostConjI_sound:
 assumes valid_Q: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 assumes valid_R: "\<forall>n. \<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P c R,B"
 shows "\<Gamma>,\<Theta> \<Turnstile>n:\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from valid_Q [rule_format] ctxt exec P t_notin_F have "t \<in> Normal ` Q \<union> Abrupt ` A"
     by (rule cnvalidD)
   moreover
   from valid_R [rule_format] ctxt exec P t_notin_F have "t \<in> Normal ` R \<union> Abrupt ` B"
     by (rule cnvalidD)
   ultimately show "t \<in> Normal ` (Q \<inter> R) \<union> Abrupt ` (A \<inter> B)"
     by blast
 qed
 
 lemma PostConjI:
   assumes deriv_Q: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes deriv_R: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c R,B"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule PostConjI_sound)
 using deriv_Q
 apply (blast intro: hoare_cnvalid)
 using deriv_R
 apply (blast intro: hoare_cnvalid)
 done
 
 lemma Merge_PostConj_sound:
   assumes validF: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   assumes validG: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/G\<^esub> P' c R,X"
   assumes F_G: "F \<subseteq> G"
   assumes P_P': "P \<subseteq> P'"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> X)"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   with F_G have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/G\<^esub> P (Call p) Q,A"
     by (auto intro: nvalid_augment_Faults)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   with P_P' have P': "s \<in> P'"
     by auto
   assume t_noFault: "t \<notin> Fault ` F"
   show "t \<in> Normal ` (Q \<inter> R) \<union> Abrupt ` (A \<inter> X)"
   proof -
     from cnvalidD [OF validF [rule_format] ctxt exec P t_noFault]
     have *: "t \<in> Normal ` Q \<union> Abrupt ` A".
     then have "t \<notin> Fault ` G"
       by auto
     from cnvalidD [OF validG [rule_format] ctxt' exec P' this]
     have "t \<in> Normal ` R \<union> Abrupt ` X" .
     with * show ?thesis by auto
   qed
 qed
 
 lemma Merge_PostConj:
   assumes validF: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes validG: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/G\<^esub> P' c R,X"
   assumes F_G: "F \<subseteq> G"
   assumes P_P': "P \<subseteq> P'"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> X)"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule Merge_PostConj_sound [OF _ _ F_G P_P'])
 using validF apply (blast intro:hoare_cnvalid)
 using validG apply (blast intro:hoare_cnvalid)
 done
 
 subsubsection \<open>Weaken Context\<close>
 
 
 lemma WeakenContext_sound:
   assumes valid_c: "\<forall>n. \<Gamma>,\<Theta>'\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   assumes valid_ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>'. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   with valid_ctxt
   have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>'. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (simp add: cnvalid_def)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from valid_c [rule_format] ctxt' exec P t_notin_F
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
     by (rule cnvalidD)
 qed
 
 lemma WeakenContext:
   assumes deriv_c: "\<Gamma>,\<Theta>'\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes deriv_ctxt: "\<forall>(P,p,Q,A)\<in>\<Theta>'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule WeakenContext_sound)
 using deriv_c
 apply (blast intro: hoare_cnvalid)
 using deriv_ctxt
 apply (blast intro: hoare_cnvalid)
 done
 
 subsubsection \<open>Guards and Guarantees\<close>
 
 lemma SplitGuards_sound:
 assumes valid_c1: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c\<^sub>1 Q,A"
 assumes valid_c2: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c\<^sub>2 UNIV,UNIV"
 assumes c: "(c\<^sub>1 \<inter>\<^sub>g c\<^sub>2) = Some c"
 shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases t)
     case Normal
     with inter_guards_execn_noFault [OF c exec]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> t" by simp
     from valid_c1 [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   next
     case Abrupt
     with inter_guards_execn_noFault [OF c exec]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> t" by simp
     from valid_c1 [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   next
     case (Fault f)
     with exec inter_guards_execn_Fault [OF c]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by auto
     then show ?thesis
     proof (cases rule: disjE [consumes 1])
       assume "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> Fault f"
       from Fault cnvalidD [OF valid_c1 [rule_format] ctxt this P] t_notin_F
       show ?thesis
         by blast
     next
       assume "\<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> =n\<Rightarrow> Fault f"
       from Fault cnvalidD [OF valid_c2 [rule_format] ctxt this P] t_notin_F
       show ?thesis
         by blast
     qed
   next
     case Stuck
     with inter_guards_execn_noFault [OF c exec]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow> t" by simp
     from valid_c1 [rule_format] ctxt this P t_notin_F
     show ?thesis
       by (rule cnvalidD)
   qed
 qed
 
 lemma SplitGuards:
   assumes c: "(c\<^sub>1 \<inter>\<^sub>g c\<^sub>2) = Some c"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>1 Q,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>2 UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule SplitGuards_sound [OF _ _ c])
 using deriv_c1
 apply (blast intro: hoare_cnvalid)
 using deriv_c2
 apply (blast intro: hoare_cnvalid)
 done
 
 lemma CombineStrip_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   assumes valid_strip: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P (strip_guards (-F) c) UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/{}\<^esub> P (Call p) Q,A"
   hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto intro: nvalid_augment_Faults)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases t)
     case (Normal t')
     from cnvalidD [OF valid [rule_format] ctxt' exec P] Normal
     show ?thesis
       by auto
   next
     case (Abrupt t')
     from cnvalidD [OF valid [rule_format] ctxt' exec P] Abrupt
     show ?thesis
       by auto
   next
     case (Fault f)
     show ?thesis
     proof (cases "f \<in> F")
       case True
       hence "f \<notin> -F" by simp
       with exec Fault
       have "\<Gamma>\<turnstile>\<langle>strip_guards (-F) c,Normal s\<rangle> =n\<Rightarrow> Fault f"
         by (auto intro: execn_to_execn_strip_guards_Fault)
       from cnvalidD [OF valid_strip [rule_format] ctxt this P] Fault
       have False
         by auto
       thus ?thesis ..
     next
       case False
       with cnvalidD [OF valid [rule_format] ctxt' exec P] Fault
       show ?thesis
         by auto
     qed
   next
     case Stuck
     from cnvalidD [OF valid [rule_format] ctxt' exec P] Stuck
     show ?thesis
       by auto
   qed
 qed
 
 lemma CombineStrip:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes deriv_strip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P (strip_guards (-F) c) UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule CombineStrip_sound)
 apply  (iprover intro: hoare_cnvalid [OF deriv])
 apply (iprover intro: hoare_cnvalid [OF deriv_strip])
 done
 
 lemma GuardsFlip_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   assumes validFlip: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/-F\<^esub> P c UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/{}\<^esub> P (Call p) Q,A"
   hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto intro: nvalid_augment_Faults)
   from ctxt have ctxtFlip: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/-F\<^esub> P (Call p) Q,A"
     by (auto intro: nvalid_augment_Faults)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases t)
     case (Normal t')
     from cnvalidD [OF valid [rule_format] ctxt' exec P] Normal
     show ?thesis
       by auto
   next
     case (Abrupt t')
     from cnvalidD [OF valid [rule_format] ctxt' exec P] Abrupt
     show ?thesis
       by auto
   next
     case (Fault f)
     show ?thesis
     proof (cases "f \<in> F")
       case True
       hence "f \<notin> -F" by simp
       with cnvalidD [OF validFlip [rule_format] ctxtFlip exec P] Fault
       have False
         by auto
       thus ?thesis ..
     next
       case False
       with cnvalidD [OF valid [rule_format] ctxt' exec P] Fault
       show ?thesis
         by auto
     qed
   next
     case Stuck
     from cnvalidD [OF valid [rule_format] ctxt' exec P] Stuck
     show ?thesis
       by auto
   qed
 qed
 
 lemma GuardsFlip:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes derivFlip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/-F\<^esub> P c UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule GuardsFlip_sound)
 apply  (iprover intro: hoare_cnvalid [OF deriv])
 apply (iprover intro: hoare_cnvalid [OF derivFlip])
 done
 
 lemma MarkGuardsI_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s\<rangle> =n\<Rightarrow> t"
   from execn_mark_guards_to_execn [OF exec] obtain t' where
     exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t'" and
     t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
     by blast
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from cnvalidD [OF valid [rule_format] ctxt exec_c P]
     have "t' \<in> Normal ` Q \<union> Abrupt ` A"
       by blast
     with t'_noFault
     show ?thesis
       by auto
   qed
 qed
 
 lemma MarkGuardsI:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule MarkGuardsI_sound)
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 lemma MarkGuardsD_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases "isFault t")
     case True
     with execn_to_execn_mark_guards_Fault [OF exec ]
     obtain f' where "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s\<rangle> =n\<Rightarrow> Fault f'"
       by (fastforce elim: isFaultE)
     from cnvalidD [OF valid [rule_format] ctxt this P]
     have False
       by auto
     thus ?thesis ..
   next
     case False
     from execn_to_execn_mark_guards [OF exec False]
     obtain f' where "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s\<rangle> =n\<Rightarrow> t"
       by auto
     from cnvalidD [OF valid [rule_format] ctxt this P]
     show ?thesis
       by auto
   qed
 qed
 
 lemma MarkGuardsD:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule MarkGuardsD_sound)
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 lemma MergeGuardsI_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P merge_guards c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec_merge: "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t"
   from execn_merge_guards_to_execn [OF exec_merge]
   have exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" .
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from cnvalidD [OF valid [rule_format] ctxt exec P t_notin_F]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 qed
 
 lemma MergeGuardsI:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P merge_guards c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule MergeGuardsI_sound)
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 lemma MergeGuardsD_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P merge_guards c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   from execn_to_execn_merge_guards [OF exec]
   have exec_merge: "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t".
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from cnvalidD [OF valid [rule_format] ctxt exec_merge P t_notin_F]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 qed
 
 lemma MergeGuardsD:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P merge_guards c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule MergeGuardsD_sound)
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 
 lemma SubsetGuards_sound:
   assumes c_c': "c \<subseteq>\<^sub>g c'"
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P c' Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   from execn_to_execn_subseteq_guards [OF c_c' exec] obtain t' where
     exec_c': "\<Gamma>\<turnstile>\<langle>c',Normal s\<rangle> =n\<Rightarrow> t'" and
     t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
     by blast
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   from cnvalidD [OF valid [rule_format] ctxt exec_c' P] t'_noFault t_noFault
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
     by auto
 qed
 
 lemma SubsetGuards:
   assumes c_c': "c \<subseteq>\<^sub>g c'"
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c' Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule SubsetGuards_sound [OF c_c'])
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 lemma NormalizeD_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P (normalize c) Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   hence exec_norm: "\<Gamma>\<turnstile>\<langle>normalize c,Normal s\<rangle> =n\<Rightarrow> t"
     by (rule execn_to_execn_normalize)
   assume P: "s \<in> P"
   assume noFault: "t \<notin> Fault ` F"
   from cnvalidD [OF valid [rule_format] ctxt exec_norm P noFault]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 qed
 
 lemma NormalizeD:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (normalize c) Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule NormalizeD_sound)
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 lemma NormalizeI_sound:
   assumes valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P (normalize c) Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume "\<Gamma>\<turnstile>\<langle>normalize c,Normal s\<rangle> =n\<Rightarrow> t"
   hence exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
     by (rule execn_normalize_to_execn)
   assume P: "s \<in> P"
   assume noFault: "t \<notin> Fault ` F"
   from cnvalidD [OF valid [rule_format] ctxt exec P noFault]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 qed
 
 lemma NormalizeI:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (normalize c) Q,A"
 apply (rule hoare_complete')
 apply (rule allI)
 apply (rule NormalizeI_sound)
 apply (iprover intro: hoare_cnvalid [OF deriv])
 done
 
 
 subsubsection \<open>Restricting the Procedure Environment\<close>
 
 lemma nvalid_restrict_to_nvalid:
 assumes valid_c: "\<Gamma>|\<^bsub>M\<^esub>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 shows "\<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P c Q,A"
 proof (rule nvalidI)
   fix s t
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from execn_to_execn_restrict [OF exec]
     obtain t' where
       exec_res: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t'" and
       t_Fault: "\<forall>f. t = Fault f \<longrightarrow> t' \<in> {Fault f, Stuck}" and
       t'_notStuck: "t'\<noteq>Stuck \<longrightarrow> t'=t"
       by blast
     from t_Fault t_notin_F t'_notStuck have "t' \<notin> Fault ` F"
       by (cases t') auto
     with valid_c exec_res P
     have "t' \<in> Normal ` Q \<union> Abrupt ` A"
       by (auto simp add: nvalid_def)
     with t'_notStuck
     show ?thesis
       by auto
   qed
 qed
 
 lemma valid_restrict_to_valid:
 assumes valid_c: "\<Gamma>|\<^bsub>M\<^esub>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
 shows "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
 proof (rule validI)
   fix s t
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from exec_to_exec_restrict [OF exec]
     obtain t' where
       exec_res: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t'" and
       t_Fault: "\<forall>f. t = Fault f \<longrightarrow> t' \<in> {Fault f, Stuck}" and
       t'_notStuck: "t'\<noteq>Stuck \<longrightarrow> t'=t"
       by blast
     from t_Fault t_notin_F t'_notStuck have "t' \<notin> Fault ` F"
       by (cases t') auto
     with valid_c exec_res P
     have "t' \<in> Normal ` Q \<union> Abrupt ` A"
       by (auto simp add: valid_def)
     with t'_notStuck
     show ?thesis
       by auto
   qed
 qed
 
 lemma augment_procs:
 assumes deriv_c: "\<Gamma>|\<^bsub>M\<^esub>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 shows "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (rule hoare_complete)
   apply (rule valid_restrict_to_valid)
   apply (insert hoare_sound [OF deriv_c])
   by (simp add: cvalid_def)
 
 lemma augment_Faults:
 assumes deriv_c: "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 assumes F: "F \<subseteq> F'"
 shows "\<Gamma>,{}\<turnstile>\<^bsub>/F'\<^esub> P c Q,A"
   apply (rule hoare_complete)
   apply (rule valid_augment_Faults [OF _ F])
   apply (insert hoare_sound [OF deriv_c])
   by (simp add: cvalid_def)
 
 end
diff --git a/thys/Simpl/HoareTotal.thy b/thys/Simpl/HoareTotal.thy
--- a/thys/Simpl/HoareTotal.thy
+++ b/thys/Simpl/HoareTotal.thy
@@ -1,1231 +1,1430 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HoareTotal.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>Derived Hoare Rules for Total Correctness\<close>
 
 theory HoareTotal imports HoareTotalProps begin
 
 lemma conseq_no_aux:
   "\<lbrakk>\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A';
     \<forall>s. s \<in> P \<longrightarrow> (s\<in>P' \<and> (Q' \<subseteq> Q)\<and> (A' \<subseteq> A))\<rbrakk>
   \<Longrightarrow>
   \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (rule conseq [where P'="\<lambda>Z. P'" and Q'="\<lambda>Z. Q'" and A'="\<lambda>Z. A'"]) auto
 
 text \<open>If for example a specification for a "procedure pointer" parameter
 is in the precondition we can extract it with this rule\<close>
 lemma conseq_exploit_pre:
              "\<lbrakk>\<forall>s \<in> P. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s} \<inter> P) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   apply (rule Conseq)
   apply clarify
   apply (rule_tac x="{s} \<inter> P" in exI)
   apply (rule_tac x="Q" in exI)
   apply (rule_tac x="A" in exI)
   by simp
 
 
 lemma conseq:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
               \<forall>s. s \<in> P \<longrightarrow> (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q)\<and> (A' Z \<subseteq> A))\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (rule Conseq') blast
 
 
 lemma Lem:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
             P \<subseteq> {s. \<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A)}\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (lem x c) Q,A"
   apply (unfold lem_def)
   apply (erule conseq)
   apply blast
   done
 
 
 lemma LemAnno:
 assumes conseq:  "P \<subseteq> {s. \<exists>Z. s\<in>P' Z \<and>
                      (\<forall>t. t \<in> Q' Z \<longrightarrow> t \<in> Q) \<and> (\<forall>t. t \<in> A' Z \<longrightarrow> t \<in> A)}"
 assumes lem: "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (lem x c) Q,A"
   apply (rule Lem [OF lem])
   using conseq
   by blast
 
 lemma LemAnnoNoAbrupt:
 assumes conseq:  "P \<subseteq>  {s. \<exists>Z. s\<in>P' Z \<and> (\<forall>t. t \<in> Q' Z \<longrightarrow> t \<in> Q)}"
 assumes lem: "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),{}"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (lem x c) Q,{}"
   apply (rule Lem [OF lem])
   using conseq
   by blast
 
 lemma TrivPost: "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)
                  \<Longrightarrow>
                  \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c UNIV,UNIV"
 apply (rule allI)
 apply (erule conseq)
 apply auto
 done
 
 lemma TrivPostNoAbr: "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),{}
                  \<Longrightarrow>
                  \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c UNIV,{}"
 apply (rule allI)
 apply (erule conseq)
 apply auto
 done
 
 lemma DynComConseq:
   assumes "P \<subseteq> {s. \<exists>P' Q' A'.  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P' (c s) Q',A' \<and> P \<subseteq> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P DynCom c Q,A"
   using assms
   apply -
   apply (rule hoaret.DynCom)
   apply clarsimp
   apply (rule hoaret.Conseq)
   apply clarsimp
   apply blast
   done
 
 lemma SpecAnno:
  assumes consequence: "P \<subseteq> {s. (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A))}"
  assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) (c Z) (Q' Z),(A' Z)"
  assumes bdy_constant:  "\<forall>Z. c Z = c undefined"
  shows   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (specAnno P' c Q' A') Q,A"
 proof -
   from spec bdy_constant
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) (c undefined) (Q' Z),(A' Z)"
     apply -
     apply (rule allI)
     apply (erule_tac x=Z in allE)
     apply (erule_tac x=Z in allE)
     apply simp
     done
   with consequence show ?thesis
     apply (simp add: specAnno_def)
     apply (erule conseq)
     apply blast
     done
 qed
 
 
 
 lemma SpecAnno':
  "\<lbrakk>P \<subseteq> {s.  \<exists> Z. s\<in>P' Z \<and>
             (\<forall>t. t \<in> Q' Z \<longrightarrow>  t \<in> Q) \<and> (\<forall>t. t \<in> A' Z \<longrightarrow> t \<in>  A)};
    \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) (c Z) (Q' Z),(A' Z);
    \<forall>Z. c Z = c undefined
   \<rbrakk> \<Longrightarrow>
     \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (specAnno P' c Q' A') Q,A"
 apply (simp only: subset_iff [THEN sym])
 apply (erule (1) SpecAnno)
 apply assumption
 done
 
 lemma SpecAnnoNoAbrupt:
  "\<lbrakk>P \<subseteq> {s.  \<exists> Z. s\<in>P' Z \<and>
             (\<forall>t. t \<in> Q' Z \<longrightarrow>  t \<in> Q)};
    \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) (c Z) (Q' Z),{};
    \<forall>Z. c Z = c undefined
   \<rbrakk> \<Longrightarrow>
     \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (specAnno P' c Q' (\<lambda>s. {})) Q,A"
 apply (rule SpecAnno')
 apply auto
 done
 
 lemma Skip: "P \<subseteq> Q \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Skip Q,A"
   by (rule hoaret.Skip [THEN conseqPre],simp)
 
 lemma Basic: "P \<subseteq> {s. (f s) \<in> Q} \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Basic f) Q,A"
   by (rule hoaret.Basic [THEN conseqPre])
 
 lemma BasicCond:
   "\<lbrakk>P \<subseteq> {s. (b s \<longrightarrow> f s\<in>Q) \<and> (\<not> b s \<longrightarrow> g s\<in>Q)}\<rbrakk> \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Basic (\<lambda>s. if b s then f s else g s) Q,A"
   apply (rule Basic)
   apply auto
   done
 
 lemma Spec: "P \<subseteq> {s. (\<forall>t. (s,t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s,t) \<in> r)}
             \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Spec r) Q,A"
 by (rule hoaret.Spec [THEN conseqPre])
 
 lemma SpecIf:
   "\<lbrakk>P \<subseteq> {s. (b s \<longrightarrow> f s \<in> Q) \<and> (\<not> b s \<longrightarrow> g s \<in> Q \<and> h s \<in> Q)}\<rbrakk> \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Spec (if_rel b f g h) Q,A"
   apply (rule Spec)
   apply (auto simp add: if_rel_def)
   done
 
 lemma Seq [trans, intro?]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Seq c\<^sub>1 c\<^sub>2 Q,A"
   by (rule hoaret.Seq)
 
 lemma SeqSwap:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c2 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c1 R,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Seq c1 c2 Q,A"
   by (rule Seq)
 
 lemma BSeq:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (bseq c\<^sub>1 c\<^sub>2) Q,A"
   by (unfold bseq_def) (rule Seq)
 
 lemma Cond:
   assumes wp: "P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P\<^sub>1 c\<^sub>1 Q,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P\<^sub>2 c\<^sub>2 Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 proof (rule hoaret.Cond [THEN conseqPre])
   from deriv_c1
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. (s \<in> b \<longrightarrow> s \<in> P\<^sub>1) \<and> (s \<notin> b \<longrightarrow> s \<in> P\<^sub>2)} \<inter> b) c\<^sub>1 Q,A"
     by (rule conseqPre) blast
 next
   from deriv_c2
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. (s \<in> b \<longrightarrow> s \<in> P\<^sub>1) \<and> (s \<notin> b \<longrightarrow> s \<in> P\<^sub>2)} \<inter> - b) c\<^sub>2 Q,A"
     by (rule conseqPre) blast
 qed (insert wp)
 
 
 lemma CondSwap:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P1 c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P2 c2 Q,A;
     P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P1) \<and> (s\<notin>b \<longrightarrow> s\<in>P2)}\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c1 c2) Q,A"
   by (rule Cond)
 
 lemma Cond':
   "\<lbrakk>P \<subseteq> {s. (b \<subseteq> P1) \<and> (- b \<subseteq> P2)};\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P1 c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P2 c2 Q,A\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c1 c2) Q,A"
   by (rule CondSwap) blast+
 
 lemma CondInv:
   assumes wp: "P \<subseteq> Q"
   assumes inv: "Q \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P\<^sub>1 c\<^sub>1 Q,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P\<^sub>2 c\<^sub>2 Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 proof -
   from wp inv
   have "P \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
     by blast
   from Cond [OF this deriv_c1 deriv_c2]
   show ?thesis .
 qed
 
 lemma CondInv':
   assumes wp: "P \<subseteq> I"
   assumes inv: "I \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>P\<^sub>1) \<and> (s\<notin>b \<longrightarrow> s\<in>P\<^sub>2)}"
   assumes wp': "I \<subseteq> Q"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P\<^sub>1 c\<^sub>1 I,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P\<^sub>2 c\<^sub>2 I,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 proof -
   from CondInv [OF wp inv deriv_c1 deriv_c2]
   have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) I,A" .
   from conseqPost [OF this wp' subset_refl]
   show ?thesis .
 qed
 
 
 lemma switchNil:
   "P \<subseteq> Q \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P (switch v []) Q,A"
   by (simp add: Skip)
 
 lemma switchCons:
   "\<lbrakk>P \<subseteq> {s. (v s \<in> V \<longrightarrow> s \<in> P\<^sub>1) \<and> (v s \<notin> V \<longrightarrow> s \<in> P\<^sub>2)};
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P\<^sub>1 c Q,A;
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P\<^sub>2 (switch v vs) Q,A\<rbrakk>
 \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P (switch v ((V,c)#vs)) Q,A"
   by (simp add: Cond)
 
 
 lemma Guard:
  "\<lbrakk>P \<subseteq> g \<inter> R; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Guard f g c Q,A"
 apply (rule HoareTotalDef.Guard [THEN conseqPre, of _ _ _ _ R])
 apply (erule conseqPre)
 apply auto
 done
 
 lemma GuardSwap:
  "\<lbrakk> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> g \<inter> R\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Guard f g c Q,A"
   by (rule Guard)
 
 lemma Guarantee:
  "\<lbrakk>P \<subseteq> {s. s \<in> g \<longrightarrow> s \<in> R}; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 apply (rule Guarantee [THEN conseqPre, of _ _ _ _ _ "{s. s \<in> g \<longrightarrow> s \<in> R}"])
 apply   assumption
 apply  (erule conseqPre)
 apply auto
 done
 
 lemma GuaranteeSwap:
  "\<lbrakk> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> {s. s \<in> g \<longrightarrow> s \<in> R}; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
   by (rule Guarantee)
 
 
 lemma GuardStrip:
  "\<lbrakk>P \<subseteq> R; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 apply (rule Guarantee [THEN conseqPre])
 apply auto
 done
 
 lemma GuardStripSwap:
  "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> R; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
   by (rule GuardStrip)
 
 lemma GuaranteeStrip:
  "\<lbrakk>P \<subseteq> R; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guaranteeStrip f g c) Q,A"
   by (unfold guaranteeStrip_def) (rule GuardStrip)
 
 lemma GuaranteeStripSwap:
  "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> R; f \<in> F\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guaranteeStrip f g c) Q,A"
   by (unfold guaranteeStrip_def) (rule GuardStrip)
 
 lemma GuaranteeAsGuard:
  "\<lbrakk>P \<subseteq> g \<inter> R; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P guaranteeStrip f g c Q,A"
   by (unfold guaranteeStrip_def) (rule Guard)
 
 lemma GuaranteeAsGuardSwap:
  "\<lbrakk> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c Q,A; P \<subseteq> g \<inter> R\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P guaranteeStrip f g c Q,A"
   by (rule GuaranteeAsGuard)
 
 lemma GuardsNil:
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guards [] c) Q,A"
   by simp
 
 lemma GuardsCons:
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Guard f g (guards gs c) Q,A \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guards ((f,g)#gs) c) Q,A"
   by simp
 
 lemma GuardsConsGuaranteeStrip:
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P guaranteeStrip f g (guards gs c) Q,A \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guards (guaranteeStripPair f g#gs) c) Q,A"
   by (simp add: guaranteeStripPair_def guaranteeStrip_def)
 
 lemma While:
   assumes P_I: "P \<subseteq> I"
   assumes deriv_body:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I \<inter> b) c ({t. (t, \<sigma>) \<in> V} \<inter> I),A"
   assumes I_Q: "I \<inter> -b \<subseteq> Q"
   assumes wf: "wf V"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnno  b I V c) Q,A"
 proof -
   from wf deriv_body P_I I_Q
   show ?thesis
     apply (unfold whileAnno_def)
     apply (erule conseqPrePost [OF HoareTotalDef.While])
     apply auto
     done
 qed
 
 
 
 lemma WhileInvPost:
   assumes P_I: "P \<subseteq> I"
   assumes termi_body:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/UNIV\<^esub> ({\<sigma>} \<inter> I \<inter> b) c ({t. (t, \<sigma>) \<in> V} \<inter> P),A"
   assumes deriv_body:
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (I \<inter> b) c I,A"
   assumes I_Q: "I \<inter> -b \<subseteq> Q"
   assumes wf: "wf V"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnno  b I V c) Q,A"
 proof -
   have "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I \<inter> b) c ({t. (t, \<sigma>) \<in> V} \<inter> I),A"
   proof
     fix \<sigma>
     from hoare_sound [OF deriv_body] hoaret_sound [OF termi_body [rule_format, of \<sigma>]]
     have "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I \<inter> b) c ({t. (t, \<sigma>) \<in> V} \<inter> I),A"
       by (fastforce simp add: cvalidt_def validt_def cvalid_def valid_def)
     then
     show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I \<inter> b) c ({t. (t, \<sigma>) \<in> V} \<inter> I),A"
       by (rule hoaret_complete')
   qed
 
   from While [OF P_I this I_Q wf]
   show ?thesis .
 qed
 
 (* *)
 lemma "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) (Seq c (Guard f Q Skip)) Q,A"
 oops
 
 text \<open>@{term "J"} will be instantiated by tactic with @{term "gs' \<inter> I"} for
   those guards that are not stripped.\<close>
 lemma WhileAnnoG:
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guards gs
                     (whileAnno  b J V (Seq c (guards gs Skip)))) Q,A
         \<Longrightarrow>
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoG gs b I V c) Q,A"
   by (simp add: whileAnnoG_def whileAnno_def while_def)
 
 text \<open>This form stems from @{term "strip_guards F (whileAnnoG gs b I V c)"}\<close>
 lemma WhileNoGuard':
   assumes P_I: "P \<subseteq> I"
   assumes deriv_body: "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I \<inter> b) c ({t. (t, \<sigma>) \<in> V} \<inter> I),A"
   assumes I_Q: "I \<inter> -b \<subseteq> Q"
   assumes wf: "wf V"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnno b I V (Seq c Skip)) Q,A"
   apply (rule While [OF P_I _ I_Q wf])
   apply (rule allI)
   apply (rule Seq)
   apply  (rule deriv_body [rule_format])
   apply (rule hoaret.Skip)
   done
 
 lemma WhileAnnoFix:
 assumes consequence: "P \<subseteq> {s. (\<exists> Z. s\<in>I Z \<and> (I Z \<inter> -b \<subseteq> Q)) }"
 assumes bdy: "\<forall>Z \<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I Z \<inter> b) (c Z) ({t. (t, \<sigma>) \<in> V Z} \<inter> I Z),A"
 assumes bdy_constant:  "\<forall>Z. c Z = c undefined"
 assumes wf: "\<forall>Z. wf (V Z)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoFix b I V c) Q,A"
 proof -
   from bdy bdy_constant
   have bdy': "\<And>Z. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I Z \<inter> b) (c undefined)
                ({t. (t, \<sigma>) \<in> V Z} \<inter> I Z),A"
     apply -
     apply (erule_tac x=Z in allE)
     apply (erule_tac x=Z in allE)
     apply simp
     done
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (I Z) (whileAnnoFix b I V c) (I Z \<inter> -b),A"
     apply rule
     apply (unfold whileAnnoFix_def)
     apply (rule hoaret.While)
     apply (rule wf [rule_format])
     apply (rule bdy')
     done
   then
   show ?thesis
     apply (rule conseq)
     using consequence
     by blast
 qed
 
 lemma WhileAnnoFix':
 assumes consequence: "P \<subseteq> {s. (\<exists> Z. s\<in>I Z \<and>
                                (\<forall>t. t \<in> I Z \<inter> -b \<longrightarrow> t \<in> Q)) }"
 assumes bdy: "\<forall>Z \<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> I Z \<inter> b) (c Z) ({t. (t, \<sigma>) \<in> V Z} \<inter> I Z),A"
 assumes bdy_constant:  "\<forall>Z. c Z = c undefined"
 assumes wf: "\<forall>Z. wf (V Z)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoFix b I V c) Q,A"
   apply (rule WhileAnnoFix [OF _ bdy bdy_constant wf])
   using consequence by blast
 
 lemma WhileAnnoGFix:
 assumes whileAnnoFix:
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (guards gs
                 (whileAnnoFix  b J V (\<lambda>Z. (Seq (c Z) (guards gs Skip))))) Q,A"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoGFix gs b I V c) Q,A"
   using whileAnnoFix
   by (simp add: whileAnnoGFix_def whileAnnoFix_def while_def)
 
 lemma Bind:
   assumes adapt: "P \<subseteq> {s. s \<in> P' s}"
   assumes c: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) (c (e s)) Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (bind e c) Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. s=Z \<and> s \<in> P' Z}" and Q'="\<lambda>Z. Q" and
 A'="\<lambda>Z. A"])
 apply  (rule allI)
 apply  (unfold bind_def)
 apply  (rule HoareTotalDef.DynCom)
 apply  (rule ballI)
 apply  clarsimp
 apply  (rule conseqPre)
 apply   (rule c [rule_format])
 apply  blast
 using adapt
 apply blast
 done
 
-lemma Block:
+lemma Block_exn:
 assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
-assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. return s t \<in> A}"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. result_exn (return s t) t \<in> A}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block_exn init bdy return result_exn c) Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. s=Z \<and> init s \<in> P' Z}" and Q'="\<lambda>Z. Q" and
 A'="\<lambda>Z. A"])
 prefer 2
 using adapt
 apply  blast
 apply (rule allI)
-apply (unfold block_def)
+apply (unfold block_exn_def)
 apply (rule HoareTotalDef.DynCom)
 apply (rule ballI)
 apply clarsimp
 apply (rule_tac R="{t. return Z t \<in> R Z t}" in SeqSwap )
 apply  (rule_tac  P'="\<lambda>Z'. {t. t=Z' \<and> return Z t \<in> R Z t}" and
           Q'="\<lambda>Z'. Q" and A'="\<lambda>Z'. A" in conseq)
 prefer 2 apply simp
 apply  (rule allI)
 apply  (rule HoareTotalDef.DynCom)
 apply  (clarsimp)
 apply  (rule SeqSwap)
 apply   (rule c [rule_format])
 apply  (rule Basic)
 apply  clarsimp
-apply (rule_tac R="{t. return Z t \<in> A}" in HoareTotalDef.Catch)
+apply (rule_tac R="{t. result_exn (return Z t) t \<in> A}" in HoareTotalDef.Catch)
 apply  (rule_tac R="{i. i \<in> P' Z}" in Seq)
 apply   (rule Basic)
 apply   clarsimp
 apply  simp
 apply  (rule bdy [rule_format])
 apply (rule SeqSwap)
 apply  (rule Throw)
 apply (rule Basic)
 apply simp
 done
 
+lemma Block:
+assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. return s t \<in> A}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+  using adapt bdy c unfolding block_def by (rule Block_exn)
+
 lemma BlockSwap:
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. return s t \<in> A}"
 assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
   using adapt bdy c
   by (rule Block)
 
-lemma BlockSpec:
+lemma Block_exnSwap:
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) bdy {t. return s t \<in> R s t},{t. result_exn (return s t) t \<in> A}"
+assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block_exn init bdy return result_exn c) Q,A"
+  using adapt bdy c
+  by (rule Block_exn)
+
+lemma Block_exnSpec:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
-                             (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}"
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes bdy: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) bdy (Q' Z),(A' Z)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block_exn init bdy return result_exn c) Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
-                             (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}" and Q'="\<lambda>Z. Q" and
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> result_exn (return s t) t \<in> A)}" and Q'="\<lambda>Z. Q" and
 A'="\<lambda>Z. A"])
 prefer 2
 using adapt
 apply  blast
 apply (rule allI)
-apply (unfold block_def)
+apply (unfold block_exn_def)
 apply (rule HoareTotalDef.DynCom)
 apply (rule ballI)
 apply clarsimp
 apply (rule_tac R="{t. return s t \<in> R s t}" in SeqSwap )
 apply  (rule_tac  P'="\<lambda>Z'. {t. t=Z' \<and> return s t \<in> R s t}" and
           Q'="\<lambda>Z'. Q" and A'="\<lambda>Z'. A" in conseq)
 prefer 2 apply simp
 apply  (rule allI)
 apply  (rule HoareTotalDef.DynCom)
 apply  (clarsimp)
 apply  (rule SeqSwap)
 apply   (rule c [rule_format])
 apply  (rule Basic)
 apply  clarsimp
-apply (rule_tac R="{t. return s t \<in> A}" in HoareTotalDef.Catch)
+apply (rule_tac R="{t. result_exn (return s t) t \<in> A}" in HoareTotalDef.Catch)
 apply  (rule_tac R="{i. i \<in> P' Z}" in Seq)
 apply   (rule Basic)
 apply   clarsimp
 apply  simp
 apply  (rule conseq [OF bdy])
 apply  clarsimp
 apply  blast
 apply (rule SeqSwap)
 apply  (rule Throw)
 apply (rule Basic)
 apply simp
 done
 
+lemma BlockSpec:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes bdy: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) bdy (Q' Z),(A' Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (block init bdy return c) Q,A"
+  using adapt c bdy unfolding block_def by (rule Block_exnSpec)
+
 
 lemma Throw: "P \<subseteq> A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Throw Q,A"
   by (rule hoaret.Throw [THEN conseqPre])
 
 lemmas Catch = hoaret.Catch
 lemma CatchSwap: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,R\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
   by (rule hoaret.Catch)
 
 lemma raise: "P \<subseteq> {s. f s \<in> A} \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P raise f Q,A"
   apply (simp add: raise_def)
   apply (rule Seq)
   apply  (rule Basic)
   apply  (assumption)
   apply (rule Throw)
   apply (rule subset_refl)
   done
 
 lemma condCatch: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,((b \<inter> R) \<union> (-b \<inter> A));\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk>
                   \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P condCatch c\<^sub>1 b c\<^sub>2 Q,A"
   apply (simp add: condCatch_def)
   apply (rule Catch)
   apply  assumption
   apply (rule CondSwap)
   apply   (assumption)
   apply  (rule hoaret.Throw)
   apply blast
   done
 
 lemma condCatchSwap: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,((b \<inter> R) \<union> (-b \<inter> A))\<rbrakk>
                      \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P condCatch c\<^sub>1 b c\<^sub>2 Q,A"
   by (rule condCatch)
 
+lemma Proc_exnSpec:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
+                             (\<forall>t. t \<in> A' Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+using adapt c p
+apply (unfold call_exn_def)
+  by (rule Block_exnSpec)
 
 lemma ProcSpec:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
                              (\<forall>t. t \<in> A' Z \<longrightarrow> return s t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 using adapt c p
 apply (unfold call_def)
 by (rule BlockSpec)
 
-lemma ProcSpec':
+lemma Proc_exnSpec':
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t \<in> Q' Z. return s t \<in> R s t) \<and>
-                             (\<forall>t \<in> A' Z. return s t \<in> A)}"
+                             (\<forall>t \<in> A' Z. result_exn (return s t) t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
-apply (rule ProcSpec [OF _ c p])
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule Proc_exnSpec [OF _ c p])
 apply (insert adapt)
 apply clarsimp
 apply (drule (1) subsetD)
 apply (clarsimp)
 apply (rule_tac x=Z in exI)
 apply blast
 done
 
+lemma ProcSpec':
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t \<in> Q' Z. return s t \<in> R s t) \<and>
+                             (\<forall>t \<in> A' Z. return s t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),(A' Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using adapt c p unfolding call_call_exn by (rule Proc_exnSpec')
+
+
+lemma Proc_exnSpecNoAbrupt:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
+                             (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule Proc_exnSpec [OF _ c p])
+using adapt
+apply simp
+  done
 
 lemma ProcSpecNoAbrupt:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' Z \<and>
                              (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call p (Q' Z),{}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 apply (rule ProcSpec [OF _ c p])
 using adapt
 apply simp
 done
 
 lemma FCall:
 "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return (\<lambda>s t. c (result t))) Q,A
 \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (fcall init p return result c) Q,A"
   by (simp add: fcall_def)
 
 lemma ProcRec:
   assumes deriv_bodies:
    "\<forall>p\<in>Procs.
     \<forall>\<sigma> Z. \<Gamma>,\<Theta>\<union>(\<Union>q\<in>Procs. \<Union>Z.
        {(P q Z \<inter> {s. ((s,q), \<sigma>,p) \<in> r},q,Q q Z,A q Z)})
         \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   assumes wf: "wf r"
   assumes Procs_defined: "Procs \<subseteq> dom \<Gamma>"
   shows "\<forall>p\<in>Procs. \<forall>Z.
   \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>(P p Z) Call p (Q p Z),(A p Z)"
   by (intro strip)
      (rule HoareTotalDef.CallRec'
      [OF _  Procs_defined wf deriv_bodies],
      simp_all)
 
 lemma ProcRec':
   assumes ctxt:
    "\<Theta>'=(\<lambda>\<sigma> p. \<Theta>\<union>(\<Union>q\<in>Procs.
                    \<Union>Z. {(P q Z \<inter> {s. ((s,q), \<sigma>,p) \<in> r},q,Q q Z,A q Z)}))"
   assumes deriv_bodies:
    "\<forall>p\<in>Procs.
     \<forall>\<sigma> Z. \<Gamma>,\<Theta>' \<sigma> p\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   assumes wf: "wf r"
   assumes Procs_defined: "Procs \<subseteq> dom \<Gamma>"
   shows "\<forall>p\<in>Procs. \<forall>Z.  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>(P p Z) Call p (Q p Z),(A p Z)"
   using ctxt deriv_bodies
   apply simp
   apply (erule ProcRec [OF _ wf Procs_defined])
   done
 
 
 lemma ProcRecList:
   assumes deriv_bodies:
    "\<forall>p\<in>set Procs.
     \<forall>\<sigma> Z. \<Gamma>,\<Theta>\<union>(\<Union>q\<in>set Procs. \<Union>Z.
        {(P q Z \<inter> {s. ((s,q), \<sigma>,p) \<in> r},q,Q q Z,A q Z)})
         \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   assumes wf: "wf r"
   assumes dist: "distinct Procs"
   assumes Procs_defined: "set Procs \<subseteq> dom \<Gamma>"
   shows "\<forall>p\<in>set Procs. \<forall>Z.
   \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>(P p Z) Call p (Q p Z),(A p Z)"
   using deriv_bodies wf Procs_defined
   by (rule ProcRec)
 
 lemma  ProcRecSpecs:
   "\<lbrakk>\<forall>\<sigma>. \<forall>(P,p,Q,A) \<in> Specs.
      \<Gamma>,\<Theta>\<union> ((\<lambda>(P,q,Q,A). (P \<inter> {s. ((s,q),(\<sigma>,p)) \<in> r},q,Q,A)) ` Specs)
       \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P) (the (\<Gamma> p)) Q,A;
     wf r;
     \<forall>(P,p,Q,A) \<in> Specs. p \<in> dom \<Gamma>\<rbrakk>
   \<Longrightarrow> \<forall>(P,p,Q,A) \<in> Specs. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
 apply (rule ballI)
 apply (case_tac x)
 apply (rename_tac x P p Q A)
 apply simp
 apply (rule hoaret.CallRec)
 apply auto
 done
 
 lemma ProcRec1:
   assumes deriv_body:
    "\<forall>\<sigma> Z. \<Gamma>,\<Theta>\<union>(\<Union>Z. {(P Z \<inter> {s. ((s,p), \<sigma>,p) \<in> r},p,Q Z,A Z)})
            \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
   assumes wf: "wf r"
   assumes p_defined: "p \<in> dom \<Gamma>"
   shows "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) Call p (Q Z),(A Z)"
 proof -
   from deriv_body wf p_defined
   have "\<forall>p\<in>{p}. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) Call p (Q Z),(A Z)"
     apply -
     apply (rule ProcRec [where  A="\<lambda>p. A" and P="\<lambda>p. P" and Q="\<lambda>p. Q"])
     apply simp_all
     done
   thus ?thesis
     by simp
 qed
 
 lemma ProcNoRec1:
   assumes deriv_body:
    "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
   assumes p_defined: "p \<in> dom \<Gamma>"
   shows "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) Call p (Q Z),(A Z)"
 proof -
   have "\<forall>\<sigma> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
     by (blast intro: conseqPre deriv_body [rule_format])
   with p_defined have "\<forall>\<sigma> Z. \<Gamma>,\<Theta>\<union>(\<Union>Z. {(P Z \<inter> {s. ((s,p), \<sigma>,p) \<in> {}},
                          p,Q Z,A Z)})
              \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P Z) (the (\<Gamma> p)) (Q Z),(A Z)"
     by (blast intro: hoaret_augment_context)
   from this
   show ?thesis
     by (rule ProcRec1) (auto simp add: p_defined)
 qed
 
 lemma ProcBody:
  assumes WP: "P \<subseteq> P'"
  assumes deriv_body: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' body Q,A"
  assumes body: "\<Gamma> p = Some body"
  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Call p Q,A"
 apply (rule conseqPre [OF _ WP])
 apply (rule ProcNoRec1 [rule_format, where P="\<lambda>Z. P'" and Q="\<lambda>Z. Q" and A="\<lambda>Z. A"])
 apply  (insert body)
 apply  simp
 apply  (rule hoaret_augment_context [OF deriv_body])
 apply  blast
 apply fastforce
 done
 
 lemma CallBody:
 assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
 assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) body {t. return s t \<in> R s t},{t. return s t \<in> A}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes body: "\<Gamma> p = Some body"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 apply (unfold call_def)
 apply (rule Block [OF adapt _ c])
 apply (rule allI)
 apply (rule ProcBody [where \<Gamma>=\<Gamma>, OF _ bdy [rule_format] body])
 apply simp
 done
 
+lemma Call_exnBody:
+assumes adapt: "P \<subseteq> {s. init s \<in> P' s}"
+assumes bdy: "\<forall>s. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s) body {t. return s t \<in> R s t},{t. result_exn (return s t) t \<in> A}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes body: "\<Gamma> p = Some body"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (unfold call_exn_def)
+apply (rule Block_exn [OF adapt _ c])
+apply (rule allI)
+apply (rule ProcBody [where \<Gamma>=\<Gamma>, OF _ bdy [rule_format] body])
+apply simp
+  done
+
 lemmas ProcModifyReturn = HoareTotalProps.ProcModifyReturn
 lemmas ProcModifyReturnSameFaults = HoareTotalProps.ProcModifyReturnSameFaults
 
+lemmas Proc_exnModifyReturn = HoareTotalProps.Proc_exnModifyReturn
+lemmas Proc_exnModifyReturnSameFaults = HoareTotalProps.Proc_exnModifyReturnSameFaults
+
 lemma ProcModifyReturnNoAbr:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes result_conform:
       "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 by (rule ProcModifyReturn [OF spec result_conform _ modifies_spec]) simp
 
+lemma Proc_exnModifyReturnNoAbr:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes result_conform:
+      "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+  by (rule Proc_exnModifyReturn [OF spec result_conform _ modifies_spec]) simp
+
 
 lemma ProcModifyReturnNoAbrSameFaults:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes result_conform:
       "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
 by (rule ProcModifyReturnSameFaults [OF spec result_conform _ modifies_spec]) simp
 
+lemma Proc_exnModifyReturnNoAbrSameFaults:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes result_conform:
+      "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+  by (rule Proc_exnModifyReturnSameFaults [OF spec result_conform _ modifies_spec]) simp
 
-lemma DynProc:
+lemma DynProc_exn:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
                           (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
-                          (\<forall>t. t \<in> A' s Z \<longrightarrow> return s t \<in> A)}"
+                          (\<forall>t. t \<in> A' s Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return c Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f UNIV init p return result_exn c Q,A"
 apply (rule conseq [where P'="\<lambda>Z. {s. s=Z \<and> s \<in> P}"
   and Q'="\<lambda>Z. Q" and A'="\<lambda>Z. A"])
 prefer 2
 using adapt
 apply  blast
 apply (rule allI)
-apply (unfold dynCall_def call_def block_def)
+apply (unfold dynCall_exn_def maybe_guard_UNIV call_exn_def block_exn_def guards.simps)
 apply (rule HoareTotalDef.DynCom)
 apply clarsimp
 apply (rule HoareTotalDef.DynCom)
 apply clarsimp
 apply (frule in_mono [rule_format, OF adapt])
 apply clarsimp
 apply (rename_tac Z')
 apply (rule_tac R="Q' Z Z'" in Seq)
 apply  (rule CatchSwap)
 apply   (rule SeqSwap)
 apply    (rule Throw)
 apply    (rule subset_refl)
 apply   (rule Basic)
 apply   (rule subset_refl)
 apply  (rule_tac R="{i. i \<in> P' Z Z'}" in Seq)
 apply   (rule Basic)
 apply   clarsimp
 apply  simp
 apply  (rule_tac Q'="Q' Z Z'" and A'="A' Z Z'" in conseqPost)
 using p
 apply    clarsimp
 apply   simp
 apply  clarsimp
 apply  (rule_tac  P'="\<lambda>Z''. {t. t=Z'' \<and> return Z t \<in> R Z t}" and
           Q'="\<lambda>Z''. Q" and A'="\<lambda>Z''. A" in conseq)
 prefer 2 apply simp
 apply (rule allI)
 apply (rule HoareTotalDef.DynCom)
 apply clarsimp
 apply (rule SeqSwap)
 apply  (rule c [rule_format])
 apply (rule Basic)
 apply clarsimp
-done
+  done
+
+lemma DynProc_exn_guards_cons:
+  assumes p: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f UNIV init p return result_exn c Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) dynCall_exn f g init p return result_exn c Q,A"
+  using p apply (clarsimp simp add: dynCall_exn_def maybe_guard_def)
+  apply (rule Guard)
+   apply (rule subset_refl)
+  apply assumption
+  done
+
+lemma DynProc:
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
+                          (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
+                          (\<forall>t. t \<in> A' s Z \<longrightarrow> return s t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return c Q,A"
+  using adapt c p unfolding dynCall_dynCall_exn by (rule DynProc_exn)
+
+lemma DynProc_exn':
+  assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
+                          (\<forall>t \<in> Q' s Z. return s t \<in> R s t) \<and>
+                          (\<forall>t \<in> A' s Z. result_exn (return s t) t \<in> A)}"
+  assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+  assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f UNIV init p return result_exn c Q,A"
+proof -
+  from adapt have "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
+                          (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
+                          (\<forall>t. t \<in> A' s Z \<longrightarrow> result_exn (return s t) t \<in> A)}"
+    by blast
+  from this c p show ?thesis
+    by (rule DynProc_exn)
+qed
 
 lemma DynProc':
   assumes adapt: "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
                           (\<forall>t \<in> Q' s Z. return s t \<in> R s t) \<and>
                           (\<forall>t \<in> A' s Z. return s t \<in> A)}"
   assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
   assumes p: "\<forall>s\<in> P. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' s Z) Call (p s) (Q' s Z),(A' s Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return c Q,A"
-proof -
-  from adapt have "P \<subseteq> {s. \<exists>Z. init s \<in> P' s Z \<and>
-                          (\<forall>t. t \<in> Q' s Z \<longrightarrow>  return s t \<in> R s t) \<and>
-                          (\<forall>t. t \<in> A' s Z \<longrightarrow> return s t \<in> A)}"
-    by blast
-  from this c p show ?thesis
-    by (rule DynProc)
-qed
+  using adapt c p unfolding dynCall_dynCall_exn by (rule DynProc_exn')
 
-lemma DynProcStaticSpec:
+lemma DynProc_exnStaticSpec:
 assumes adapt: "P \<subseteq> {s. s \<in> S \<and> (\<exists>Z. init s \<in> P' Z  \<and>
                             (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
-                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> return s \<tau> \<in> A))}"
+                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> result_exn (return s \<tau>) \<tau> \<in> A))}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>s\<in>S. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call (p s) (Q' Z),(A' Z)"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f UNIV init p return result_exn c) Q,A"
 proof -
   from adapt have P_S: "P \<subseteq> S"
     by blast
-  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> S) (dynCall init p return c) Q,A"
-    apply (rule DynProc [where P'="\<lambda>s Z. P' Z" and Q'="\<lambda>s Z. Q' Z"
+  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> S) (dynCall_exn f UNIV init p return result_exn c) Q,A"
+    apply (rule DynProc_exn [where P'="\<lambda>s Z. P' Z" and Q'="\<lambda>s Z. Q' Z"
                          and A'="\<lambda>s Z. A' Z", OF _ c])
     apply  clarsimp
     apply  (frule in_mono [rule_format, OF adapt])
     apply  clarsimp
     using spec
     apply clarsimp
     done
   thus ?thesis
     by (rule conseqPre) (insert P_S,blast)
 qed
 
 
+lemma DynProcStaticSpec:
+assumes adapt: "P \<subseteq> {s. s \<in> S \<and> (\<exists>Z. init s \<in> P' Z  \<and>
+                            (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
+                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> return s \<tau> \<in> A))}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes spec: "\<forall>s\<in>S. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call (p s) (Q' Z),(A' Z)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using adapt c spec unfolding dynCall_dynCall_exn by (rule DynProc_exnStaticSpec)
+
+lemma DynProc_exnProcPar:
+assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
+                            (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
+                            (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> result_exn (return s \<tau>) \<tau> \<in> A))}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),(A' Z)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f UNIV init p return result_exn c) Q,A"
+  apply (rule DynProc_exnStaticSpec [where S="{s. p s = q}",simplified, OF adapt c])
+  using spec
+  apply simp
+  done
 
 lemma DynProcProcPar:
 assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
                             (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>) \<and>
                             (\<forall>\<tau>. \<tau> \<in> A' Z \<longrightarrow> return s \<tau> \<in> A))}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),(A' Z)"
 shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
   apply (rule DynProcStaticSpec [where S="{s. p s = q}",simplified, OF adapt c])
   using spec
   apply simp
   done
 
-
-lemma DynProcProcParNoAbrupt:
+lemma DynProc_exnProcParNoAbrupt:
 assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
                             (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>))}"
 assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),{}"
-shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f UNIV init p return result_exn c) Q,A"
 proof -
   have "P \<subseteq> {s. p s = q \<and> (\<exists> Z. init s \<in> P' Z \<and>
                       (\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t) \<and>
-                      (\<forall>t. t \<in> {} \<longrightarrow> return s t \<in> A))}"
+                      (\<forall>t. t \<in> {} \<longrightarrow> result_exn (return s t) t \<in> A))}"
     (is "P \<subseteq> ?P'")
   proof
     fix s
     assume P: "s\<in>P"
     with adapt obtain Z where
       Pre: "p s = q \<and> init s \<in> P' Z" and
       adapt_Norm: "\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>"
       by blast
     from  adapt_Norm
     have "\<forall>t. t \<in> Q' Z \<longrightarrow> return s t \<in> R s t"
       by auto
     then
     show "s\<in>?P'"
       using Pre by blast
   qed
   note P = this
   show ?thesis
     apply -
-    apply (rule DynProcStaticSpec [where S="{s. p s = q}",simplified, OF P c])
+    apply (rule DynProc_exnStaticSpec [where S="{s. p s = q}",simplified, OF P c])
     apply (insert spec)
     apply auto
     done
 qed
 
-lemma DynProcModifyReturnNoAbr:
-  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return' c) Q,A"
+lemma DynProcProcParNoAbrupt:
+assumes adapt: "P \<subseteq> {s. p s = q \<and> (\<exists>Z. init s \<in> P' Z  \<and>
+                            (\<forall>\<tau>. \<tau> \<in> Q' Z \<longrightarrow> return s \<tau> \<in> R s \<tau>))}"
+assumes c: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
+assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) Call q (Q' Z),{}"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using adapt c spec unfolding dynCall_dynCall_exn by (rule DynProc_exnProcParNoAbrupt)
+
+lemma DynProc_exnModifyReturnNoAbr:
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return' result_exn c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
             "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s)  (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
   from ret_nrm_modif
   have "\<forall>s t. t  \<in> (Modif (init s))
         \<longrightarrow> return' s t = return s t"
     by iprover
   then
   have ret_nrm_modif': "\<forall>s t. t \<in> (Modif (init s))
                       \<longrightarrow> return' s t = return s t"
     by simp
   have ret_abr_modif': "\<forall>s t. t \<in> {}
-                        \<longrightarrow> return' s t = return s t"
+                        \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
     by simp
   from to_prove ret_nrm_modif' ret_abr_modif' modif_clause show ?thesis
-    by (rule dynProcModifyReturn)
+    by (rule dynProc_exnModifyReturn)
 qed
 
-lemma ProcDynModifyReturnNoAbrSameFaults:
+lemma DynProcModifyReturnNoAbr:
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
+            "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s)  (Modif \<sigma>),{}"
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule DynProc_exnModifyReturnNoAbr)
+
+lemma ProcDyn_exnModifyReturnNoAbrSameFaults:
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
             "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
   from ret_nrm_modif
   have "\<forall>s t. t  \<in> (Modif (init s))
         \<longrightarrow> return' s t = return s t"
     by iprover
   then
   have ret_nrm_modif': "\<forall>s t. t \<in> (Modif (init s))
                       \<longrightarrow> return' s t = return s t"
     by simp
   have ret_abr_modif': "\<forall>s t. t \<in> {}
-                        \<longrightarrow> return' s t = return s t"
+                        \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
     by simp
   from to_prove ret_nrm_modif' ret_abr_modif' modif_clause show ?thesis
-    by (rule dynProcModifyReturnSameFaults)
+    by (rule dynProc_exnModifyReturnSameFaults)
+qed
+
+
+lemma ProcDynModifyReturnNoAbrSameFaults:
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return' c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
+            "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),{}"
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule ProcDyn_exnModifyReturnNoAbrSameFaults)
+
+lemma Proc_exnProcParModifyReturn:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
+         @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
+                            \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  assumes modif_clause:
+          "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+proof -
+  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
+    by (rule conseqPre) blast
+  from this ret_nrm_modif
+       ret_abr_modif
+  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule dynProc_exnModifyReturn) (insert modif_clause,auto)
+  from this q show ?thesis
+    by (rule conseqPre)
 qed
 
 lemma ProcProcParModifyReturn:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
          @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
           "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+        shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif ret_abr_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturn)
+
+lemma Proc_exnProcParModifyReturnSameFaults:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
+         @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
+                            \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  assumes modif_clause:
+          "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call q (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
-  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
+  from to_prove
+  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
     by (rule conseqPre) blast
   from this ret_nrm_modif
        ret_abr_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule dynProcModifyReturn) (insert modif_clause,auto)
+  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule dynProc_exnModifyReturnSameFaults) (insert modif_clause,auto)
   from this q show ?thesis
     by (rule conseqPre)
 qed
 
 
-
 lemma ProcProcParModifyReturnSameFaults:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcPar} introduces the same constraint as first conjunction in
          @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes ret_abr_modif: "\<forall>s t. t \<in> (ModifAbr (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
           "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call q (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+        shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif ret_abr_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturnSameFaults)
+
+lemma Proc_exnProcParModifyReturnNoAbr:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+   \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
+      first conjunction in @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
+            "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
-  from to_prove
-  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
+  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
     by (rule conseqPre) blast
   from this ret_nrm_modif
-       ret_abr_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule dynProcModifyReturnSameFaults) (insert modif_clause,auto)
+  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule DynProc_exnModifyReturnNoAbr) (insert modif_clause,auto)
   from this q show ?thesis
     by (rule conseqPre)
 qed
 
 lemma ProcProcParModifyReturnNoAbr:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
    \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
       first conjunction in @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
             "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturnNoAbr)
+
+
+lemma Proc_exnProcParModifyReturnNoAbrSameFaults:
+  assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
+      \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
+      first conjunction in @{term P'}, so the vcg can simplify it.\<close>
+  assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall_exn f g init p return' result_exn c) Q,A"
+  assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
+                            \<longrightarrow> return' s t = return s t"
+  assumes modif_clause:
+            "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof -
-  from to_prove have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
+  from to_prove have
+    "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return' result_exn c) Q,A"
     by (rule conseqPre) blast
   from this ret_nrm_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule DynProcModifyReturnNoAbr) (insert modif_clause,auto)
+  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall_exn f g init p return result_exn c) Q,A"
+    by (rule ProcDyn_exnModifyReturnNoAbrSameFaults) (insert modif_clause,auto)
   from this q show ?thesis
     by (rule conseqPre)
 qed
 
-
 lemma ProcProcParModifyReturnNoAbrSameFaults:
   assumes q: "P \<subseteq> {s. p s = q} \<inter> P'"
       \<comment> \<open>@{thm[source] DynProcProcParNoAbrupt} introduces the same constraint as
       first conjunction in @{term P'}, so the vcg can simplify it.\<close>
   assumes to_prove: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' (dynCall init p return' c) Q,A"
   assumes ret_nrm_modif: "\<forall>s t. t \<in> (Modif (init s))
                             \<longrightarrow> return' s t = return s t"
   assumes modif_clause:
             "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call q) (Modif \<sigma>),{}"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-proof -
-  from to_prove have
-    "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return' c) Q,A"
-    by (rule conseqPre) blast
-  from this ret_nrm_modif
-  have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. p s = q} \<inter> P') (dynCall init p return c) Q,A"
-    by (rule ProcDynModifyReturnNoAbrSameFaults) (insert modif_clause,auto)
-  from this q show ?thesis
-    by (rule conseqPre)
-qed
+          shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using q to_prove ret_nrm_modif modif_clause unfolding dynCall_dynCall_exn
+  by (rule Proc_exnProcParModifyReturnNoAbrSameFaults)
+
 
 lemma MergeGuards_iff: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P merge_guards c Q,A = \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (auto intro: MergeGuardsI MergeGuardsD)
 
 lemma CombineStrip':
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c' Q,A"
   assumes deriv_strip_triv: "\<Gamma>,{}\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
   assumes c'': "c''= mark_guards False (strip_guards (-F) c')"
   assumes c: "merge_guards c = merge_guards (mark_guards False c')"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 proof -
   from deriv_strip_triv have deriv_strip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
     by (auto intro: hoare_augment_context)
   from deriv_strip [simplified c'']
   have "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P (strip_guards (- F) c') UNIV,UNIV"
     by (rule HoarePartialProps.MarkGuardsD)
   with deriv
   have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c' Q,A"
     by (rule CombineStrip)
   hence "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P mark_guards False c' Q,A"
     by (rule MarkGuardsI)
   hence "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P merge_guards (mark_guards False c') Q,A"
     by (rule MergeGuardsI)
   hence "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P merge_guards c Q,A"
     by (simp add: c)
   thus ?thesis
     by (rule MergeGuardsD)
 qed
 
 lemma CombineStrip'':
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{True}\<^esub> P c' Q,A"
   assumes deriv_strip_triv: "\<Gamma>,{}\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
   assumes c'': "c''= mark_guards False (strip_guards ({False}) c')"
   assumes c: "merge_guards c = merge_guards (mark_guards False c')"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
   apply (rule CombineStrip' [OF deriv deriv_strip_triv _ c])
   apply (insert c'')
   apply (subgoal_tac "- {True} = {False}")
   apply auto
   done
 
 lemma AsmUN:
   "(\<Union>Z. {(P Z, p, Q Z,A Z)}) \<subseteq> \<Theta>
   \<Longrightarrow>
   \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) (Call p) (Q Z),(A Z)"
   by (blast intro: hoaret.Asm)
 
 
 lemma hoaret_to_hoarep':
   "\<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z) \<Longrightarrow> \<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)"
   by (iprover intro: total_to_partial)
 
 lemma augment_context':
   "\<lbrakk>\<Theta> \<subseteq> \<Theta>'; \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z)  p (Q Z),(A Z)\<rbrakk>
    \<Longrightarrow> \<forall>Z. \<Gamma>,\<Theta>'\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)"
   by (iprover intro: hoaret_augment_context)
 
 
 lemma augment_emptyFaults:
  "\<lbrakk>\<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> (P Z) p (Q Z),(A Z)\<rbrakk> \<Longrightarrow>
     \<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)"
   by (blast intro: augment_Faults)
 
 lemma augment_FaultsUNIV:
  "\<lbrakk>\<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) p (Q Z),(A Z)\<rbrakk> \<Longrightarrow>
     \<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/UNIV\<^esub> (P Z) p (Q Z),(A Z)"
   by (blast intro: augment_Faults)
 
 lemma PostConjI [trans]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c R,B\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
   by (rule PostConjI)
 
 lemma PostConjI' :
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c R,B\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
   by (rule PostConjI) iprover+
 
 lemma PostConjE [consumes 1]:
   assumes conj: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
   assumes E: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c R,B\<rbrakk> \<Longrightarrow> S"
   shows "S"
 proof -
   from conj have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" by (rule conseqPost) blast+
   moreover
   from conj have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c R,B" by (rule conseqPost) blast+
   ultimately show "S"
     by (rule E)
 qed
 
 subsubsection \<open>Rules for Single-Step Proof \label{sec:hoare-isar}\<close>
 
 text \<open>
  We are now ready to introduce a set of Hoare rules to be used in
  single-step structured proofs in Isabelle/Isar.
 
  \medskip Assertions of Hoare Logic may be manipulated in
  calculational proofs, with the inclusion expressed in terms of sets
  or predicates.  Reversed order is supported as well.
 \<close>
 
 
 lemma annotateI [trans]:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P anno Q,A; c = anno\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (simp)
 
 lemma annotate_normI:
   assumes deriv_anno: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>P anno Q,A"
   assumes norm_eq: "normalize c = normalize anno"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>P c Q,A"
 proof -
   from HoareTotalProps.NormalizeI [OF deriv_anno] norm_eq
   have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>P normalize c Q,A"
     by simp
   from NormalizeD [OF this]
   show ?thesis .
 qed
 
 
 lemma annotateWhile:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoG gs b I V c) Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (while gs b c) Q,A"
   by (simp add: whileAnnoG_def)
 
 
 lemma reannotateWhile:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoG gs b I V c) Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnnoG gs b J V c) Q,A"
   by (simp add: whileAnnoG_def)
 
 lemma reannotateWhileNoGuard:
 "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnno b I V c) Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (whileAnno b J V c) Q,A"
   by (simp add: whileAnno_def)
 
 lemma [trans] : "P' \<subseteq> P \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q,A"
   by (rule conseqPre)
 
 lemma [trans]: "Q \<subseteq> Q' \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q',A"
   by (rule conseqPost) blast+
 
 lemma [trans]:
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P s} c Q,A \<Longrightarrow> (\<And>s. P' s \<longrightarrow> P s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P' s} c Q,A"
   by (rule conseqPre) auto
 
 lemma [trans]:
     "(\<And>s. P' s \<longrightarrow> P s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P s} c Q,A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P' s} c Q,A"
   by (rule conseqPre) auto
 
 lemma [trans]:
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c {s. Q s},A \<Longrightarrow> (\<And>s. Q s \<longrightarrow> Q' s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c {s. Q' s},A"
   by (rule conseqPost) auto
 
 lemma [trans]:
     "(\<And>s. Q s \<longrightarrow> Q' s) \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c {s. Q s},A \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c {s. Q' s},A"
   by (rule conseqPost) auto
 
 lemma [intro?]: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Skip P,A"
   by (rule Skip) auto
 
 lemma CondInt [trans,intro?]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> b) c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> - b) c2 Q,A\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c1 c2) Q,A"
   by (rule Cond) auto
 
 lemma CondConj [trans, intro?]:
   "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P s \<and> b s} c1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P s \<and> \<not> b s} c2 Q,A\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. P s} (Cond {s. b s} c1 c2) Q,A"
   by (rule Cond) auto
 end
 
diff --git a/thys/Simpl/HoareTotalDef.thy b/thys/Simpl/HoareTotalDef.thy
--- a/thys/Simpl/HoareTotalDef.thy
+++ b/thys/Simpl/HoareTotalDef.thy
@@ -1,374 +1,353 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HoareTotalDef.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>Hoare Logic for Total Correctness\<close>
 
 theory HoareTotalDef imports HoarePartialDef Termination begin
 
 subsection \<open>Validity of Hoare Tuples: \<open>\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A\<close>\<close>
 
 definition
   validt :: "[('s,'p,'f) body,'f set,'s assn,('s,'p,'f) com,'s assn,'s assn] \<Rightarrow> bool"
                 ("_\<Turnstile>\<^sub>t\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60,1000, 20, 1000,1000] 60)
 where
  "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<equiv> \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A \<and> (\<forall>s \<in> Normal ` P. \<Gamma>\<turnstile>c\<down>s)"
 
 definition
   cvalidt::
   "[('s,'p,'f) body,('s,'p) quadruple set,'f set,
     's assn,('s,'p,'f) com,'s assn,'s assn] \<Rightarrow> bool"
                 ("_,_\<Turnstile>\<^sub>t\<^bsub>'/_\<^esub>/ _ _ _,_"  [61,60, 60,1000, 20, 1000,1000] 60)
 where
  "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<equiv> (\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A) \<longrightarrow> \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 
 
 
 notation (ASCII)
   validt  ("_|=t'/_/ _ _ _,_"  [61,60,1000, 20, 1000,1000] 60) and
   cvalidt  ("_,_|=t'/_ / _ _ _,_"  [61,60,60,1000, 20, 1000,1000] 60)
 
 subsection \<open>Properties of Validity\<close>
 
 lemma validtI:
  "\<lbrakk>\<And>s t. \<lbrakk>\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t;s \<in> P;t \<notin> Fault ` F\<rbrakk> \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A;
    \<And>s. s \<in> P \<Longrightarrow> \<Gamma>\<turnstile> c\<down>(Normal s) \<rbrakk>
   \<Longrightarrow> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (auto simp add: validt_def valid_def)
 
 lemma cvalidtI:
  "\<lbrakk>\<And>s t. \<lbrakk>\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A;\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t;s \<in> P;
           t \<notin> Fault ` F\<rbrakk>
           \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A;
    \<And>s. \<lbrakk>\<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A; s\<in>P\<rbrakk> \<Longrightarrow>  \<Gamma>\<turnstile>c\<down>(Normal s)\<rbrakk>
   \<Longrightarrow> \<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (auto simp add: cvalidt_def validt_def valid_def)
 
 lemma cvalidt_postD:
  "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A;\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t;
    s \<in> P;t \<notin> Fault ` F\<rbrakk>
   \<Longrightarrow> t \<in> Normal ` Q \<union> Abrupt ` A"
   by (simp add: cvalidt_def validt_def valid_def)
 
 lemma cvalidt_termD:
  "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<forall>(P,p,Q,A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A;s \<in> P\<rbrakk>
   \<Longrightarrow> \<Gamma>\<turnstile>c\<down>(Normal s)"
   by (simp add: cvalidt_def validt_def valid_def)
 
 
 lemma validt_augment_Faults:
   assumes valid:"\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes F': "F \<subseteq> F'"
   shows "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F'\<^esub> P c Q,A"
   using valid F'
   by (auto intro: valid_augment_Faults simp add: validt_def)
 
 subsection \<open>The Hoare Rules: \<open>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A\<close>\<close>
 
 inductive "hoaret"::"[('s,'p,'f) body,('s,'p) quadruple set,'f set,
                         's assn,('s,'p,'f) com,'s assn,'s assn]
                        => bool"
     ("(3_,_/\<turnstile>\<^sub>t\<^bsub>'/_\<^esub> (_/ (_)/ _,_))" [61,60,60,1000,20,1000,1000]60)
    for \<Gamma>::"('s,'p,'f) body"
 where
   Skip: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> Q Skip Q,A"
 
 | Basic: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. f s \<in> Q} (Basic f) Q,A"
 
 | Spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. (\<forall>t. (s,t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s,t) \<in> r)} (Spec r) Q,A"
 
 | Seq: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 R,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk>
         \<Longrightarrow>
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Seq c\<^sub>1 c\<^sub>2 Q,A"
 
 | Cond: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> b) c\<^sub>1 Q,A; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> - b) c\<^sub>2 Q,A\<rbrakk>
          \<Longrightarrow>
          \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Cond b c\<^sub>1 c\<^sub>2) Q,A"
 
 | While: "\<lbrakk>wf r; \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P \<inter> b) c ({t. (t,\<sigma>)\<in>r} \<inter> P),A\<rbrakk>
           \<Longrightarrow>
           \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (While b c) (P \<inter> - b),A"
 
 | Guard: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) c Q,A
           \<Longrightarrow>
           \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) Guard f g c Q,A"
 
 | Guarantee: "\<lbrakk>f \<in> F; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Guard f g c) Q,A"
 
 | CallRec:
   "\<lbrakk>(P,p,Q,A) \<in> Specs;
     wf r;
     Specs_wf = (\<lambda>p \<sigma>. (\<lambda>(P,q,Q,A). (P \<inter> {s. ((s,q),(\<sigma>,p)) \<in> r},q,Q,A)) ` Specs);
     \<forall>(P,p,Q,A)\<in> Specs.
       p \<in> dom \<Gamma> \<and> (\<forall>\<sigma>. \<Gamma>,\<Theta> \<union> Specs_wf p \<sigma>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P) (the (\<Gamma> p)) Q,A)
     \<rbrakk>
     \<Longrightarrow>
     \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
 
 
 | DynCom:  "\<forall>s \<in> P. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (c s) Q,A
             \<Longrightarrow>
             \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (DynCom c) Q,A"
 
 
 | Throw: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> A Throw Q,A"
 
 | Catch: "\<lbrakk>\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,R; \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A\<rbrakk> \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
 
 | Conseq: "\<forall>s \<in> P. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A' \<and> s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A
            \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 
 
 | Asm: "(P,p,Q,A) \<in> \<Theta>
         \<Longrightarrow>
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
 
 | ExFalso: "\<lbrakk>\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A; \<not> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A\<rbrakk> \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   \<comment> \<open>This is a hack rule that enables us to derive completeness for
         an arbitrary context \<open>\<Theta>\<close>, from completeness for an empty context.\<close>
 
 
 text \<open>Does not work, because of rule ExFalso, the context \<open>\<Theta>\<close> is to blame.
  A weaker version with empty context can be derived from soundness
  later on.\<close>
 lemma hoaret_to_hoarep:
   assumes hoaret: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P p Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P p Q,A"
 using hoaret
 proof (induct)
   case Skip thus ?case by (rule hoarep.intros)
 next
   case Basic thus ?case by (rule hoarep.intros)
 next
   case Seq thus ?case by - (rule hoarep.intros)
 next
   case Cond thus ?case by - (rule hoarep.intros)
 next
   case (While r \<Theta> F P b c A)
   hence "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P \<inter> b) c ({t. (t, \<sigma>) \<in> r} \<inter> P),A"
     by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P \<inter> b) c P,A"
     by (rule HoarePartialDef.conseq) blast
   then show "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P While b c (P \<inter> - b),A"
     by (rule hoarep.While)
 next
   case Guard thus ?case by - (rule hoarep.intros)
 (*next
   case (CallRec A F P Procs Q Z \<Theta>  p r)
   hence hyp: "\<forall>p\<in>Procs. \<forall>\<tau> Z.
            \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r},
                       Call q, Q q Z,A q Z)})\<turnstile>\<^bsub>/F\<^esub>
               ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
     by blast
   have "\<forall>p\<in>Procs. \<forall>Z.
            \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z,
                       Call q, Q q Z,A q Z)})\<turnstile>\<^bsub>/F\<^esub>
               (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
   proof (intro ballI allI)
     fix p Z
     assume "p \<in> Procs"
     with hyp
     have hyp': "\<And> \<tau>.
            \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r},
                       Call q, Q q Z, A q Z)})\<turnstile>\<^bsub>/F\<^esub>
               ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
       by blast
     have "\<forall>\<tau>.
            \<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z,
                       Call q, Q q Z,A q Z)})\<turnstile>\<^bsub>/F\<^esub>
               ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
       (is "\<forall>\<tau>. \<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> ({\<tau>} \<inter> P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)")
     proof (rule allI, rule WeakenContext [OF hyp'],clarify)
       fix \<tau> P' c Q' A'
       assume "(P', c, Q', A') \<in> \<Theta> \<union>
          (\<Union>q\<in>Procs.
              \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r},
                   Call q, Q q Z,
                   A q Z)})" (is "(P', c, Q', A') \<in> \<Theta> \<union> ?Spec")
       then show "\<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> P' c Q',A'"
       proof (cases rule: UnE [consumes 1])
         assume "(P',c,Q',A') \<in> \<Theta>"
         then show ?thesis
           by (blast intro: HoarePartialDef.Asm)
       next
         assume "(P',c,Q',A') \<in> ?Spec"
         then show ?thesis
         proof (clarify)
           fix q Z
           assume q: "q \<in> Procs"
           show "\<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> (P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r})
                          Call  q
                         (Q q Z),(A q Z)"
           proof -
             from q
             have "\<Gamma>,?\<Theta>'\<turnstile>\<^bsub>/F\<^esub> (P q Z) Call q (Q q Z),(A q Z)"
               by - (rule HoarePartialDef.Asm,blast)
             thus ?thesis
               by (rule HoarePartialDef.conseqPre) blast
           qed
         qed
       qed
     qed
     then show "\<Gamma>,\<Theta> \<union> (\<Union>q\<in>Procs. \<Union>Z. {(P q Z, Call q, Q q Z,A q Z)})
                 \<turnstile>\<^bsub>/F\<^esub> (P p Z) (the (\<Gamma> p)) (Q p Z),(A p Z)"
       by (rule HoarePartialDef.conseq) blast
   qed
   thus ?case
     by - (rule hoarep.CallRec)*)
 next
   case DynCom thus ?case by (blast intro: hoarep.DynCom)
 next
   case Throw thus ?case by - (rule hoarep.Throw)
 next
   case Catch thus ?case by - (rule hoarep.Catch)
 next
   case Conseq thus ?case by - (rule hoarep.Conseq,blast)
 next
   case Asm thus ?case by (rule HoarePartialDef.Asm)
 next
   case (ExFalso \<Theta> F P c Q A)
   assume "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   hence "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
     oops
 
 
 lemma hoaret_augment_context:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P p Q,A"
   shows "\<And>\<Theta>'. \<Theta> \<subseteq> \<Theta>' \<Longrightarrow> \<Gamma>,\<Theta>'\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P p Q,A"
 using deriv
 proof (induct)
   case (CallRec P p Q A Specs r Specs_wf \<Theta> F \<Theta>')
   have aug: "\<Theta> \<subseteq> \<Theta>'" by fact
   then
   have h: "\<And>\<tau> p. \<Theta> \<union> Specs_wf p \<tau>
        \<subseteq> \<Theta>' \<union> Specs_wf p \<tau>"
     by blast
   have "\<forall>(P,p,Q,A)\<in>Specs. p \<in> dom \<Gamma> \<and>
      (\<forall>\<tau>. \<Gamma>,\<Theta> \<union> Specs_wf p \<tau>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A \<and>
            (\<forall>x. \<Theta> \<union> Specs_wf p \<tau>
                  \<subseteq> x \<longrightarrow>
                  \<Gamma>,x\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A))" by fact
   hence "\<forall>(P,p,Q,A)\<in>Specs. p \<in> dom \<Gamma> \<and>
          (\<forall>\<tau>. \<Gamma>,\<Theta>'\<union> Specs_wf p \<tau> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A)"
     apply (clarify)
     apply (rename_tac P p Q A)
     apply (drule (1) bspec)
     apply (clarsimp)
     apply (erule_tac x=\<tau> in allE)
     apply clarify
     apply (erule_tac x="\<Theta>' \<union> Specs_wf p \<tau>" in allE)
     apply (insert aug)
     apply auto
     done
   with CallRec show ?case by - (rule hoaret.CallRec)
 next
   case DynCom thus ?case by (blast intro: hoaret.DynCom)
 next
   case (Conseq P \<Theta> F c Q A \<Theta>')
   from Conseq
   have "\<forall>s \<in> P. (\<exists>P' Q' A'. (\<Gamma>,\<Theta>' \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A') \<and> s \<in> P'\<and> Q' \<subseteq> Q \<and> A' \<subseteq> A)"
     by blast
   with Conseq show ?case by - (rule hoaret.Conseq)
 next
   case (ExFalso \<Theta> F P  c Q A \<Theta>')
   have "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" "\<not> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" "\<Theta> \<subseteq> \<Theta>'"  by fact+
   then show ?case
     by (fastforce intro: hoaret.ExFalso simp add: cvalidt_def)
 qed (blast intro: hoaret.intros)+
 
 subsection \<open>Some Derived Rules\<close>
 
 
 lemma  Conseq': "\<forall>s. s \<in> P \<longrightarrow>
             (\<exists>P' Q' A'.
               (\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z)) \<and>
                     (\<exists>Z. s \<in> P' Z \<and> (Q' Z \<subseteq> Q) \<and> (A' Z \<subseteq> A)))
            \<Longrightarrow>
            \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 apply (rule Conseq)
 apply (rule ballI)
 apply (erule_tac x=s in allE)
 apply (clarify)
 apply (rule_tac x="P' Z" in exI)
 apply (rule_tac x="Q' Z" in exI)
 apply (rule_tac x="A' Z" in exI)
 apply blast
 done
 
 lemma conseq:"\<lbrakk>\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z) c (Q' Z),(A' Z);
               \<forall>s. s \<in> P \<longrightarrow> (\<exists> Z. s\<in>P' Z \<and> (Q' Z \<subseteq> Q)\<and> (A' Z \<subseteq> A))\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (rule Conseq) blast
 
 theorem conseqPrePost:
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A' \<Longrightarrow> P \<subseteq> P' \<Longrightarrow>  Q' \<subseteq> Q \<Longrightarrow> A' \<subseteq> A \<Longrightarrow>  \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (rule conseq [where ?P'="\<lambda>Z. P'" and ?Q'="\<lambda>Z. Q'"]) auto
 
 lemma conseqPre: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q,A \<Longrightarrow> P \<subseteq> P' \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 by (rule conseq) auto
 
 lemma conseqPost: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q',A'\<Longrightarrow> Q' \<subseteq> Q \<Longrightarrow> A' \<subseteq> A \<Longrightarrow>   \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (rule conseq) auto
 
 
 lemma Spec_wf_conv:
   "(\<lambda>(P, q, Q, A). (P \<inter> {s. ((s, q), \<tau>, p) \<in> r}, q, Q, A)) `
                 (\<Union>p\<in>Procs. \<Union>Z. {(P p Z, p, Q p Z, A p Z)}) =
         (\<Union>q\<in>Procs. \<Union>Z. {(P q Z \<inter> {s. ((s, q), \<tau>, p) \<in> r}, q, Q q Z, A q Z)})"
   by (auto intro!: image_eqI)
 
 lemma CallRec':
   "\<lbrakk>p\<in>Procs; Procs \<subseteq> dom \<Gamma>;
     wf r;
    \<forall>p\<in>Procs. \<forall>\<tau> Z.
    \<Gamma>,\<Theta>\<union>(\<Union>q\<in>Procs. \<Union>Z.
     {((P q Z) \<inter> {s. ((s,q),(\<tau>,p)) \<in> r},q,Q q Z,(A q Z))})
      \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> (P p Z)) (the (\<Gamma> p)) (Q p Z),(A p Z)\<rbrakk>
    \<Longrightarrow>
    \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P p Z) (Call p) (Q p Z),(A p Z)"
 apply (rule CallRec [where Specs="\<Union>p\<in>Procs. \<Union>Z. {((P p Z),p,Q p Z,A p Z)}" and
          r=r])
 apply    blast
 apply   assumption
 apply  (rule refl)
 apply (clarsimp)
 apply (rename_tac p')
 apply (rule conjI)
 apply  blast
 apply (intro allI)
 apply (rename_tac Z \<tau>)
 apply (drule_tac x=p' in bspec, assumption)
 apply (erule_tac x=\<tau> in allE)
 apply (erule_tac x=Z in allE)
 apply (fastforce simp add: Spec_wf_conv)
 done
 
 end
 
diff --git a/thys/Simpl/HoareTotalProps.thy b/thys/Simpl/HoareTotalProps.thy
--- a/thys/Simpl/HoareTotalProps.thy
+++ b/thys/Simpl/HoareTotalProps.thy
@@ -1,3496 +1,3634 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      HoarePartial.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
 section \<open>Properties of Total Correctness Hoare Logic\<close>
 
 theory HoareTotalProps imports SmallStep HoareTotalDef HoarePartialProps begin
 
 subsection \<open>Soundness\<close>
 
 lemma hoaret_sound:
  assumes hoare: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
  shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 using hoare
 proof (induct)
   case (Skip \<Theta> F P A)
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Skip P,A"
   proof (rule cvalidtI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow> t" "s \<in> P"
     thus "t \<in> Normal ` P \<union> Abrupt ` A"
       by cases auto
   next
     fix s show "\<Gamma>\<turnstile>Skip \<down> Normal s"
       by (rule terminates.intros)
   qed
 next
   case (Basic \<Theta> F f P A)
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. f s \<in> P} (Basic f) P,A"
   proof (rule cvalidtI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow> t" "s \<in> {s. f s \<in> P}"
     thus "t \<in> Normal ` P \<union> Abrupt ` A"
       by cases auto
   next
     fix s show "\<Gamma>\<turnstile>Basic f \<down> Normal s"
       by (rule terminates.intros)
   qed
 next
   case (Spec \<Theta> F r Q A)
   show "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. (\<forall>t. (s, t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s, t) \<in> r)} Spec r Q,A"
   proof (rule cvalidtI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Spec r ,Normal s\<rangle> \<Rightarrow> t"
            "s \<in> {s. (\<forall>t. (s, t) \<in> r \<longrightarrow> t \<in> Q) \<and> (\<exists>t. (s, t) \<in> r)}"
     thus "t \<in> Normal ` Q \<union> Abrupt ` A"
       by cases auto
   next
     fix s show "\<Gamma>\<turnstile>Spec r \<down> Normal s"
       by (rule terminates.intros)
   qed
 next
   case (Seq \<Theta> F P c1 R A c2 Q)
   have valid_c1: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c1 R,A" by fact
   have valid_c2: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> R c2 Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Seq c1 c2 Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     from exec P obtain r where
       exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> r" and exec_c2:  "\<Gamma>\<turnstile>\<langle>c2,r\<rangle> \<Rightarrow> t"
       by cases auto
     with t_notin_F have "r \<notin> Fault ` F"
       by (auto dest: Fault_end)
     from valid_c1 ctxt exec_c1 P this
     have r: "r \<in> Normal ` R \<union> Abrupt ` A"
       by (rule cvalidt_postD)
     show "t\<in>Normal ` Q \<union> Abrupt ` A"
     proof (cases r)
       case (Normal r')
       with exec_c2 r
       show "t\<in>Normal ` Q \<union> Abrupt ` A"
         apply -
         apply (rule cvalidt_postD [OF valid_c2 ctxt _ _ t_notin_F])
         apply auto
         done
     next
       case (Abrupt r')
       with exec_c2 have "t=Abrupt r'"
         by (auto elim: exec_elim_cases)
       with Abrupt r show ?thesis
         by auto
     next
       case Fault with r show ?thesis by blast
     next
       case Stuck with r show ?thesis by blast
     qed
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P: "s\<in>P"
     show "\<Gamma>\<turnstile>Seq c1 c2 \<down> Normal s"
     proof -
       from valid_c1 ctxt P
       have "\<Gamma>\<turnstile>c1\<down> Normal s"
         by (rule cvalidt_termD)
       moreover
       {
         fix r assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> r"
         have "\<Gamma>\<turnstile>c2 \<down> r"
         proof (cases r)
           case (Normal r')
           with cvalidt_postD [OF valid_c1 ctxt exec_c1 P]
           have r: "r\<in>Normal ` R"
             by auto
           with cvalidt_termD [OF valid_c2 ctxt] exec_c1
           show "\<Gamma>\<turnstile>c2 \<down> r"
             by auto
         qed auto
       }
       ultimately show ?thesis
         by (iprover intro: terminates.intros)
     qed
   qed
 next
   case (Cond \<Theta> F P b c1 Q A c2)
   have valid_c1: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> b) c1 Q,A" by fact
   have valid_c2: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (P \<inter> - b) c2 Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Cond b c1 c2 Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof (cases "s\<in>b")
       case True
       with exec have "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> t"
         by cases auto
       with P True
       show ?thesis
         by - (rule cvalidt_postD [OF valid_c1 ctxt _ _ t_notin_F],auto)
     next
       case False
       with exec P have "\<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow> t"
         by cases auto
       with P False
       show ?thesis
         by - (rule cvalidt_postD [OF valid_c2 ctxt _ _ t_notin_F],auto)
     qed
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P: "s \<in> P"
     thus "\<Gamma>\<turnstile>Cond b c1 c2 \<down> Normal s"
       using cvalidt_termD [OF valid_c1 ctxt] cvalidt_termD [OF valid_c2 ctxt]
       by (cases "s \<in> b") (auto intro: terminates.intros)
   qed
 next
   case (While r \<Theta> F P b c A)
   assume wf: "wf r"
   have valid_c: "\<forall>\<sigma>. \<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> P \<inter> b) c ({t. (t, \<sigma>) \<in> r} \<inter> P),A"
     using While.hyps by iprover
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (While b c) (P \<inter> - b),A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume wprems: "\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow> t" "s \<in> P" "t \<notin> Fault ` F"
     from wf
     have "\<And>t. \<lbrakk>\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow> t; s \<in> P; t \<notin> Fault ` F\<rbrakk>
                  \<Longrightarrow> t \<in> Normal ` (P \<inter> - b) \<union> Abrupt ` A"
     proof (induct)
       fix s t
       assume hyp:
         "\<And>s' t. \<lbrakk>(s',s)\<in>r; \<Gamma>\<turnstile>\<langle>While b c,Normal s'\<rangle> \<Rightarrow> t; s' \<in> P; t \<notin> Fault ` F\<rbrakk>
                  \<Longrightarrow> t \<in> Normal ` (P \<inter> - b) \<union> Abrupt ` A"
       assume exec: "\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow> t"
       assume P: "s \<in> P"
       assume t_notin_F: "t \<notin> Fault ` F"
       from exec
       show "t \<in> Normal ` (P \<inter> - b) \<union> Abrupt ` A"
       proof (cases)
         fix s'
         assume b: "s\<in>b"
         assume exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> s'"
         assume exec_w: "\<Gamma>\<turnstile>\<langle>While b c,s'\<rangle> \<Rightarrow> t"
         from exec_w t_notin_F have "s' \<notin> Fault ` F"
           by (auto dest: Fault_end)
         from exec_c P b valid_c ctxt this
         have s': "s' \<in> Normal ` ({s'. (s', s) \<in> r} \<inter> P) \<union> Abrupt ` A"
           by (auto simp add: cvalidt_def validt_def valid_def)
         show ?thesis
         proof (cases s')
           case Normal
           with exec_w s' t_notin_F
           show ?thesis
             by - (rule hyp,auto)
         next
           case Abrupt
           with exec_w have "t=s'"
             by (auto dest: Abrupt_end)
           with Abrupt s' show ?thesis
             by blast
         next
           case Fault
           with exec_w have "t=s'"
             by (auto dest: Fault_end)
           with Fault s' show ?thesis
             by blast
         next
           case Stuck
           with exec_w have "t=s'"
             by (auto dest: Stuck_end)
           with Stuck s' show ?thesis
             by blast
         qed
       next
         assume "s\<notin>b" "t=Normal s" with P show ?thesis by simp
       qed
     qed
     with wprems show "t \<in> Normal ` (P \<inter> - b) \<union> Abrupt ` A" by blast
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume "s \<in> P"
     with wf
     show "\<Gamma>\<turnstile>While b c \<down> Normal s"
     proof (induct)
       fix s
       assume hyp: "\<And>s'. \<lbrakk>(s',s)\<in>r; s' \<in> P\<rbrakk>
                          \<Longrightarrow> \<Gamma>\<turnstile>While b c \<down> Normal s'"
       assume P: "s \<in> P"
       show "\<Gamma>\<turnstile>While b c \<down> Normal s"
       proof (cases "s \<in> b")
         case False with P show ?thesis
           by (blast intro: terminates.intros)
       next
         case True
         with valid_c P ctxt
         have "\<Gamma>\<turnstile>c \<down> Normal s"
           by (simp add: cvalidt_def validt_def)
         moreover
         {
           fix s'
           assume exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> s'"
           have "\<Gamma>\<turnstile>While b c \<down> s'"
           proof (cases s')
             case (Normal s'')
             with exec_c P True valid_c ctxt
             have s': "s' \<in> Normal ` ({s'. (s', s) \<in> r} \<inter> P)"
               by (fastforce simp add: cvalidt_def validt_def valid_def)
             then show ?thesis
               by (blast intro: hyp)
           qed auto
         }
         ultimately
         show ?thesis
           by (blast intro: terminates.intros)
       qed
     qed
   qed
 next
   case (Guard \<Theta> F g P c Q A  f)
   have valid_c: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) c Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) Guard f g c Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow> t"
     assume t_notin_F: "t \<notin> Fault ` F"
     assume P:"s \<in> (g \<inter> P)"
     from exec P have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
       by cases auto
     from valid_c ctxt this P t_notin_F
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by (rule cvalidt_postD)
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P:"s \<in> (g \<inter> P)"
     thus "\<Gamma>\<turnstile>Guard f g c  \<down> Normal s"
       by (auto intro: terminates.intros cvalidt_termD [OF valid_c ctxt])
   qed
 next
   case (Guarantee f F \<Theta> g P c Q A)
   have valid_c: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> P) c Q,A" by fact
   have f_F: "f \<in> F" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Guard f g c Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow> t"
     assume t_notin_F: "t \<notin> Fault ` F"
     assume P:"s \<in> P"
     from exec f_F t_notin_F have g: "s \<in> g"
       by cases auto
     with P have P': "s \<in> g \<inter> P"
       by blast
     from exec g have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
       by cases auto
     from valid_c ctxt this P' t_notin_F
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by (rule cvalidt_postD)
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P:"s \<in> P"
     thus "\<Gamma>\<turnstile>Guard f g c  \<down> Normal s"
       by (auto intro: terminates.intros cvalidt_termD [OF valid_c ctxt])
   qed
 next
   case (CallRec P p Q A Specs r Specs_wf \<Theta>  F)
   have p: "(P,p,Q,A) \<in> Specs"  by fact
   have wf: "wf r" by fact
   have Specs_wf:
     "Specs_wf = (\<lambda>p \<tau>. (\<lambda>(P,q,Q,A). (P \<inter> {s. ((s, q),\<tau>,p) \<in> r},q,Q,A)) ` Specs)" by fact
   from CallRec.hyps
   have valid_body:
     "\<forall>(P, p, Q, A)\<in>Specs. p \<in> dom \<Gamma> \<and>
         (\<forall>\<tau>. \<Gamma>,\<Theta> \<union> Specs_wf p \<tau>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) the (\<Gamma> p) Q,A)" by auto
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   proof -
     {
       fix \<tau>p
       assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
       from wf
       have "\<And>\<tau> p P Q A.  \<lbrakk>\<tau>p = (\<tau>,p); (P,p,Q,A) \<in> Specs\<rbrakk> \<Longrightarrow>
                   \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> (p))) Q,A"
       proof (induct \<tau>p rule: wf_induct [rule_format, consumes 1, case_names WF])
         case (WF \<tau>p \<tau> p P Q A)
         have \<tau>p: "\<tau>p = (\<tau>, p)" by fact
         have p: "(P, p, Q, A) \<in> Specs" by fact
         {
           fix q P' Q' A'
           assume q: "(P',q,Q',A') \<in> Specs"
           have "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' \<inter> {s. ((s,q), \<tau>,p) \<in> r}) (Call q) Q',A'"
           proof (rule validtI)
             fix s t
             assume exec_q:
               "\<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow> t"
             assume Pre: "s \<in> P' \<inter> {s. ((s,q), \<tau>,p) \<in> r}"
             assume t_notin_F: "t \<notin> Fault ` F"
             from Pre q \<tau>p
             have valid_bdy:
               "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s} \<inter> P') the (\<Gamma> q) Q',A'"
               by - (rule WF.hyps, auto)
             from Pre q
             have Pre': "s \<in> {s} \<inter> P'"
               by auto
             from exec_q show "t \<in> Normal ` Q' \<union> Abrupt ` A'"
             proof (cases)
               fix bdy
               assume bdy: "\<Gamma> q = Some bdy"
               assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow> t"
               from valid_bdy [simplified bdy option.sel]  t_notin_F exec_bdy Pre'
               have "t \<in> Normal ` Q' \<union> Abrupt ` A'"
                 by (auto simp add: validt_def valid_def)
               with Pre q
               show ?thesis
                 by auto
             next
               assume "\<Gamma> q = None"
               with q valid_body have False by auto
               thus ?thesis ..
             qed
           next
             fix s
             assume Pre: "s \<in> P' \<inter> {s. ((s,q), \<tau>,p) \<in> r}"
             from Pre q \<tau>p
             have valid_bdy:
               "\<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s} \<inter> P') (the (\<Gamma> q)) Q',A'"
               by - (rule WF.hyps, auto)
             from Pre q
             have Pre': "s \<in> {s} \<inter> P'"
               by auto
             from valid_bdy ctxt Pre'
             have "\<Gamma>\<turnstile>the (\<Gamma> q) \<down> Normal s"
               by (auto simp add: validt_def)
             with valid_body q
             show "\<Gamma>\<turnstile>Call q\<down> Normal s"
               by (fastforce intro: terminates.Call)
           qed
         }
         hence "\<forall>(P, p, Q, A)\<in>Specs_wf p \<tau>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Call p Q,A"
           by (auto simp add: cvalidt_def Specs_wf)
         with ctxt have "\<forall>(P, p, Q, A)\<in>\<Theta> \<union> Specs_wf p \<tau>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Call p Q,A"
           by auto
         with p valid_body
         show "\<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A"
           by (simp add: cvalidt_def) blast
       qed
     }
     note lem = this
     have valid_body':
       "\<And>\<tau>. \<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A \<Longrightarrow>
       \<forall>(P,p,Q,A)\<in>Specs. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<tau>} \<inter> P) (the (\<Gamma> p)) Q,A"
       by (auto intro: lem)
     show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     proof (rule cvalidtI)
       fix s t
       assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
       assume exec_call: "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow> t"
       assume P: "s \<in> P"
       assume t_notin_F: "t \<notin> Fault ` F"
       from exec_call show "t \<in> Normal ` Q \<union> Abrupt ` A"
       proof (cases)
         fix bdy
         assume bdy: "\<Gamma> p = Some bdy"
         assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow> t"
         from exec_body bdy p P t_notin_F
           valid_body' [of "s", OF ctxt]
           ctxt
         have "t \<in> Normal ` Q \<union> Abrupt ` A"
           apply (simp only: cvalidt_def validt_def valid_def)
           apply (drule (1) bspec)
           apply auto
           done
         with p P
         show ?thesis
           by simp
       next
         assume "\<Gamma> p = None"
         with p valid_body have False by auto
         thus ?thesis by simp
       qed
     next
       fix s
       assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
       assume P: "s \<in> P"
       show "\<Gamma>\<turnstile>Call p \<down> Normal s"
       proof -
         from ctxt P p valid_body' [of "s",OF ctxt]
         have "\<Gamma>\<turnstile>(the (\<Gamma> p)) \<down> Normal s"
           by (auto simp add: cvalidt_def validt_def)
         with valid_body p show ?thesis
           by (fastforce intro: terminates.Call)
       qed
     qed
   qed
 next
   case (DynCom P \<Theta> F c Q A)
   hence valid_c: "\<forall>s\<in>P. \<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (c s) Q,A" by simp
   show "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P DynCom c Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     from exec show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof (cases)
       assume "\<Gamma>\<turnstile>\<langle>c s,Normal s\<rangle> \<Rightarrow> t"
       from cvalidt_postD [OF valid_c [rule_format, OF P] ctxt this P t_notin_F]
       show ?thesis .
     qed
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P: "s \<in> P"
     show "\<Gamma>\<turnstile>DynCom c \<down> Normal s"
     proof -
       from cvalidt_termD [OF valid_c [rule_format, OF P] ctxt P]
       have "\<Gamma>\<turnstile>c s \<down> Normal s" .
       thus ?thesis
         by (rule terminates.intros)
     qed
   qed
 next
   case (Throw \<Theta> F A Q)
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> A Throw Q,A"
   proof (rule cvalidtI)
     fix s t
     assume "\<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow> t" "s \<in> A"
     then show "t \<in> Normal ` Q \<union> Abrupt ` A"
       by cases simp
   next
     fix s
     show "\<Gamma>\<turnstile>Throw \<down> Normal s"
       by (rule terminates.intros)
   qed
 next
   case (Catch \<Theta> F P c\<^sub>1 Q R c\<^sub>2 A)
   have valid_c1: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,R" by fact
   have valid_c2: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> R c\<^sub>2 Q,A" by fact
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P Catch c\<^sub>1 c\<^sub>2 Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     from exec show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof (cases)
       fix s'
       assume exec_c1: "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> Abrupt s'"
       assume exec_c2: "\<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s'\<rangle> \<Rightarrow> t"
       from cvalidt_postD [OF valid_c1 ctxt exec_c1 P]
       have "Abrupt s' \<in> Abrupt ` R"
         by auto
       with cvalidt_postD [OF valid_c2 ctxt] exec_c2 t_notin_F
       show ?thesis
         by fastforce
     next
       assume exec_c1: "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> t"
       assume notAbr: "\<not> isAbr t"
       from cvalidt_postD [OF valid_c1 ctxt exec_c1 P] t_notin_F
       have "t \<in> Normal ` Q \<union> Abrupt ` R" .
       with notAbr
       show ?thesis
         by auto
     qed
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P: "s \<in> P"
     show "\<Gamma>\<turnstile>Catch c\<^sub>1 c\<^sub>2 \<down> Normal s"
     proof -
       from valid_c1 ctxt P
       have "\<Gamma>\<turnstile>c\<^sub>1\<down> Normal s"
         by (rule cvalidt_termD)
       moreover
       {
         fix r assume exec_c1: "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> Abrupt r"
         from cvalidt_postD [OF valid_c1 ctxt exec_c1 P]
         have r: "Abrupt r\<in>Normal ` Q \<union> Abrupt ` R"
           by auto
         hence "Abrupt r\<in>Abrupt ` R" by fast
         with cvalidt_termD [OF valid_c2 ctxt] exec_c1
         have "\<Gamma>\<turnstile>c\<^sub>2 \<down> Normal r"
           by fast
       }
       ultimately show ?thesis
         by (iprover intro: terminates.intros)
     qed
   qed
 next
   case (Conseq P \<Theta> F c Q A)
   hence adapt:
     "\<forall>s \<in> P. (\<exists>P' Q' A'. (\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A') \<and> s \<in> P'\<and> Q' \<subseteq> Q \<and> A' \<subseteq> A)" by blast
   show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   proof (rule cvalidtI)
     fix s t
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
     assume P: "s \<in> P"
     assume t_notin_F: "t \<notin> Fault ` F"
     show "t \<in> Normal ` Q \<union> Abrupt ` A"
     proof -
       from adapt [rule_format, OF P]
       obtain P' and Q' and A' where
         valid_P'_Q': "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A'"
         and weaken: "s \<in> P'" "Q' \<subseteq>  Q" "A'\<subseteq> A"
         by blast
       from exec valid_P'_Q' ctxt t_notin_F
       have P'_Q': "Normal s \<in> Normal ` P' \<longrightarrow>
         t \<in> Normal ` Q' \<union> Abrupt ` A'"
         by (unfold cvalidt_def validt_def valid_def) blast
       hence "s \<in> P' \<longrightarrow> t \<in> Normal ` Q' \<union> Abrupt ` A'"
         by blast
       with weaken
       show ?thesis
         by blast
     qed
   next
     fix s
     assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     assume P: "s \<in> P"
     show "\<Gamma>\<turnstile>c \<down> Normal s"
     proof -
       from P adapt
       obtain P' and Q' and  A' where
         "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P' c Q',A'"
         "s \<in> P'"
         by blast
       with ctxt
       show ?thesis
         by (simp add: cvalidt_def validt_def)
     qed
   qed
 next
   case (Asm P p Q A \<Theta> F)
   assume "(P, p, Q, A) \<in> \<Theta>"
   then show "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto simp add: cvalidt_def )
 next
   case ExFalso thus ?case by iprover
 qed
 
 lemma hoaret_sound':
 "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   apply (drule hoaret_sound)
   apply (simp add: cvalidt_def)
   done
 
 theorem total_to_partial:
  assumes total: "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A" shows "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
 proof -
   from total have "\<Gamma>,{}\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
     by (rule hoaret_sound)
   hence "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
     by (simp add: cvalidt_def validt_def cvalid_def)
   thus ?thesis
     by (rule hoare_complete)
 qed
 
 subsection \<open>Completeness\<close>
 
 lemma MGT_valid:
 "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F \<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and> \<Gamma>\<turnstile>c\<down>Normal s} c
     {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t}, {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof (rule validtI)
   fix s t
   assume "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
          "s \<in> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and> \<Gamma>\<turnstile>c\<down>Normal s}"
          "t \<notin> Fault ` F"
   thus "t \<in> Normal ` {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t} \<union>
             Abrupt ` {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (cases t)
     apply (auto simp add: final_notin_def)
     done
 next
   fix s
   assume "s \<in> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and> \<Gamma>\<turnstile>c\<down>Normal s}"
   thus "\<Gamma>\<turnstile>c\<down>Normal s"
     by blast
 qed
 
 text \<open>The consequence rule where the existential @{term Z} is instantiated
 to @{term s}. Usefull in proof of \<open>MGT_lemma\<close>.\<close>
 lemma ConseqMGT:
   assumes modif: "\<forall>Z::'a. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P' Z::'a assn) c (Q' Z),(A' Z)"
   assumes impl: "\<And>s. s \<in> P \<Longrightarrow> s \<in> P' s \<and> (\<forall>t. t \<in> Q' s \<longrightarrow> t \<in> Q) \<and>
                                             (\<forall>t. t \<in> A' s \<longrightarrow> t \<in> A)"
   shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 using impl
 by - (rule conseq [OF modif],blast)
 
 lemma MGT_implies_complete:
   assumes MGT: "\<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                  \<Gamma>\<turnstile>c\<down>Normal s}
                               c
                             {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                             {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   assumes valid: "\<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,{} \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   using MGT
   apply (rule ConseqMGT)
   apply (insert valid)
   apply (auto simp add: validt_def valid_def intro!: final_notinI)
   done
 
 lemma conseq_extract_state_indep_prop:
   assumes state_indep_prop:"\<forall>s \<in> P. R"
   assumes to_show: "R \<Longrightarrow> \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   apply (rule Conseq)
   apply (clarify)
   apply (rule_tac x="P" in exI)
   apply (rule_tac x="Q" in exI)
   apply (rule_tac x="A" in exI)
   using state_indep_prop to_show
   by blast
 
 lemma MGT_lemma:
   assumes MGT_Calls:
     "\<forall>p \<in> dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
        {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
            \<Gamma>\<turnstile>(Call p)\<down>Normal s}
              (Call p)
        {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
        {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   shows "\<And>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                           \<Gamma>\<turnstile>c\<down>Normal s}
                c
              {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof (induct c)
   case Skip
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>Skip \<down> Normal s}
                Skip
             {t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Skip [THEN conseqPre])
        (auto elim: exec_elim_cases simp add: final_notin_def
              intro: exec.intros terminates.intros)
 next
   case (Basic f)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Basic f \<down> Normal s}
                 Basic f
               {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Basic [THEN conseqPre])
        (auto elim: exec_elim_cases simp add: final_notin_def
              intro: exec.intros terminates.intros)
 next
   case (Spec r)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Spec r \<down> Normal s}
                 Spec r
               {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (rule hoaret.Spec [THEN conseqPre])
     apply (clarsimp simp add: final_notin_def)
     apply (case_tac "\<exists>t. (Z,t) \<in> r")
     apply (auto elim: exec_elim_cases simp add: final_notin_def intro: exec.intros)
     done
 next
   case (Seq c1 c2)
   have hyp_c1: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                 \<Gamma>\<turnstile>c1\<down>Normal s}
                             c1
                            {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                            {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   have hyp_c2: "\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                  \<Gamma>\<turnstile>c2\<down>Normal s}
                               c2
                             {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                             {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   from hyp_c1
   have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                 \<Gamma>\<turnstile>Seq c1 c2\<down>Normal s} c1
     {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t \<and> \<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
         \<Gamma>\<turnstile>c2\<down>Normal t},
     {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (auto dest: Seq_NoFaultStuckD1 [simplified] Seq_NoFaultStuckD2 [simplified]
              elim: terminates_Normal_elim_cases
              intro: exec.intros)
   thus "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Seq c1 c2\<down>Normal s}
                 Seq c1 c2
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule hoaret.Seq )
     show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t \<and>
                     \<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and> \<Gamma>\<turnstile>c2 \<down> Normal t}
                  c2
                 {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF hyp_c2],safe)
       fix r t
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal r" "\<Gamma>\<turnstile>\<langle>c2,Normal r\<rangle> \<Rightarrow> Normal t"
       then show "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t"
         by (rule exec.intros)
     next
       fix r t
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal r" "\<Gamma>\<turnstile>\<langle>c2,Normal r\<rangle> \<Rightarrow> Abrupt t"
       then show "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
         by (rule exec.intros)
     qed
   qed
 next
   case (Cond b c1 c2)
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                          \<Gamma>\<turnstile>c1\<down>Normal s}
                      c1
                    {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                    {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   hence "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>(Cond b c1 c2)\<down>Normal s}\<inter>b)
                 c1
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (fastforce simp add: final_notin_def intro: exec.CondTrue
                  elim: terminates_Normal_elim_cases)
   moreover
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                \<Gamma>\<turnstile>c2\<down>Normal s}
                       c2
                     {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                     {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>(Cond b c1 c2)\<down>Normal s}\<inter>-b)
                 c2
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT)
        (fastforce simp add: final_notin_def intro: exec.CondFalse
                  elim: terminates_Normal_elim_cases)
   ultimately
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                \<Gamma>\<turnstile>(Cond b c1 c2)\<down>Normal s}
                (Cond b c1 c2)
               {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Cond)
 next
   case (While b c)
   let ?unroll = "({(s,t). s\<in>b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t})\<^sup>*"
   let ?P' = "\<lambda>Z. {t. (Z,t)\<in>?unroll \<and>
                     (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                          \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                              (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                     \<Gamma>\<turnstile>(While b c)\<down>Normal t}"
   let ?A = "\<lambda>Z. {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   let ?r = "{(t,s). \<Gamma>\<turnstile>(While b c)\<down>Normal s \<and> s\<in>b \<and>
                     \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>(While b c)\<down>Normal s}
               (While b c)
               {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [where ?P'="\<lambda> Z. ?P' Z"
                          and ?Q'="\<lambda> Z. ?P' Z \<inter> - b"])
     have wf_r: "wf ?r" by (rule wf_terminates_while)
     show "\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (?P' Z) (While b c) (?P' Z \<inter> - b),(?A Z)"
     proof (rule allI, rule hoaret.While [OF wf_r])
       fix Z
       from While
       have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                   \<Gamma>\<turnstile>c\<down>Normal s}
                                 c
                               {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                               {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}" by iprover
       show "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> ?P' Z  \<inter> b) c
                        ({t. (t, \<sigma>) \<in> ?r} \<inter> ?P' Z),(?A Z)"
       proof (rule allI, rule ConseqMGT [OF hyp_c])
         fix \<sigma> s
         assume  "s\<in> {\<sigma>} \<inter>
                    {t. (Z, t) \<in> ?unroll \<and>
                       (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                       \<Gamma>\<turnstile>(While b c)\<down>Normal t}
                    \<inter> b"
         then obtain
           s_eq_\<sigma>: "s=\<sigma>" and
           Z_s_unroll: "(Z,s) \<in> ?unroll" and
           noabort:"\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" and
           while_term:  "\<Gamma>\<turnstile>(While b c)\<down>Normal s" and
           s_in_b: "s\<in>b"
           by blast
         show "s \<in> {t. t = s \<and> \<Gamma>\<turnstile>\<langle>c,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>c\<down>Normal t} \<and>
         (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t} \<longrightarrow>
              t \<in> {t. (t,\<sigma>) \<in> ?r} \<inter>
                  {t. (Z, t) \<in> ?unroll \<and>
                      (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow>  e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                               (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                       \<Gamma>\<turnstile>(While b c)\<down>Normal t})  \<and>
          (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t} \<longrightarrow>
              t \<in> {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t})"
           (is "?C1 \<and> ?C2 \<and> ?C3")
         proof (intro conjI)
           from Z_s_unroll noabort s_in_b while_term show ?C1
             by (blast elim: terminates_Normal_elim_cases)
         next
           {
             fix t
             assume s_t: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t"
             with s_eq_\<sigma> while_term s_in_b have "(t,\<sigma>) \<in> ?r"
               by blast
             moreover
             from Z_s_unroll s_t s_in_b
             have "(Z, t) \<in> ?unroll"
               by (blast intro: rtrancl_into_rtrancl)
             moreover from while_term s_t s_in_b
             have "\<Gamma>\<turnstile>(While b c)\<down>Normal t"
               by (blast elim: terminates_Normal_elim_cases)
             moreover note noabort
             ultimately
             have "(t,\<sigma>) \<in> ?r \<and> (Z, t) \<in> ?unroll \<and>
                   (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                   \<Gamma>\<turnstile>(While b c)\<down>Normal t"
               by iprover
           }
           then show ?C2 by blast
         next
           {
             fix t
             assume s_t:  "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t"
             from Z_s_unroll noabort s_t s_in_b
             have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
               by blast
           } thus ?C3 by simp
         qed
       qed
     qed
   next
     fix s
     assume P: "s \<in> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>While b c \<down> Normal s}"
     hence WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by auto
     show "s \<in> ?P' s \<and>
      (\<forall>t. t\<in>(?P' s \<inter> - b)\<longrightarrow>
           t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t})\<and>
      (\<forall>t. t\<in>?A s \<longrightarrow> t\<in>?A Z)"
     proof (intro conjI)
       {
         fix e
         assume "(Z,e) \<in> ?unroll" "e \<in> b"
         from this WhileNoFault
         have "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" (is "?Prop Z e")
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           assume e_in_b: "e \<in> b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           with e_in_b WhileNoFault
           have cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           moreover
           {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with e_in_b have "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           ultimately
           show "?Prop e e"
             by iprover
         next
           fix Z r
           assume e_in_b: "e\<in>b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           assume hyp: "\<lbrakk>e\<in>b;\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))\<rbrakk>
                        \<Longrightarrow> ?Prop r e"
           assume Z_r:
             "(Z, r) \<in> {(Z, r). Z \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r}"
           with WhileNoFault
           have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           from hyp [OF e_in_b this] obtain
             cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))" and
             Abrupt_r: "\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u \<longrightarrow>
                             \<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u"
             by simp
 
            {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with Abrupt_r have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u" by simp
             moreover from  Z_r obtain
               "Z \<in> b"  "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by simp
             ultimately have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           with cNoFault show "?Prop Z e"
             by iprover
         qed
       }
       with P show "s \<in> ?P' s"
         by blast
     next
       {
         fix t
         assume "termination": "t \<notin> b"
         assume "(Z, t) \<in> ?unroll"
         hence "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           from "termination"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal t\<rangle> \<Rightarrow> Normal t"
             by (blast intro: exec.WhileFalse)
         next
           fix Z r
           assume first_body:
                  "(Z, r) \<in> {(s, t). s \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
           assume "(r, t) \<in> ?unroll"
           assume rest_loop: "\<Gamma>\<turnstile>\<langle>While b c, Normal r\<rangle> \<Rightarrow> Normal t"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
           proof -
             from first_body obtain
               "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by fast
             moreover
             from rest_loop have
               "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Normal t"
               by fast
             ultimately show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
               by (rule exec.WhileTrue)
           qed
         qed
       }
       with P
       show "(\<forall>t. t\<in>(?P' s \<inter> - b)
             \<longrightarrow>t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t})"
         by blast
     next
       from P show "\<forall>t. t\<in>?A s \<longrightarrow> t\<in>?A Z"
         by simp
     qed
   qed
 next
   case (Call p)
   from noStuck_Call
   have "\<forall>s \<in> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                          \<Gamma>\<turnstile>Call p\<down> Normal s}.
           p \<in> dom \<Gamma>"
     by (fastforce simp add: final_notin_def)
   then show ?case
   proof (rule conseq_extract_state_indep_prop)
     assume p_defined: "p \<in> dom \<Gamma>"
     with MGT_Calls show
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>{s. s=Z \<and>
                  \<Gamma>\<turnstile>\<langle>Call p ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))\<and>
                  \<Gamma>\<turnstile>Call  p\<down>Normal s}
                 (Call p)
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (auto)
   qed
 next
   case (DynCom c)
   have hyp:
     "\<And>s'. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c s',Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>c s'\<down>Normal s} c s'
       {t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using DynCom by simp
   have hyp':
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>{s. s = Z \<and> \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
             \<Gamma>\<turnstile>DynCom c\<down>Normal s}
          (c Z)
         {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT [OF hyp])
        (fastforce simp add: final_notin_def intro: exec.intros
           elim: terminates_Normal_elim_cases)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>DynCom c\<down>Normal s}
                 DynCom c
              {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (rule hoaret.DynCom)
     apply (clarsimp)
     apply (rule hyp' [simplified])
     done
 next
   case (Guard f g c)
   have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                               \<Gamma>\<turnstile>c\<down>Normal s}
                      c
                    {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
                    {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Guard by iprover
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Guard f g c\<down> Normal s}
                 Guard f g c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (cases "f \<in> F")
     case True
     from hyp_c
     have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>(g \<inter> {s. s=Z \<and>
                      \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck}\<union> Fault ` (-F))\<and>
                      \<Gamma>\<turnstile>Guard f g c\<down> Normal s})
                    c
                  {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       apply (rule ConseqMGT)
       apply (insert True)
       apply  (auto simp add: final_notin_def intro: exec.intros
                    elim: terminates_Normal_elim_cases)
       done
     from True this
     show ?thesis
       by (rule conseqPre [OF Guarantee]) auto
   next
     case False
     from hyp_c
     have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F \<^esub>(g \<inter> {s. s \<in> g \<and> s=Z \<and>
                      \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck}\<union> Fault ` (-F))\<and>
                      \<Gamma>\<turnstile>Guard f g c\<down> Normal s} )
                    c
                  {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>Guard f g c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       apply (rule ConseqMGT)
       apply clarify
       apply (frule Guard_noFaultStuckD [OF _ False])
       apply  (auto simp add: final_notin_def intro: exec.intros
                    elim: terminates_Normal_elim_cases)
       done
     then show ?thesis
       apply (rule conseqPre [OF hoaret.Guard])
       apply clarify
       apply (frule Guard_noFaultStuckD [OF _ False])
       apply auto
       done
   qed
 next
   case Throw
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Throw \<down> Normal s}
               Throw
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule conseqPre [OF hoaret.Throw])
        (blast intro: exec.intros terminates.intros)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                         \<Gamma>\<turnstile>c\<^sub>1 \<down> Normal s}
                     c\<^sub>1
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>Catch c\<^sub>1 c\<^sub>2 \<down> Normal s}
                 c\<^sub>1
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t \<and> \<Gamma>\<turnstile>c\<^sub>2 \<down> Normal t \<and>
                    \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}"
     by (rule ConseqMGT)
        (fastforce intro: exec.intros terminates.intros
                  elim: terminates_Normal_elim_cases
                  simp add: final_notin_def)
   moreover
   have
     "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s} c\<^sub>2
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   hence "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow>Abrupt s \<and> \<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s \<and>
                    \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))}
                c\<^sub>2
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (rule ConseqMGT)
          (fastforce intro: exec.intros terminates.intros
                    simp add: noFault_def')
   ultimately
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>Catch c\<^sub>1 c\<^sub>2 \<down> Normal s}
                 Catch c\<^sub>1 c\<^sub>2
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Catch )
 qed
 
 
 lemma Call_lemma':
  assumes Call_hyp:
  "\<forall>q\<in>dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
  shows "\<And>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
       {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and> \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c \<in> redexes c')}
               c
       {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
       {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof (induct c)
   case Skip
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> Skip \<in> redexes c')}
                Skip
               {t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Skip,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Skip [THEN conseqPre]) (blast intro: exec.Skip)
 next
   case (Basic f)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                       Basic f \<in> redexes c')}
                Basic f
               {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Basic f,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Basic [THEN conseqPre]) (blast intro: exec.Basic)
 next
   case (Spec r)
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                  Spec r \<in> redexes c')}
                Spec r
               {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Spec r,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     apply (rule hoaret.Spec [THEN conseqPre])
     apply (clarsimp)
     apply (case_tac "\<exists>t. (Z,t) \<in> r")
     apply (auto elim: exec_elim_cases simp add: final_notin_def intro: exec.intros)
     done
 next
   case (Seq c1 c2)
   have hyp_c1:
     "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                  (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c1 \<in> redexes c')}
                 c1
                {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps by iprover
   have hyp_c2:
     "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                  (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c2 \<in> redexes c')}
                 c2
                {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Seq.hyps (2) by iprover
   have c1: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
               (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                     Seq c1 c2 \<in> redexes c')}
                c1
                {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t \<and>
                    \<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                    \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                   (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal t) \<and>
                         c2 \<in> redexes c')},
                {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp_c1],clarify,safe)
     assume "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (blast dest: Seq_NoFaultStuckD1)
   next
     fix c'
     assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume red: "Seq c1 c2 \<in> redexes c'"
     from redexes_subset [OF red] steps_c'
     show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c1 \<in> redexes c'"
       by (auto iff: root_in_redexes)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (blast dest: Seq_NoFaultStuckD2)
   next
     fix c' t
     assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume red: "Seq c1 c2 \<in> redexes c'"
     assume exec_c1: "\<Gamma>\<turnstile> \<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t"
     show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal t) \<and> c2 \<in> redexes c'"
     proof -
       note steps_c'
       also
       from exec_impl_steps_Normal [OF exec_c1]
       have "\<Gamma>\<turnstile> (c1, Normal Z) \<rightarrow>\<^sup>* (Skip, Normal t)".
       from steps_redexes_Seq [OF this red]
       obtain c'' where
         steps_c'': "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow>\<^sup>* (c'', Normal t)" and
         Skip: "Seq Skip c2 \<in> redexes c''"
         by blast
       note steps_c''
       also
       have step_Skip: "\<Gamma>\<turnstile> (Seq Skip c2,Normal t) \<rightarrow> (c2,Normal t)"
         by (rule step.SeqSkip)
       from step_redexes [OF step_Skip Skip]
       obtain c''' where
         step_c''': "\<Gamma>\<turnstile> (c'', Normal t) \<rightarrow> (c''', Normal t)" and
         c2: "c2 \<in> redexes c'''"
         by blast
       note step_c'''
       finally show ?thesis
         using c2
         by blast
     qed
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (blast intro: exec.intros)
   qed
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
               (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> Seq c1 c2 \<in> redexes c')}
               Seq c1 c2
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Seq [OF c1 ConseqMGT [OF hyp_c2]])
        (blast intro: exec.intros)
 next
   case (Cond b c1 c2)
   have hyp_c1:
        "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                         \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                     (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c1 \<in> redexes c')}
                    c1
                   {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   have
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
            \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
            (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                  Cond b c1 c2 \<in> redexes c')}
            \<inter> b)
            c1
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp_c1],safe)
     assume "Z \<in> b" "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (auto simp add: final_notin_def intro: exec.CondTrue)
   next
     fix c'
     assume b: "Z \<in> b"
     assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume redex_c': "Cond b c1 c2 \<in> redexes c'"
     show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c1 \<in> redexes c'"
     proof -
       note steps_c'
       also
       from b
       have "\<Gamma>\<turnstile>(Cond b c1 c2, Normal Z) \<rightarrow> (c1, Normal Z)"
         by (rule step.CondTrue)
       from step_redexes [OF this redex_c'] obtain c'' where
         step_c'': "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow> (c'', Normal Z)" and
         c1: "c1 \<in> redexes c''"
         by blast
       note step_c''
       finally show ?thesis
         using c1
         by blast
     qed
   next
     fix t assume "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (blast intro: exec.CondTrue)
   next
     fix t assume "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (blast intro: exec.CondTrue)
   qed
   moreover
   have hyp_c2:
        "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                     (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c2 \<in> redexes c')}
                    c2
                   {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t},
                   {t. \<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Cond.hyps by iprover
   have
   "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
            (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal s) \<and>
                  Cond b c1 c2 \<in> redexes c')}
            \<inter> -b)
            c2
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp_c2],safe)
     assume "Z \<notin> b" "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (auto simp add: final_notin_def intro: exec.CondFalse)
   next
     fix c'
     assume b: "Z \<notin> b"
     assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume redex_c': "Cond b c1 c2 \<in> redexes c'"
     show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c2 \<in> redexes c'"
     proof -
       note steps_c'
       also
       from b
       have "\<Gamma>\<turnstile>(Cond b c1 c2, Normal Z) \<rightarrow> (c2, Normal Z)"
         by (rule step.CondFalse)
       from step_redexes [OF this redex_c'] obtain c'' where
         step_c'': "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow> (c'', Normal Z)" and
         c1: "c2 \<in> redexes c''"
         by blast
       note step_c''
       finally show ?thesis
         using c1
         by blast
     qed
   next
     fix t assume "Z \<notin> b" "\<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (blast intro: exec.CondFalse)
   next
     fix t assume "Z \<notin> b" "\<Gamma>\<turnstile>\<langle>c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (blast intro: exec.CondFalse)
   qed
   ultimately
   show
    "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
            (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                  Cond b c1 c2 \<in> redexes c')}
            (Cond b c1 c2)
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule hoaret.Cond)
 next
   case (While b c)
   let ?unroll = "({(s,t). s\<in>b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t})\<^sup>*"
   let ?P' = "\<lambda>Z. {t. (Z,t)\<in>?unroll \<and>
                     (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                          \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                              (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                     \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                   (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+
                                (c',Normal t) \<and> While b c \<in> redexes c')}"
   let ?A = "\<lambda>Z. {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   let ?r = "{(t,s). \<Gamma>\<turnstile>(While b c)\<down>Normal s \<and> s\<in>b \<and>
                     \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
        {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
           (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>)\<rightarrow>\<^sup>+(c',Normal s) \<and> While b c \<in> redexes c')}
          (While b c)
        {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t},
        {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [where ?P'="\<lambda> Z. ?P' Z"
                          and ?Q'="\<lambda> Z. ?P' Z \<inter> - b"])
     have wf_r: "wf ?r" by (rule wf_terminates_while)
     show "\<forall> Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (?P' Z) (While b c) (?P' Z \<inter> - b),(?A Z)"
     proof (rule allI, rule hoaret.While [OF wf_r])
       fix Z
       from While
       have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
             {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                 \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c \<in> redexes c')}
               c
             {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
             {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}" by iprover
       show "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ({\<sigma>} \<inter> ?P' Z  \<inter> b) c
                        ({t. (t, \<sigma>) \<in> ?r} \<inter> ?P' Z),(?A Z)"
       proof (rule allI, rule ConseqMGT [OF hyp_c])
         fix \<tau> s
         assume  asm: "s\<in> {\<tau>} \<inter>
                    {t. (Z, t) \<in> ?unroll \<and>
                       (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                      \<Gamma>\<turnstile>Call p\<down> Normal \<sigma> \<and>
                      (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+
                                   (c',Normal t) \<and> While b c \<in> redexes c')}
                    \<inter> b"
         then obtain c' where
           s_eq_\<tau>: "s=\<tau>" and
           Z_s_unroll: "(Z,s) \<in> ?unroll" and
           noabort:"\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" and
           termi:  "\<Gamma>\<turnstile>Call p \<down> Normal \<sigma>" and
           reach: "\<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s)" and
           red_c': "While b c \<in> redexes c'" and
           s_in_b: "s\<in>b"
           by blast
         obtain c'' where
           reach_c: "\<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c'',Normal s)"
                    "Seq c (While b c) \<in> redexes c''"
         proof -
           note reach
           also from s_in_b
           have "\<Gamma>\<turnstile>(While b c,Normal s) \<rightarrow> (Seq c (While b c),Normal s)"
             by (rule step.WhileTrue)
           from step_redexes [OF this red_c'] obtain c'' where
             step: "\<Gamma>\<turnstile> (c', Normal s) \<rightarrow> (c'', Normal s)" and
             red_c'': "Seq c (While b c) \<in> redexes c''"
             by blast
           note step
           finally
           show ?thesis
             using red_c''
             by (blast intro: that)
         qed
         from reach termi
         have "\<Gamma>\<turnstile>c' \<down> Normal s"
           by (rule steps_preserves_termination')
         from redexes_preserves_termination [OF this red_c']
         have termi_while: "\<Gamma>\<turnstile>While b c \<down> Normal s" .
         show "s \<in> {t. t = s \<and> \<Gamma>\<turnstile>\<langle>c,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                       \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                    (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal t) \<and> c \<in> redexes c')} \<and>
         (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t} \<longrightarrow>
              t \<in> {t. (t,\<tau>) \<in> ?r} \<inter>
                  {t. (Z, t) \<in> ?unroll \<and>
                      (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow>  e\<in>b
                            \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                               (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                       \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                     (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal t) \<and>
                           While b c \<in> redexes c')}) \<and>
          (\<forall>t. t \<in> {t. \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t} \<longrightarrow>
              t \<in> {t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t})"
           (is "?C1 \<and> ?C2 \<and> ?C3")
         proof (intro conjI)
           from Z_s_unroll noabort s_in_b termi reach_c show ?C1
             apply clarsimp
             apply (drule redexes_subset)
             apply simp
             apply (blast intro: root_in_redexes)
             done
         next
           {
             fix t
             assume s_t: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t"
             with s_eq_\<tau> termi_while s_in_b have "(t,\<tau>) \<in> ?r"
               by blast
             moreover
             from Z_s_unroll s_t s_in_b
             have "(Z, t) \<in> ?unroll"
               by (blast intro: rtrancl_into_rtrancl)
             moreover
             obtain c'' where
               reach_c'': "\<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c'',Normal t)"
                         "(While b c) \<in> redexes c''"
             proof -
               note reach_c (1)
               also from s_in_b
               have "\<Gamma>\<turnstile>(While b c,Normal s)\<rightarrow> (Seq c (While b c),Normal s)"
                 by (rule step.WhileTrue)
               have "\<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow>\<^sup>+
                         (While b c, Normal t)"
               proof -
                 from exec_impl_steps_Normal [OF s_t]
                 have "\<Gamma>\<turnstile> (c, Normal s) \<rightarrow>\<^sup>* (Skip, Normal t)".
                 hence "\<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow>\<^sup>*
                           (Seq Skip (While b c), Normal t)"
                   by (rule SeqSteps) auto
                 moreover
                 have "\<Gamma>\<turnstile>(Seq Skip (While b c), Normal t)\<rightarrow>(While b c, Normal t)"
                   by (rule step.SeqSkip)
                 ultimately show ?thesis by (rule rtranclp_into_tranclp1)
               qed
               from steps_redexes' [OF this reach_c (2)]
               obtain c''' where
                 step: "\<Gamma>\<turnstile> (c'', Normal s) \<rightarrow>\<^sup>+ (c''', Normal t)" and
                 red_c'': "While b c \<in> redexes c'''"
                 by blast
               note step
               finally
               show ?thesis
                 using red_c''
                 by (blast intro: that)
             qed
             moreover note noabort termi
             ultimately
             have "(t,\<tau>) \<in> ?r \<and> (Z, t) \<in> ?unroll \<and>
                   (\<forall>e. (Z,e)\<in>?unroll \<longrightarrow> e\<in>b
                         \<longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                             (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                                   \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)) \<and>
                   \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                     (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal t) \<and>
                              While b c \<in> redexes c')"
               by iprover
           }
           then show ?C2 by blast
         next
           {
             fix t
             assume s_t:  "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t"
             from Z_s_unroll noabort s_t s_in_b
             have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
               by blast
           } thus ?C3 by simp
         qed
       qed
     qed
   next
     fix s
     assume P: "s \<in> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                        \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                    (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                          While b c \<in> redexes c')}"
     hence WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by auto
     show "s \<in> ?P' s \<and>
      (\<forall>t. t\<in>(?P' s \<inter> - b)\<longrightarrow>
           t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t})\<and>
      (\<forall>t. t\<in>?A s \<longrightarrow> t\<in>?A Z)"
     proof (intro conjI)
       {
         fix e
         assume "(Z,e) \<in> ?unroll" "e \<in> b"
         from this WhileNoFault
         have "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                (\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>Abrupt u \<longrightarrow>
                     \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u)" (is "?Prop Z e")
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           assume e_in_b: "e \<in> b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           with e_in_b WhileNoFault
           have cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           moreover
           {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with e_in_b have "\<Gamma>\<turnstile>\<langle>While b c,Normal e\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           ultimately
           show "?Prop e e"
             by iprover
         next
           fix Z r
           assume e_in_b: "e\<in>b"
           assume WhileNoFault: "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
           assume hyp: "\<lbrakk>e\<in>b;\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))\<rbrakk>
                        \<Longrightarrow> ?Prop r e"
           assume Z_r:
             "(Z, r) \<in> {(Z, r). Z \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r}"
           with WhileNoFault
           have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
             by (auto simp add: final_notin_def intro: exec.intros)
           from hyp [OF e_in_b this] obtain
             cNoFault: "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))" and
             Abrupt_r: "\<forall>u. \<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u \<longrightarrow>
                             \<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u"
             by simp
 
            {
             fix u assume "\<Gamma>\<turnstile>\<langle>c,Normal e\<rangle> \<Rightarrow> Abrupt u"
             with Abrupt_r have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Abrupt u" by simp
             moreover from  Z_r obtain
               "Z \<in> b"  "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by simp
             ultimately have "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Abrupt u"
               by (blast intro: exec.intros)
           }
           with cNoFault show "?Prop Z e"
             by iprover
         qed
       }
       with P show "s \<in> ?P' s"
         by blast
     next
       {
         fix t
         assume "termination": "t \<notin> b"
         assume "(Z, t) \<in> ?unroll"
         hence "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
         proof (induct rule: converse_rtrancl_induct [consumes 1])
           from "termination"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal t\<rangle> \<Rightarrow> Normal t"
             by (blast intro: exec.WhileFalse)
         next
           fix Z r
           assume first_body:
                  "(Z, r) \<in> {(s, t). s \<in> b \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal t}"
           assume "(r, t) \<in> ?unroll"
           assume rest_loop: "\<Gamma>\<turnstile>\<langle>While b c, Normal r\<rangle> \<Rightarrow> Normal t"
           show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
           proof -
             from first_body obtain
               "Z \<in> b" "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal r"
               by fast
             moreover
             from rest_loop have
               "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> \<Rightarrow> Normal t"
               by fast
             ultimately show "\<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t"
               by (rule exec.WhileTrue)
           qed
         qed
       }
       with P
       show "\<forall>t. t\<in>(?P' s \<inter> - b)
             \<longrightarrow>t\<in>{t. \<Gamma>\<turnstile>\<langle>While b c,Normal Z\<rangle> \<Rightarrow> Normal t}"
         by blast
     next
       from P show "\<forall>t. t\<in>?A s \<longrightarrow> t\<in>?A Z"
         by simp
     qed
   qed
 next
   case (Call q)
   let ?P = "{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
               (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> Call q \<in> redexes c')}"
   from noStuck_Call
   have "\<forall>s \<in> ?P. q \<in> dom \<Gamma>"
     by (fastforce simp add: final_notin_def)
   then show ?case
   proof (rule conseq_extract_state_indep_prop)
     assume q_defined: "q \<in> dom \<Gamma>"
     from Call_hyp have
       "\<forall>q\<in>dom \<Gamma>. \<forall>Z.
         \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>{s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                         \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (simp add: exec_Call_body' noFaultStuck_Call_body' [simplified]
          terminates_Normal_Call_body)
     from Call_hyp q_defined have Call_hyp':
     "\<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                   (Call q)
                  {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                  {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by auto
     show
      "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> ?P
            (Call q)
           {t. \<Gamma>\<turnstile>\<langle>Call q ,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call q ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF Call_hyp'],safe)
       fix c'
       assume termi: "\<Gamma>\<turnstile>Call p \<down> Normal \<sigma>"
       assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
       assume red_c': "Call q \<in> redexes c'"
       show "\<Gamma>\<turnstile>Call q \<down> Normal Z"
       proof -
         from steps_preserves_termination' [OF steps_c' termi]
         have "\<Gamma>\<turnstile>c' \<down> Normal Z" .
         from redexes_preserves_termination [OF this red_c']
         show ?thesis .
       qed
     next
       fix c'
       assume termi: "\<Gamma>\<turnstile>Call p \<down> Normal \<sigma>"
       assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
       assume red_c': "Call q \<in> redexes c'"
       from redex_redexes [OF this]
       have "redex c' = Call q"
         by auto
       with termi steps_c'
       show "((Z, q), \<sigma>, p) \<in> termi_call_steps \<Gamma>"
         by (auto simp add: termi_call_steps_def)
     qed
   qed
 next
   case (DynCom c)
   have hyp:
     "\<And>s'. \<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
       {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>c s',Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
             \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
           (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c s' \<in> redexes c')}
         (c s')
        {t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c s',Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using DynCom by simp
   have hyp':
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> DynCom c \<in> redexes c')}
         (c Z)
        {t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (rule ConseqMGT [OF hyp],safe)
     assume "\<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     then show "\<Gamma>\<turnstile>\<langle>c Z,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (fastforce simp add: final_notin_def intro: exec.intros)
   next
     fix c'
     assume steps: "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume c': "DynCom c \<in> redexes c'"
     have "\<Gamma>\<turnstile> (DynCom c, Normal Z) \<rightarrow> (c Z,Normal Z)"
       by (rule step.DynCom)
     from step_redexes [OF this c'] obtain c'' where
       step: "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow> (c'', Normal Z)"  and c'': "c Z \<in> redexes c''"
       by blast
     note steps also note step
     finally show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c Z \<in> redexes c'"
       using c'' by blast
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c Z,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (auto intro: exec.intros)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c Z,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>DynCom c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       by (auto intro: exec.intros)
   qed
   show ?case
     apply (rule hoaret.DynCom)
     apply safe
     apply (rule hyp')
     done
 next
   case (Guard f g c)
   have hyp_c: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub>
          {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
             (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c \<in> redexes c')}
           c
          {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t},
          {t. \<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Guard.hyps by iprover
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
             (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> Guard f g c \<in> redexes c')}
               Guard f g c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
   proof (cases "f \<in> F")
     case True
     have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> {s. s=Z \<and>
                      \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
             (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                   Guard f g c \<in> redexes c')})
               c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF hyp_c], safe)
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))" "Z\<in>g"
       thus "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         by (auto simp add: final_notin_def intro: exec.intros)
     next
       fix c'
       assume steps: "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
       assume c': "Guard f g c \<in> redexes c'"
       assume "Z \<in> g"
       from this have "\<Gamma>\<turnstile>(Guard f g c,Normal Z) \<rightarrow> (c,Normal Z)"
         by (rule step.Guard)
       from step_redexes [OF this c'] obtain c'' where
         step: "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow> (c'', Normal Z)"  and c'': "c \<in> redexes c''"
         by blast
       note steps also note step
       finally show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c \<in> redexes c'"
         using c'' by blast
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
              "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t" "Z \<in> g"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t"
         by (auto simp add: final_notin_def intro: exec.intros )
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
               "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t" "Z \<in> g"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t"
         by (auto simp add: final_notin_def intro: exec.intros )
     qed
     from True this show ?thesis
       by (rule conseqPre [OF Guarantee]) auto
   next
     case False
     have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (g \<inter> {s. s=Z \<and>
                      \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                  \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
             (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                   Guard f g c \<in> redexes c')})
               c
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     proof (rule ConseqMGT [OF hyp_c], safe)
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       thus "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         using False
         by (cases "Z\<in> g") (auto simp add: final_notin_def intro: exec.intros)
     next
       fix c'
       assume steps: "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
       assume c': "Guard f g c \<in> redexes c'"
 
       assume "Z \<in> g"
       from this have "\<Gamma>\<turnstile>(Guard f g c,Normal Z) \<rightarrow> (c,Normal Z)"
         by (rule step.Guard)
       from step_redexes [OF this c'] obtain c'' where
         step: "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow> (c'', Normal Z)"  and c'': "c \<in> redexes c''"
         by blast
       note steps also note step
       finally show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c \<in> redexes c'"
         using c'' by blast
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
         "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Normal t"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Normal t"
         using False
         by (cases "Z\<in> g") (auto simp add: final_notin_def intro: exec.intros )
     next
       fix t
       assume "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
              "\<Gamma>\<turnstile>\<langle>c,Normal Z\<rangle> \<Rightarrow> Abrupt t"
       thus "\<Gamma>\<turnstile>\<langle>Guard f g c ,Normal Z\<rangle> \<Rightarrow> Abrupt t"
         using False
         by (cases "Z\<in> g") (auto simp add: final_notin_def intro: exec.intros )
     qed
     then show ?thesis
       apply (rule conseqPre [OF hoaret.Guard])
       apply clarify
       apply (frule Guard_noFaultStuckD [OF _ False])
       apply auto
       done
   qed
 next
   case Throw
   show "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>Call p\<down>Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> Throw \<in> redexes c')}
               Throw
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Throw,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule conseqPre [OF hoaret.Throw])
        (blast intro: exec.intros terminates.intros)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have hyp_c1:
    "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s= Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and>
                       c\<^sub>1 \<in> redexes c')}
                c\<^sub>1
               {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   have hyp_c2:
    "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s= Z \<and> \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                      \<Gamma>\<turnstile>Call p\<down> Normal \<sigma> \<and>
                 (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal s) \<and> c\<^sub>2 \<in> redexes c')}
                c\<^sub>2
               {t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},{t. \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     using Catch.hyps by iprover
   have
     "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                \<Gamma>\<turnstile>Call p\<down> Normal \<sigma> \<and>
             (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>)\<rightarrow>\<^sup>+(c',Normal s) \<and>
                    Catch c\<^sub>1 c\<^sub>2 \<in> redexes c')}
             c\<^sub>1
            {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
            {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t \<and>
                \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault`(-F)) \<and> \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal t) \<and> c\<^sub>2 \<in> redexes c')}"
   proof (rule ConseqMGT [OF hyp_c1],clarify,safe)
     assume "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
     thus "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (fastforce simp add: final_notin_def intro: exec.intros)
   next
     fix c'
     assume steps: "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume c': "Catch c\<^sub>1 c\<^sub>2 \<in> redexes c'"
     from steps redexes_subset [OF this]
     show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z) \<and> c\<^sub>1 \<in> redexes c'"
       by (auto iff:  root_in_redexes)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Normal t"
     thus "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t"
       by (auto intro: exec.intros)
   next
     fix t
     assume "\<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     thus "\<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
       by (auto simp add: final_notin_def intro: exec.intros)
   next
     fix c' t
     assume steps_c': "\<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal Z)"
     assume red: "Catch c\<^sub>1 c\<^sub>2 \<in> redexes c'"
     assume exec_c\<^sub>1: "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t"
     show "\<exists>c'. \<Gamma>\<turnstile> (Call p, Normal \<sigma>) \<rightarrow>\<^sup>+ (c', Normal t) \<and> c\<^sub>2 \<in> redexes c'"
     proof -
       note steps_c'
       also
       from exec_impl_steps_Normal_Abrupt [OF exec_c\<^sub>1]
       have "\<Gamma>\<turnstile> (c\<^sub>1, Normal Z) \<rightarrow>\<^sup>* (Throw, Normal t)".
       from steps_redexes_Catch [OF this red]
       obtain c'' where
         steps_c'': "\<Gamma>\<turnstile> (c', Normal Z) \<rightarrow>\<^sup>* (c'', Normal t)" and
         Catch: "Catch Throw c\<^sub>2 \<in> redexes c''"
         by blast
       note steps_c''
       also
       have step_Catch: "\<Gamma>\<turnstile> (Catch Throw c\<^sub>2,Normal t) \<rightarrow> (c\<^sub>2,Normal t)"
         by (rule step.CatchThrow)
       from step_redexes [OF step_Catch Catch]
       obtain c''' where
         step_c''': "\<Gamma>\<turnstile> (c'', Normal t) \<rightarrow> (c''', Normal t)" and
         c2: "c\<^sub>2 \<in> redexes c'''"
         by blast
       note step_c'''
       finally show ?thesis
         using c2
         by blast
     qed
   qed
   moreover
   have "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> {t. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal Z\<rangle> \<Rightarrow> Abrupt t \<and>
                   \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>Call p \<down> Normal \<sigma> \<and>
                   (\<exists>c'. \<Gamma>\<turnstile>(Call p,Normal \<sigma>) \<rightarrow>\<^sup>+ (c',Normal t) \<and> c\<^sub>2 \<in> redexes c')}
                c\<^sub>2
               {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
     by (rule ConseqMGT [OF hyp_c2]) (fastforce intro: exec.intros)
   ultimately show ?case
     by (rule hoaret.Catch)
 qed
 
 
 text \<open>To prove a procedure implementation correct it suffices to assume
        only the procedure specifications of procedures that actually
        occur during evaluation of the body.
 \<close>
 
 lemma Call_lemma:
  assumes A:
  "\<forall>q \<in> dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
                  {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
  assumes pdef: "p \<in> dom \<Gamma>"
  shows "\<And>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
               ({\<sigma>} \<inter> {s. s=Z \<and>\<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                  \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal s})
                  the (\<Gamma> p)
               {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 apply (rule conseqPre)
 apply (rule Call_lemma' [OF A])
 using pdef
 apply (fastforce intro: terminates.intros tranclp.r_into_trancl [of "(step \<Gamma>)", OF step.Call] root_in_redexes)
 done
 
 lemma Call_lemma_switch_Call_body:
  assumes
  call: "\<forall>q \<in> dom \<Gamma>. \<forall>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
                  {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call q,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call q\<down>Normal s \<and> ((s,q),(\<sigma>,p)) \<in> termi_call_steps \<Gamma>}
                  (Call q)
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Normal t},
                 {t. \<Gamma>\<turnstile>\<langle>Call q,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
  assumes p_defined: "p \<in> dom \<Gamma>"
  shows "\<And>Z. \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
               ({\<sigma>} \<inter> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                                  \<Gamma>\<turnstile>Call p\<down>Normal s})
                  the (\<Gamma> p)
               {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
               {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 apply (simp only: exec_Call_body' [OF p_defined] noFaultStuck_Call_body' [OF p_defined] terminates_Normal_Call_body [OF p_defined])
 apply (rule conseqPre)
 apply (rule Call_lemma')
 apply (rule call)
 using p_defined
 apply (fastforce intro: terminates.intros tranclp.r_into_trancl [of "(step \<Gamma>)", OF step.Call]
 root_in_redexes)
 done
 
 lemma MGT_Call:
 "\<forall>p \<in> dom \<Gamma>. \<forall>Z.
   \<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
              \<Gamma>\<turnstile>(Call p)\<down>Normal s}
            (Call p)
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 apply (intro ballI allI)
 apply (rule CallRec' [where Procs="dom \<Gamma>" and
     P="\<lambda>p Z. {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                     \<Gamma>\<turnstile>Call p\<down>Normal s}" and
     Q="\<lambda>p Z. {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t}" and
     A="\<lambda>p Z. {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}" and
     r="termi_call_steps \<Gamma>"
     ])
 apply    simp
 apply   simp
 apply  (rule wf_termi_call_steps)
 apply (intro ballI allI)
 apply simp
 apply (rule Call_lemma_switch_Call_body [rule_format, simplified])
 apply  (rule hoaret.Asm)
 apply  fastforce
 apply assumption
 done
 
 
 lemma CollInt_iff: "{s. P s} \<inter> {s. Q s} = {s. P s \<and> Q s}"
   by auto
 
 lemma image_Un_conv: "f ` (\<Union>p\<in>dom \<Gamma>. \<Union>Z. {x p Z}) =  (\<Union>p\<in>dom \<Gamma>. \<Union>Z. {f (x p Z)})"
   by (auto iff: not_None_eq)
 
 
 text \<open>Another proof of \<open>MGT_Call\<close>, maybe a little more readable\<close>
 lemma
 "\<forall>p \<in> dom \<Gamma>. \<forall>Z.
   \<Gamma>,{} \<turnstile>\<^sub>t\<^bsub>/F\<^esub> {s. s=Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
              \<Gamma>\<turnstile>(Call p)\<down>Normal s}
            (Call p)
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
           {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
 proof -
   {
     fix p Z \<sigma>
     assume defined: "p \<in> dom \<Gamma>"
     define Specs where "Specs = (\<Union>p\<in>dom \<Gamma>. \<Union>Z.
             {({s. s=Z \<and>
               \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal s},
              p,
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t})})"
     define Specs_wf where "Specs_wf p \<sigma> = (\<lambda>(P,q,Q,A).
                        (P \<inter> {s. ((s,q),\<sigma>,p) \<in> termi_call_steps \<Gamma>}, q, Q, A)) ` Specs" for p \<sigma>
     have "\<Gamma>,Specs_wf p \<sigma>
             \<turnstile>\<^sub>t\<^bsub>/F\<^esub>({\<sigma>} \<inter>
                  {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>the (\<Gamma> p)\<down>Normal s})
                 (the (\<Gamma> p))
                {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       apply (rule Call_lemma [rule_format, OF _ defined])
       apply (rule hoaret.Asm)
       apply (clarsimp simp add: Specs_wf_def Specs_def image_Un_conv)
       apply (rule_tac x=q in bexI)
       apply (rule_tac x=Z in exI)
       apply (clarsimp simp add: CollInt_iff)
       apply auto
       done
     hence "\<Gamma>,Specs_wf p \<sigma>
             \<turnstile>\<^sub>t\<^bsub>/F\<^esub>({\<sigma>} \<inter>
                  {s. s = Z \<and> \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
                   \<Gamma>\<turnstile>Call p\<down>Normal s})
                 (the (\<Gamma> p))
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
                {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t}"
       by (simp only: exec_Call_body' [OF defined]
                    noFaultStuck_Call_body' [OF defined]
                   terminates_Normal_Call_body [OF defined])
   } note bdy=this
   show ?thesis
     apply (intro ballI allI)
     apply (rule hoaret.CallRec [where Specs="(\<Union>p\<in>dom \<Gamma>. \<Union>Z.
             {({s. s=Z \<and>
               \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) \<and>
               \<Gamma>\<turnstile>Call p\<down>Normal s},
              p,
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Normal t},
              {t. \<Gamma>\<turnstile>\<langle>Call p,Normal Z\<rangle> \<Rightarrow> Abrupt t})})",
              OF _ wf_termi_call_steps [of \<Gamma>] refl])
     apply fastforce
     apply clarify
     apply (rule conjI)
     apply  fastforce
     apply (rule allI)
     apply (simp (no_asm_use) only : Un_empty_left)
     apply (rule bdy)
     apply auto
     done
 qed
 
 
 theorem hoaret_complete: "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A \<Longrightarrow> \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   by (iprover intro: MGT_implies_complete MGT_lemma [OF MGT_Call])
 
 lemma hoaret_complete':
   assumes cvalid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows  "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof (cases "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A")
   case True
   hence "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
     by (rule hoaret_complete)
   thus "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
     by (rule hoaret_augment_context) simp
 next
   case False
   with cvalid
   show ?thesis
     by (rule ExFalso)
 qed
 
 subsection \<open>And Now: Some Useful Rules\<close>
 
 subsubsection \<open>Modify Return\<close>
 
-lemma ProcModifyReturn_sound:
-  assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P call init p return' c Q,A"
+lemma Proc_exnModifyReturn_sound:
+  assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P call_exn init p return' result_exn c Q,A"
   assumes valid_modif:
   "\<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
   assumes res_modif:
   "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
   assumes ret_modifAbr:
-  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
-  shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   hence "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto simp add: validt_def)
   then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults)
-  assume exec: "\<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow> t"
+  assume exec: "\<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from exec
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: exec_call_Normal_elim)
+  proof (cases rule: exec_call_exn_Normal_elim)
     fix bdy t'
     assume bdy: "\<Gamma> p = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
     assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
     from exec_body bdy
     have "\<Gamma>\<turnstile>\<langle>(Call p ),Normal (init s)\<rangle> \<Rightarrow> Normal t'"
       by (auto simp add: intro: exec.intros)
     from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
     have "t' \<in> Modif (init s)"
       by auto
     with res_modif have "Normal (return' s t') = Normal (return s t')"
       by simp
     with exec_body exec_c bdy
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_call)
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exn)
     from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
     show ?thesis
       by simp
   next
     fix bdy t'
     assume bdy: "\<Gamma> p = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-    assume t: "t = Abrupt (return s t')"
+    assume t: "t = Abrupt (result_exn (return s t') t')"
     also from exec_body bdy
     have "\<Gamma>\<turnstile>\<langle>(Call p),Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
       by (auto simp add: intro: exec.intros)
     from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
     have "t' \<in> ModifAbr (init s)"
       by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
+    with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
       by simp
-    finally have "t = Abrupt (return' s t')" .
+    finally have "t = Abrupt (result_exn (return' s t') t')" .
     with exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callAbrupt)
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnAbrupt)
     from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
     show ?thesis
       by simp
   next
     fix bdy f
     assume bdy: "\<Gamma> p = Some bdy"
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f"  and
       t: "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callFault)
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnFault)
     from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
     show ?thesis
       by simp
   next
     fix bdy
     assume bdy: "\<Gamma> p = Some bdy"
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
       "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callStuck)
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnStuck)
     from valid_call ctxt this P t_notin_F
     show ?thesis
       by (rule cvalidt_postD)
   next
     assume "\<Gamma> p = None" "t=Stuck"
-    hence "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callUndefined)
+    hence "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnUndefined)
     from valid_call ctxt this P t_notin_F
     show ?thesis
       by (rule cvalidt_postD)
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   hence "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto simp add: validt_def)
   then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults)
   assume P: "s \<in> P"
   from valid_call ctxt P
-  have call: "\<Gamma>\<turnstile>call init p return' c\<down> Normal s"
+  have call: "\<Gamma>\<turnstile>call_exn init p return' result_exn c\<down> Normal s"
     by (rule cvalidt_termD)
-  show "\<Gamma>\<turnstile>call init p return c \<down> Normal s"
-  proof (cases "p \<in> dom \<Gamma>")
-    case True
-    with call obtain bdy where
-      bdy: "\<Gamma> p = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
-      termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
-                    \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
-      by cases auto
-    {
-      fix t
-      assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
-      hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
-      proof -
-        from exec_bdy bdy
-        have "\<Gamma>\<turnstile>\<langle>(Call p ),Normal (init s)\<rangle> \<Rightarrow> Normal t"
-          by (auto simp add: intro: exec.intros)
-        from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
-          res_modif
-        have "return' s t = return s t"
-          by auto
-        with termi_c exec_bdy show ?thesis by auto
-      qed
-    }
-    with bdy termi_bdy
-    show ?thesis
-      by (iprover intro: terminates_call)
-  next
-    case False
-    thus ?thesis
-      by (auto intro: terminates_callUndefined)
-  qed
-qed
-
-lemma ProcModifyReturn:
-  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
-  assumes res_modif:
-  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
-  assumes ret_modifAbr:
-  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> (return' s t) = (return s t)"
-  assumes modifies_spec:
-  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
-apply (rule hoaret_complete')
-apply (rule ProcModifyReturn_sound [where Modif=Modif and ModifAbr=ModifAbr,
-        OF _ _ res_modif ret_modifAbr])
-apply (rule hoaret_sound [OF spec])
-using modifies_spec
-apply (blast intro: hoare_sound)
-done
-
-lemma ProcModifyReturnSameFaults_sound:
-  assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P call init p return' c Q,A"
-  assumes valid_modif:
-  "\<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
-  assumes res_modif:
-  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
-  assumes ret_modifAbr:
-  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
-  shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
-proof (rule cvalidtI)
-  fix s t
-  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
-  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
-    by (auto simp add: validt_def)
-  assume exec: "\<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow> t"
-  assume P: "s \<in> P"
-  assume t_notin_F: "t \<notin> Fault ` F"
-  from exec
-  show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: exec_call_Normal_elim)
-    fix bdy t'
-    assume bdy: "\<Gamma> p = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
-    assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
-    from exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>(Call p) ,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
-      by (auto simp add: intro: exec.intros)
-    from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
-    have "t' \<in> Modif (init s)"
-      by auto
-    with res_modif have "Normal (return' s t') = Normal (return s t')"
-      by simp
-    with exec_body exec_c bdy
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_call)
-    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy t'
-    assume bdy: "\<Gamma> p = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-    assume t: "t = Abrupt (return s t')"
-    also
-    from exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>Call p ,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-      by (auto simp add: intro: exec.intros)
-    from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
-    have "t' \<in> ModifAbr (init s)"
-      by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
-      by simp
-    finally have "t = Abrupt (return' s t')" .
-    with exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callAbrupt)
-    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy f
-    assume bdy: "\<Gamma> p = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f"  and
-      t: "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callFault)
-    from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy
-    assume bdy: "\<Gamma> p = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
-      "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callStuck)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cvalidt_postD)
-  next
-    assume "\<Gamma> p = None" "t=Stuck"
-    hence "\<Gamma>\<turnstile>\<langle>call init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callUndefined)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cvalidt_postD)
-  qed
-next
-  fix s
-  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
-  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
-    by (auto simp add: validt_def)
-  assume P: "s \<in> P"
-  from valid_call ctxt P
-  have call: "\<Gamma>\<turnstile>call init p return' c\<down> Normal s"
-    by (rule cvalidt_termD)
-  show "\<Gamma>\<turnstile>call init p return c \<down> Normal s"
+  show "\<Gamma>\<turnstile>call_exn init p return result_exn c \<down> Normal s"
   proof (cases "p \<in> dom \<Gamma>")
     case True
     with call obtain bdy where
       bdy: "\<Gamma> p = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
       termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
                     \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
       by cases auto
     {
       fix t
       assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
       hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
       proof -
         from exec_bdy bdy
         have "\<Gamma>\<turnstile>\<langle>(Call p ),Normal (init s)\<rangle> \<Rightarrow> Normal t"
           by (auto simp add: intro: exec.intros)
         from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
           res_modif
         have "return' s t = return s t"
           by auto
         with termi_c exec_bdy show ?thesis by auto
       qed
     }
     with bdy termi_bdy
     show ?thesis
-      by (iprover intro: terminates_call)
+      by (iprover intro: terminates_call_exn)
   next
     case False
     thus ?thesis
-      by (auto intro: terminates_callUndefined)
+      by (auto intro: terminates_call_exnUndefined)
   qed
 qed
 
+lemma ProcModifyReturn_sound:
+  assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P call init p return' c Q,A"
+  assumes valid_modif:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
+  assumes res_modif:
+  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+  assumes ret_modifAbr:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
+shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using valid_call valid_modif res_modif ret_modifAbr unfolding call_call_exn
+  by (rule Proc_exnModifyReturn_sound)
+
+
+lemma Proc_exnModifyReturn:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes res_modif:
+  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes ret_modifAbr:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> (result_exn (return' s t) t) = (result_exn (return s t) t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule hoaret_complete')
+apply (rule Proc_exnModifyReturn_sound [where Modif=Modif and ModifAbr=ModifAbr,
+        OF _ _ res_modif ret_modifAbr])
+apply (rule hoaret_sound [OF spec])
+using modifies_spec
+apply (blast intro: hoare_sound)
+done
+
+lemma ProcModifyReturn:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
+  assumes res_modif:
+  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes ret_modifAbr:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using spec res_modif ret_modifAbr modifies_spec unfolding call_call_exn by (rule Proc_exnModifyReturn)
+
+lemma Proc_exnModifyReturnSameFaults_sound:
+  assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P call_exn init p return' result_exn c Q,A"
+  assumes valid_modif:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
+  assumes res_modif:
+  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+  assumes ret_modifAbr:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+proof (rule cvalidtI)
+  fix s t
+  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
+  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
+    by (auto simp add: validt_def)
+  assume exec: "\<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow> t"
+  assume P: "s \<in> P"
+  assume t_notin_F: "t \<notin> Fault ` F"
+  from exec
+  show "t \<in> Normal ` Q \<union> Abrupt ` A"
+  proof (cases rule: exec_call_exn_Normal_elim)
+    fix bdy t'
+    assume bdy: "\<Gamma> p = Some bdy"
+    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
+    assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
+    from exec_body bdy
+    have "\<Gamma>\<turnstile>\<langle>(Call p) ,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
+      by (auto simp add: intro: exec.intros)
+    from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
+    have "t' \<in> Modif (init s)"
+      by auto
+    with res_modif have "Normal (return' s t') = Normal (return s t')"
+      by simp
+    with exec_body exec_c bdy
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exn)
+    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+    show ?thesis
+      by simp
+  next
+    fix bdy t'
+    assume bdy: "\<Gamma> p = Some bdy"
+    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
+    assume t: "t = Abrupt (result_exn (return s t') t')"
+    also
+    from exec_body bdy
+    have "\<Gamma>\<turnstile>\<langle>Call p ,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
+      by (auto simp add: intro: exec.intros)
+    from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
+    have "t' \<in> ModifAbr (init s)"
+      by auto
+    with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
+      by simp
+    finally have "t = Abrupt (result_exn (return' s t') t')" .
+    with exec_body bdy
+    have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnAbrupt)
+    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+    show ?thesis
+      by simp
+  next
+    fix bdy f
+    assume bdy: "\<Gamma> p = Some bdy"
+    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f"  and
+      t: "t = Fault f"
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnFault)
+    from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
+    show ?thesis
+      by simp
+  next
+    fix bdy
+    assume bdy: "\<Gamma> p = Some bdy"
+    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
+      "t = Stuck"
+    with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnStuck)
+    from valid_call ctxt this P t_notin_F
+    show ?thesis
+      by (rule cvalidt_postD)
+  next
+    assume "\<Gamma> p = None" "t=Stuck"
+    hence "\<Gamma>\<turnstile>\<langle>call_exn init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (auto intro: exec_call_exnUndefined)
+    from valid_call ctxt this P t_notin_F
+    show ?thesis
+      by (rule cvalidt_postD)
+  qed
+next
+  fix s
+  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
+  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
+    by (auto simp add: validt_def)
+  assume P: "s \<in> P"
+  from valid_call ctxt P
+  have call: "\<Gamma>\<turnstile>call_exn init p return' result_exn c\<down> Normal s"
+    by (rule cvalidt_termD)
+  show "\<Gamma>\<turnstile>call_exn init p return result_exn c \<down> Normal s"
+  proof (cases "p \<in> dom \<Gamma>")
+    case True
+    with call obtain bdy where
+      bdy: "\<Gamma> p = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
+      termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
+                    \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
+      by cases auto
+    {
+      fix t
+      assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
+      hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
+      proof -
+        from exec_bdy bdy
+        have "\<Gamma>\<turnstile>\<langle>(Call p ),Normal (init s)\<rangle> \<Rightarrow> Normal t"
+          by (auto simp add: intro: exec.intros)
+        from cvalidD [OF valid_modif [rule_format, of "init s"] ctxt' this] P
+          res_modif
+        have "return' s t = return s t"
+          by auto
+        with termi_c exec_bdy show ?thesis by auto
+      qed
+    }
+    with bdy termi_bdy
+    show ?thesis
+      by (iprover intro: terminates_call_exn)
+  next
+    case False
+    thus ?thesis
+      by (auto intro: terminates_call_exnUndefined)
+  qed
+qed
+
+lemma ProcModifyReturnSameFaults_sound:
+  assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P call init p return' c Q,A"
+  assumes valid_modif:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call p (Modif \<sigma>),(ModifAbr \<sigma>)"
+  assumes res_modif:
+  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+  assumes ret_modifAbr:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
+shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using valid_call valid_modif res_modif ret_modifAbr unfolding call_call_exn
+  by (rule Proc_exnModifyReturnSameFaults_sound)
+
+lemma Proc_exnModifyReturnSameFaults:
+  assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return' result_exn c) Q,A"
+  assumes res_modif:
+  "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
+  assumes ret_modifAbr:
+  "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+  assumes modifies_spec:
+  "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
+  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call_exn init p return result_exn c) Q,A"
+apply (rule hoaret_complete')
+apply (rule Proc_exnModifyReturnSameFaults_sound [where Modif=Modif and ModifAbr=ModifAbr,
+          OF _ _ res_modif ret_modifAbr])
+apply (rule hoaret_sound [OF spec])
+using modifies_spec
+apply (blast intro: hoare_sound)
+done
+
+
 lemma ProcModifyReturnSameFaults:
   assumes spec: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return' c) Q,A"
   assumes res_modif:
   "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes ret_modifAbr:
   "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> (return' s t) = (return s t)"
   assumes modifies_spec:
   "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call p) (Modif \<sigma>),(ModifAbr \<sigma>)"
-  shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
-apply (rule hoaret_complete')
-apply (rule ProcModifyReturnSameFaults_sound [where Modif=Modif and ModifAbr=ModifAbr,
-          OF _ _ res_modif ret_modifAbr])
-apply (rule hoaret_sound [OF spec])
-using modifies_spec
-apply (blast intro: hoare_sound)
-done
+shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (call init p return c) Q,A"
+  using spec res_modif ret_modifAbr modifies_spec unfolding call_call_exn
+  by (rule Proc_exnModifyReturnSameFaults)
+
 
 
 subsubsection \<open>DynCall\<close>
 
-
-lemma dynProcModifyReturn_sound:
-assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
+lemma dynProc_exnModifyReturn_sound:
+assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
 assumes valid_modif:
     "\<forall>s\<in>P. \<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),(ModifAbr \<sigma>)"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
-assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
-shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   hence "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto simp add: validt_def)
   then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults)
-  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> \<Rightarrow> t"
+  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return result_exn c,Normal s\<rangle> \<Rightarrow> t"
   assume t_notin_F: "t \<notin> Fault ` F"
   assume P: "s \<in> P"
   with valid_modif
   have valid_modif':
     "\<forall>\<sigma>. \<Gamma>,\<Theta>\<Turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),(ModifAbr \<sigma>)"
     by blast
   from exec
-  have "\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> \<Rightarrow> t"
-    by (cases rule: exec_dynCall_Normal_elim)
+  have "\<Gamma>\<turnstile>\<langle>maybe_guard f g (call_exn init (p s) return result_exn c),Normal s\<rangle> \<Rightarrow> t"
+    by (cases rule: exec_dynCall_exn_Normal_elim)
   then show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: exec_call_Normal_elim)
-    fix bdy t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
-    assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
-    from exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t'"
-      by (auto simp add: intro: exec.Call)
-    from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
-    have "t' \<in> Modif (init s)"
-      by auto
-    with ret_modif have "Normal (return' s t') =
-      Normal (return s t')"
-      by simp
-    with exec_body exec_c bdy
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_call)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
+  proof (cases rule: exec_maybe_guard_Normal_elim_cases)
+    case noFault
+    from noFault have guards_ok: "s \<in> g" by simp
+    from noFault have "\<Gamma>\<turnstile> \<langle>call_exn init (p s) return result_exn c,Normal s\<rangle> \<Rightarrow> t" by simp
+    then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+    proof (cases rule: exec_call_exn_Normal_elim)
+      fix bdy t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
+      assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
+      from exec_body bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t'"
+        by (auto simp add: intro: exec.Call)
+      from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
+      have "t' \<in> Modif (init s)"
+        by auto
+      with ret_modif have "Normal (return' s t') =
+        Normal (return s t')"
+        by simp
+      with exec_body exec_c bdy
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exn)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
+      assume t: "t = Abrupt (result_exn (return s t') t')"
+      also from exec_body bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
+        by (auto simp add: intro: exec.intros)
+      from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
+      have "t' \<in> ModifAbr (init s)"
+        by auto
+      with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
+        by simp
+      finally have "t = Abrupt (result_exn (return' s t') t')" .
+      with exec_body bdy
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnAbrupt)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy f'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f'"  and
+        t: "t = Fault f'"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnFault)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
+      show ?thesis
+        by blast
+    next
+      fix bdy
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
+        "t = Stuck"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnStuck)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cvalidt_postD)
+    next
+      fix bdy
+      assume "\<Gamma> (p s) = None" "t=Stuck"
+      hence "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnUndefined)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cvalidt_postD)
+    qed
   next
-    fix bdy t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-    assume t: "t = Abrupt (return s t')"
-    also from exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s) ,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-      by (auto simp add: intro: exec.intros)
-    from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
-    have "t' \<in> ModifAbr (init s)"
-      by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
-      by simp
-    finally have "t = Abrupt (return' s t')" .
-    with exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callAbrupt)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
+    case (someFault)
+    then obtain guards_fail:"s \<notin> g"
+      and t: "t = Fault f" by simp
+    from exec_maybe_guard_Fault [OF guards_fail] t
+    have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (simp add: dynCall_exn_def exec_guards_DynCom)
     from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy f
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f"  and
-      t: "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callFault)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
-    show ?thesis
-      by blast
-  next
-    fix bdy
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
-      "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callStuck)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cvalidt_postD)
-  next
-    fix bdy
-    assume "\<Gamma> (p s) = None" "t=Stuck"
-    hence "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callUndefined)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cvalidt_postD)
+    show ?thesis by simp
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   hence "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto simp add: validt_def)
   then have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/UNIV\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults)
   assume P: "s \<in> P"
   from valid_call ctxt P
-  have "\<Gamma>\<turnstile>dynCall init p return' c\<down> Normal s"
+  have "\<Gamma>\<turnstile>dynCall_exn f g init p return' result_exn c\<down> Normal s"
     by (rule cvalidt_termD)
-  hence call: "\<Gamma>\<turnstile>call init (p s) return' c\<down> Normal s"
-    by cases
-  have "\<Gamma>\<turnstile>call init (p s) return c \<down> Normal s"
-  proof (cases "p s \<in> dom \<Gamma>")
-    case True
-    with call obtain bdy where
-      bdy: "\<Gamma> (p s) = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
-      termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
-                    \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
-      by cases auto
-    {
-      fix t
-      assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
-      hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
-      proof -
-        from exec_bdy bdy
-        have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t"
-          by (auto simp add: intro: exec.intros)
-        from cvalidD [OF valid_modif [rule_format, of s "init s"] ctxt' this] P
-          ret_modif
-        have "return' s t = return s t"
-          by auto
-        with termi_c exec_bdy show ?thesis by auto
-      qed
-    }
-    with bdy termi_bdy
-    show ?thesis
-      by (iprover intro: terminates_call)
+  thus "\<Gamma>\<turnstile>dynCall_exn f g init p return result_exn c \<down> Normal s"
+  proof (cases rule: terminates_dynCall_exn_elim)
+    case noFault
+    then obtain guards_ok: "s \<in> g"
+        and call: "\<Gamma>\<turnstile>call_exn init (p s) return' result_exn c\<down> Normal s"
+      by auto
+    have "\<Gamma>\<turnstile>call_exn init (p s) return result_exn c \<down> Normal s"
+    proof (cases "p s \<in> dom \<Gamma>")
+      case True
+      with call obtain bdy where
+        bdy: "\<Gamma> (p s) = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
+        termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
+                      \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
+        by cases auto
+      {
+        fix t
+        assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
+        hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
+        proof -
+          from exec_bdy bdy
+          have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t"
+            by (auto simp add: intro: exec.intros)
+          from cvalidD [OF valid_modif [rule_format, of s "init s"] ctxt' this] P
+            ret_modif
+          have "return' s t = return s t"
+            by auto
+          with termi_c exec_bdy show ?thesis by auto
+        qed
+      }
+      with bdy termi_bdy
+      show ?thesis
+        by (iprover intro: terminates_call_exn)
+    next
+      case False
+      thus ?thesis
+        by (auto intro: terminates_call_exnUndefined)
+    qed
+    thus "\<Gamma>\<turnstile>dynCall_exn f g init p return result_exn c \<down> Normal s"
+      by (iprover intro: terminates_dynCall_exn)
   next
-    case False
+    case (someFault)
+    then have guard_fail: "s \<notin> g" by simp
     thus ?thesis
-      by (auto intro: terminates_callUndefined)
+      by (simp add: terminates_maybe_guard_Fault dynCall_exn_def)
   qed
-  thus "\<Gamma>\<turnstile>dynCall init p return c \<down> Normal s"
-    by (iprover intro: terminates_dynCall)
 qed
 
+lemma dynProcModifyReturn_sound:
+assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
+assumes valid_modif:
+    "\<forall>s\<in>P. \<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),(ModifAbr \<sigma>)"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
+shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using valid_call valid_modif ret_modif ret_modifAbr unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturn_sound)
+
+
+lemma dynProc_exnModifyReturn:
+assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s)
+           \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
+                             \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+assumes modif:
+    "\<forall>s \<in> P. \<forall>\<sigma>.
+       \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+apply (rule hoaret_complete')
+apply (rule dynProc_exnModifyReturn_sound
+        [where Modif=Modif and ModifAbr=ModifAbr,
+            OF hoaret_sound [OF dyn_call] _ ret_modif ret_modifAbr])
+apply (intro ballI allI)
+apply (rule hoare_sound [OF modif [rule_format]])
+apply assumption
+  done
+
 lemma dynProcModifyReturn:
 assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s)
            \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s)
                              \<longrightarrow> return' s t = return s t"
 assumes modif:
     "\<forall>s \<in> P. \<forall>\<sigma>.
        \<Gamma>,\<Theta>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
-shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-apply (rule hoaret_complete')
-apply (rule dynProcModifyReturn_sound
-        [where Modif=Modif and ModifAbr=ModifAbr,
-            OF hoaret_sound [OF dyn_call] _ ret_modif ret_modifAbr])
-apply (intro ballI allI)
-apply (rule hoare_sound [OF modif [rule_format]])
-apply assumption
-done
+  shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using dyn_call ret_modif ret_modifAbr modif unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturn)
+
+lemma dynProc_exnModifyReturnSameFaults_sound:
+assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes valid_modif:
+    "\<forall>s\<in>P. \<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+proof (rule cvalidtI)
+  fix s t
+  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
+  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
+    by (auto simp add: validt_def)
+  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return result_exn c,Normal s\<rangle> \<Rightarrow> t"
+  assume t_notin_F: "t \<notin> Fault ` F"
+  assume P: "s \<in> P"
+  with valid_modif
+  have valid_modif':
+    "\<forall>\<sigma>. \<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),(ModifAbr \<sigma>)"
+    by blast
+  from exec
+  have "\<Gamma>\<turnstile>\<langle>maybe_guard f g (call_exn init (p s) return result_exn c),Normal s\<rangle> \<Rightarrow> t"
+    by (cases rule: exec_dynCall_exn_Normal_elim)
+  then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+  proof (cases rule: exec_maybe_guard_Normal_elim_cases)
+    case noFault
+    from noFault have guards_ok: "s \<in> g" by simp
+    from noFault have "\<Gamma>\<turnstile> \<langle>call_exn init (p s) return result_exn c,Normal s\<rangle> \<Rightarrow> t" by simp
+    then show "t \<in> Normal ` Q \<union> Abrupt ` A"
+    proof (cases rule: exec_call_exn_Normal_elim)
+      fix bdy t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
+      assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
+      from exec_body bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t'"
+        by (auto simp add: intro: exec.intros)
+      from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
+      have "t' \<in> Modif (init s)"
+        by auto
+      with ret_modif have "Normal (return' s t') =
+        Normal (return s t')"
+        by simp
+      with exec_body exec_c bdy
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exn)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy t'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
+      assume t: "t = Abrupt (result_exn (return s t') t')"
+      also from exec_body bdy
+      have "\<Gamma>\<turnstile>\<langle>Call (p s)  ,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
+        by (auto simp add: intro: exec.intros)
+      from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
+      have "t' \<in> ModifAbr (init s)"
+        by auto
+      with ret_modifAbr have "Abrupt (result_exn (return s t') t') = Abrupt (result_exn (return' s t') t')"
+        by simp
+      finally have "t = Abrupt (result_exn (return' s t') t')" .
+      with exec_body bdy
+      have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnAbrupt)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy f'
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f'"  and
+        t: "t = Fault f'"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnFault)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
+      show ?thesis
+        by simp
+    next
+      fix bdy
+      assume bdy: "\<Gamma> (p s) = Some bdy"
+      assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
+        "t = Stuck"
+      with bdy have "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnStuck)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cvalidt_postD)
+    next
+      fix bdy
+      assume "\<Gamma> (p s) = None" "t=Stuck"
+      hence "\<Gamma>\<turnstile>\<langle>call_exn init (p s) return' result_exn c ,Normal s\<rangle> \<Rightarrow> t"
+        by (auto intro: exec_call_exnUndefined)
+      from exec_maybe_guard_noFault [OF this guards_ok]
+      have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+        by (simp add: dynCall_exn_def exec_maybe_guard_DynCom)
+      from valid_call ctxt this P t_notin_F
+      show ?thesis
+        by (rule cvalidt_postD)
+    qed
+  next
+    case (someFault)
+    then obtain guards_fail:"s \<notin> g"
+      and t: "t = Fault f" by simp
+    from exec_maybe_guard_Fault [OF guards_fail] t
+    have "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return' result_exn c,Normal s\<rangle> \<Rightarrow> t"
+      by (simp add: dynCall_exn_def exec_guards_DynCom)
+    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
+    show ?thesis by simp
+  qed
+next
+  fix s
+  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
+  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
+    by (auto simp add: validt_def)
+  assume P: "s \<in> P"
+  from valid_call ctxt P
+  have "\<Gamma>\<turnstile>dynCall_exn f g init p return' result_exn c\<down> Normal s"
+    by (rule cvalidt_termD)
+  thus "\<Gamma>\<turnstile>dynCall_exn f g init p return result_exn c \<down> Normal s"
+  proof (cases rule: terminates_dynCall_exn_elim)
+    case noFault
+    then obtain guards_ok: "s \<in> g"
+        and call: "\<Gamma>\<turnstile>call_exn init (p s) return' result_exn c\<down> Normal s"
+      by auto
+    have "\<Gamma>\<turnstile>call_exn init (p s) return result_exn c \<down> Normal s"
+    proof (cases "p s \<in> dom \<Gamma>")
+      case True
+      with call obtain bdy where
+        bdy: "\<Gamma> (p s) = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
+        termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
+                      \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
+        by cases auto
+      {
+        fix t
+        assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
+        hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
+        proof -
+          from exec_bdy bdy
+          have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t"
+            by (auto simp add: intro: exec.intros)
+          from cvalidD [OF valid_modif [rule_format, of s "init s"] ctxt' this] P
+            ret_modif
+          have "return' s t = return s t"
+            by auto
+          with termi_c exec_bdy show ?thesis by auto
+        qed
+      }
+      with bdy termi_bdy
+      show ?thesis
+        by (iprover intro: terminates_call_exn)
+    next
+      case False
+      thus ?thesis
+        by (auto intro: terminates_call_exnUndefined)
+    qed
+    thus "\<Gamma>\<turnstile>dynCall_exn f g init p return result_exn c \<down> Normal s"
+      by (iprover intro: terminates_dynCall_exn)
+  next
+    case (someFault)
+    then have guard_fail: "s \<notin> g" by simp
+    thus ?thesis
+      by (simp add: terminates_maybe_guard_Fault dynCall_exn_def)
+  qed
+qed
 
 lemma dynProcModifyReturnSameFaults_sound:
 assumes valid_call: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes valid_modif:
     "\<forall>s\<in>P. \<forall>\<sigma>. \<Gamma>,\<Theta> \<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
 shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-proof (rule cvalidtI)
-  fix s t
-  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
-  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
-    by (auto simp add: validt_def)
-  assume exec: "\<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> \<Rightarrow> t"
-  assume t_notin_F: "t \<notin> Fault ` F"
-  assume P: "s \<in> P"
-  with valid_modif
-  have valid_modif':
-    "\<forall>\<sigma>. \<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} (Call (p s)) (Modif \<sigma>),(ModifAbr \<sigma>)"
-    by blast
-  from exec
-  have "\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> \<Rightarrow> t"
-    by (cases rule: exec_dynCall_Normal_elim)
-  then show "t \<in> Normal ` Q \<union> Abrupt ` A"
-  proof (cases rule: exec_call_Normal_elim)
-    fix bdy t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t'"
-    assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow> t"
-    from exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t'"
-      by (auto simp add: intro: exec.intros)
-    from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
-    have "t' \<in> Modif (init s)"
-      by auto
-    with ret_modif have "Normal (return' s t') =
-      Normal (return s t')"
-      by simp
-    with exec_body exec_c bdy
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_call)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy t'
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-    assume t: "t = Abrupt (return s t')"
-    also from exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>Call (p s)  ,Normal (init s)\<rangle> \<Rightarrow> Abrupt t'"
-      by (auto simp add: intro: exec.intros)
-    from cvalidD [OF valid_modif' [rule_format, of "init s"] ctxt' this] P
-    have "t' \<in> ModifAbr (init s)"
-      by auto
-    with ret_modifAbr have "Abrupt (return s t') = Abrupt (return' s t')"
-      by simp
-    finally have "t = Abrupt (return' s t')" .
-    with exec_body bdy
-    have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callAbrupt)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from cvalidt_postD [OF valid_call ctxt this] P t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy f
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Fault f"  and
-      t: "t = Fault f"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callFault)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from cvalidt_postD [OF valid_call ctxt this P] t t_notin_F
-    show ?thesis
-      by simp
-  next
-    fix bdy
-    assume bdy: "\<Gamma> (p s) = Some bdy"
-    assume "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Stuck"
-      "t = Stuck"
-    with bdy have "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callStuck)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cvalidt_postD)
-  next
-    fix bdy
-    assume "\<Gamma> (p s) = None" "t=Stuck"
-    hence "\<Gamma>\<turnstile>\<langle>call init (p s) return' c ,Normal s\<rangle> \<Rightarrow> t"
-      by (auto intro: exec_callUndefined)
-    hence "\<Gamma>\<turnstile>\<langle>dynCall init p return' c,Normal s\<rangle> \<Rightarrow> t"
-      by (rule exec_dynCall)
-    from valid_call ctxt this P t_notin_F
-    show ?thesis
-      by (rule cvalidt_postD)
-  qed
-next
-  fix s
-  assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
-  hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
-    by (auto simp add: validt_def)
-  assume P: "s \<in> P"
-  from valid_call ctxt P
-  have "\<Gamma>\<turnstile>dynCall init p return' c\<down> Normal s"
-    by (rule cvalidt_termD)
-  hence call: "\<Gamma>\<turnstile>call init (p s) return' c\<down> Normal s"
-    by cases
-  have "\<Gamma>\<turnstile>call init (p s) return c \<down> Normal s"
-  proof (cases "p s \<in> dom \<Gamma>")
-    case True
-    with call obtain bdy where
-      bdy: "\<Gamma> (p s) = Some bdy" and termi_bdy: "\<Gamma>\<turnstile>bdy \<down> Normal (init s)" and
-      termi_c: "\<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow>
-                    \<Gamma>\<turnstile>c s t \<down> Normal (return' s t)"
-      by cases auto
-    {
-      fix t
-      assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
-      hence "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
-      proof -
-        from exec_bdy bdy
-        have "\<Gamma>\<turnstile>\<langle>Call (p s),Normal (init s)\<rangle> \<Rightarrow> Normal t"
-          by (auto simp add: intro: exec.intros)
-        from cvalidD [OF valid_modif [rule_format, of s "init s"] ctxt' this] P
-          ret_modif
-        have "return' s t = return s t"
-          by auto
-        with termi_c exec_bdy show ?thesis by auto
-      qed
-    }
-    with bdy termi_bdy
-    show ?thesis
-      by (iprover intro: terminates_call)
-  next
-    case False
-    thus ?thesis
-      by (auto intro: terminates_callUndefined)
-  qed
-  thus "\<Gamma>\<turnstile>dynCall init p return c \<down> Normal s"
-    by (iprover intro: terminates_dynCall)
-qed
+  using valid_call valid_modif ret_modif ret_modifAbr unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturnSameFaults_sound)
+
+lemma dynProc_exnModifyReturnSameFaults:
+assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall_exn f g init p return' result_exn c Q,A"
+assumes ret_modif:
+    "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
+assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> result_exn (return' s t) t = result_exn (return s t) t"
+assumes modif:
+    "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
+shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall_exn f g init p return result_exn c) Q,A"
+apply (rule hoaret_complete')
+apply (rule dynProc_exnModifyReturnSameFaults_sound
+        [where Modif=Modif and ModifAbr=ModifAbr,
+          OF hoaret_sound [OF dyn_call] _ ret_modif ret_modifAbr])
+apply (intro ballI allI)
+apply (rule hoare_sound [OF modif [rule_format]])
+apply assumption
+  done
 
 lemma dynProcModifyReturnSameFaults:
 assumes dyn_call: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P dynCall init p return' c Q,A"
 assumes ret_modif:
     "\<forall>s t. t \<in> Modif (init s) \<longrightarrow> return' s t = return s t"
 assumes ret_modifAbr: "\<forall>s t. t \<in> ModifAbr (init s) \<longrightarrow> return' s t = return s t"
 assumes modif:
     "\<forall>s \<in> P. \<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Call (p s) (Modif \<sigma>),(ModifAbr \<sigma>)"
-shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
-apply (rule hoaret_complete')
-apply (rule dynProcModifyReturnSameFaults_sound
-        [where Modif=Modif and ModifAbr=ModifAbr,
-          OF hoaret_sound [OF dyn_call] _ ret_modif ret_modifAbr])
-apply (intro ballI allI)
-apply (rule hoare_sound [OF modif [rule_format]])
-apply assumption
-done
+  shows "\<Gamma>,\<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (dynCall init p return c) Q,A"
+  using dyn_call ret_modif ret_modifAbr modif unfolding dynCall_dynCall_exn
+  by (rule dynProc_exnModifyReturnSameFaults)
+
 
 subsubsection \<open>Conjunction of Postcondition\<close>
 
 lemma PostConjI_sound:
   assumes valid_Q: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes valid_R: "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c R,B"
   shows "\<Gamma>,\<Theta> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from valid_Q ctxt exec P t_notin_F have "t \<in> Normal ` Q \<union> Abrupt ` A"
     by (rule cvalidt_postD)
   moreover
   from valid_R ctxt exec P t_notin_F have "t \<in> Normal ` R \<union> Abrupt ` B"
     by (rule cvalidt_postD)
   ultimately show "t \<in> Normal ` (Q \<inter> R) \<union> Abrupt ` (A \<inter> B)"
     by blast
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from valid_Q ctxt P
   show "\<Gamma>\<turnstile>c \<down> Normal s"
     by (rule cvalidt_termD)
 qed
 
 lemma PostConjI:
   assumes deriv_Q: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes deriv_R: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c R,B"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> B)"
 apply (rule hoaret_complete')
 apply (rule PostConjI_sound)
 apply (rule hoaret_sound [OF deriv_Q])
 apply (rule hoaret_sound [OF deriv_R])
 done
 
 
 lemma Merge_PostConj_sound:
   assumes validF: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes validG: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/G\<^esub> P' c R,X"
   assumes F_G: "F \<subseteq> G"
   assumes P_P': "P \<subseteq> P'"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> X)"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   with F_G have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/G\<^esub> P (Call p) Q,A"
     by (auto intro: validt_augment_Faults)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   with P_P' have P': "s \<in> P'"
     by auto
   assume t_noFault: "t \<notin> Fault ` F"
   show "t \<in> Normal ` (Q \<inter> R) \<union> Abrupt ` (A \<inter> X)"
   proof -
     from cvalidt_postD [OF validF [rule_format] ctxt exec P t_noFault]
     have t: "t \<in> Normal ` Q \<union> Abrupt ` A".
     then have "t \<notin> Fault ` G"
       by auto
     from cvalidt_postD [OF validG [rule_format] ctxt' exec P' this]
     have "t \<in> Normal ` R \<union> Abrupt ` X" .
     with t show ?thesis by auto
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from validF ctxt P
   show "\<Gamma>\<turnstile>c \<down> Normal s"
     by (rule cvalidt_termD)
 qed
 
 
 
 lemma Merge_PostConj:
   assumes validF: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes validG: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/G\<^esub> P' c R,X"
   assumes F_G: "F \<subseteq> G"
   assumes P_P': "P \<subseteq> P'"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c (Q \<inter> R),(A \<inter> X)"
 apply (rule hoaret_complete')
 apply (rule Merge_PostConj_sound [OF _ _ F_G P_P'])
 using validF apply (blast intro:hoaret_sound)
 using validG apply (blast intro:hoaret_sound)
 done
 
 
 subsubsection \<open>Guards and Guarantees\<close>
 
 lemma SplitGuards_sound:
   assumes valid_c1: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,A"
   assumes valid_c2: "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c\<^sub>2 UNIV,UNIV"
   assumes c: "(c\<^sub>1 \<inter>\<^sub>g c\<^sub>2) = Some c"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto simp add: validt_def)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases t)
     case Normal
     with inter_guards_exec_noFault [OF c exec]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> t" by simp
     from valid_c1 ctxt this P t_notin_F
     show ?thesis
       by (rule cvalidt_postD)
   next
     case Abrupt
     with inter_guards_exec_noFault [OF c exec]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> t" by simp
     from valid_c1 ctxt this P t_notin_F
     show ?thesis
       by (rule cvalidt_postD)
   next
     case (Fault f)
     assume t: "t=Fault f"
     with exec inter_guards_exec_Fault [OF c]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow> Fault f"
       by auto
     then show ?thesis
     proof (cases rule: disjE [consumes 1])
       assume "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> Fault f"
       from cvalidt_postD [OF valid_c1 ctxt this P] t t_notin_F
       show ?thesis
         by blast
     next
       assume "\<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow> Fault f"
       from cvalidD [OF valid_c2 ctxt' this P] t t_notin_F
       show ?thesis
         by blast
     qed
   next
     case Stuck
     with inter_guards_exec_noFault [OF c exec]
     have "\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> t" by simp
     from valid_c1 ctxt this P t_notin_F
     show ?thesis
       by (rule cvalidt_postD)
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   show "\<Gamma>\<turnstile>c \<down> Normal s"
   proof -
     from valid_c1 ctxt P
     have "\<Gamma>\<turnstile>c\<^sub>1 \<down> Normal s"
       by (rule cvalidt_termD)
     with c show ?thesis
       by (rule inter_guards_terminates)
   qed
 qed
 
 lemma SplitGuards:
   assumes c: "(c\<^sub>1 \<inter>\<^sub>g c\<^sub>2) = Some c"
   assumes deriv_c1: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c\<^sub>1 Q,A"
   assumes deriv_c2: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c\<^sub>2 UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule SplitGuards_sound [OF _ _ c])
 apply (rule hoaret_sound [OF deriv_c1])
 apply (rule hoare_sound [OF deriv_c2])
 done
 
 lemma CombineStrip_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes valid_strip: "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/{}\<^esub> P (strip_guards (-F) c) UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^bsub>/{}\<^esub> P (Call p) Q,A"
     by (auto simp add: validt_def)
   from ctxt have ctxt'': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults simp add: validt_def)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases t)
     case (Normal t')
     from cvalidt_postD [OF valid ctxt'' exec P] Normal
     show ?thesis
       by auto
   next
     case (Abrupt t')
     from cvalidt_postD [OF valid ctxt'' exec P] Abrupt
     show ?thesis
       by auto
   next
     case (Fault f)
     show ?thesis
     proof (cases "f \<in> F")
       case True
       hence "f \<notin> -F" by simp
       with exec Fault
       have "\<Gamma>\<turnstile>\<langle>strip_guards (-F) c,Normal s\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec_to_exec_strip_guards_Fault)
       from cvalidD [OF valid_strip ctxt' this P] Fault
       have False
         by auto
       thus ?thesis ..
     next
       case False
       with cvalidt_postD [OF valid ctxt'' exec P] Fault
       show ?thesis
         by auto
     qed
   next
     case Stuck
     from cvalidt_postD [OF valid ctxt'' exec P] Stuck
     show ?thesis
       by auto
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults simp add: validt_def)
   assume P: "s \<in> P"
   show "\<Gamma>\<turnstile>c \<down> Normal s"
   proof -
     from valid ctxt' P
     show "\<Gamma>\<turnstile>c \<down> Normal s"
       by (rule cvalidt_termD)
   qed
 qed
 
 lemma CombineStrip:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes deriv_strip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P (strip_guards (-F) c) UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule CombineStrip_sound)
 apply  (iprover intro: hoaret_sound [OF deriv])
 apply (iprover intro: hoare_sound [OF deriv_strip])
 done
 
 lemma GuardsFlip_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes validFlip: "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/-F\<^esub> P c UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   from ctxt have ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults simp add: validt_def)
   from ctxt have ctxtFlip: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^bsub>/-F\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults simp add: validt_def)
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases t)
     case (Normal t')
     from cvalidt_postD [OF valid ctxt' exec P] Normal
     show ?thesis
       by auto
   next
     case (Abrupt t')
     from cvalidt_postD [OF valid ctxt' exec P] Abrupt
     show ?thesis
       by auto
   next
     case (Fault f)
     show ?thesis
     proof (cases "f \<in> F")
       case True
       hence "f \<notin> -F" by simp
       with cvalidD [OF validFlip ctxtFlip exec P] Fault
       have False
         by auto
       thus ?thesis ..
     next
       case False
       with cvalidt_postD [OF valid ctxt' exec P] Fault
       show ?thesis
         by auto
     qed
   next
     case Stuck
     from cvalidt_postD [OF valid ctxt' exec P] Stuck
     show ?thesis
       by auto
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma> \<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   hence ctxt': "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
     by (auto intro: valid_augment_Faults simp add: validt_def)
   assume P: "s \<in> P"
   show "\<Gamma>\<turnstile>c \<down> Normal s"
   proof -
     from valid ctxt' P
     show "\<Gamma>\<turnstile>c \<down> Normal s"
       by (rule cvalidt_termD)
   qed
 qed
 
 
 lemma GuardsFlip:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   assumes derivFlip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/-F\<^esub> P c UNIV,UNIV"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule GuardsFlip_sound)
 apply  (iprover intro: hoaret_sound [OF deriv])
 apply (iprover intro: hoare_sound [OF derivFlip])
 done
 
 lemma MarkGuardsI_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s\<rangle> \<Rightarrow> t"
   from exec_mark_guards_to_exec [OF exec] obtain t' where
     exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t'" and
     t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
     by blast
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from cvalidt_postD [OF valid [rule_format] ctxt exec_c P]
     have "t' \<in> Normal ` Q \<union> Abrupt ` A"
       by blast
     with t'_noFault
     show ?thesis
       by auto
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have "\<Gamma>\<turnstile>c \<down> Normal s".
   thus "\<Gamma>\<turnstile>mark_guards f c \<down> Normal s"
     by (rule terminates_to_terminates_mark_guards)
 qed
 
 lemma MarkGuardsI:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
 apply (rule hoaret_complete')
 apply (rule MarkGuardsI_sound)
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 
 lemma MarkGuardsD_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases "isFault t")
     case True
     with exec_to_exec_mark_guards_Fault exec
     obtain f' where "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s\<rangle> \<Rightarrow> Fault f'"
       by (fastforce elim: isFaultE)
     from cvalidt_postD [OF valid [rule_format] ctxt this P]
     have False
       by auto
     thus ?thesis ..
   next
     case False
     from exec_to_exec_mark_guards [OF exec False]
     obtain f' where "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s\<rangle> \<Rightarrow> t"
       by auto
     from cvalidt_postD [OF valid [rule_format] ctxt this P]
     show ?thesis
       by auto
   qed
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have "\<Gamma>\<turnstile>mark_guards f c \<down> Normal s".
   thus "\<Gamma>\<turnstile>c \<down> Normal s"
     by (rule terminates_mark_guards_to_terminates)
 qed
 
 lemma MarkGuardsD:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P mark_guards f c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule MarkGuardsD_sound)
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 lemma MergeGuardsI_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P merge_guards c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec_merge: "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> \<Rightarrow> t"
   from exec_merge_guards_to_exec [OF exec_merge]
   have exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t" .
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from cvalidt_postD [OF valid [rule_format] ctxt exec P t_notin_F]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have "\<Gamma>\<turnstile>c \<down> Normal s".
   thus "\<Gamma>\<turnstile>merge_guards c \<down> Normal s"
     by (rule terminates_to_terminates_merge_guards)
 qed
 
 lemma MergeGuardsI:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P merge_guards c Q,A"
 apply (rule hoaret_complete')
 apply (rule MergeGuardsI_sound)
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 lemma MergeGuardsD_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P merge_guards c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   from exec_to_exec_merge_guards [OF exec]
   have exec_merge: "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> \<Rightarrow> t".
   assume P: "s \<in> P"
   assume t_notin_F: "t \<notin> Fault ` F"
   from cvalidt_postD [OF valid [rule_format] ctxt exec_merge P t_notin_F]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have "\<Gamma>\<turnstile>merge_guards c \<down> Normal s".
   thus "\<Gamma>\<turnstile>c \<down> Normal s"
     by (rule terminates_merge_guards_to_terminates)
 qed
 
 lemma MergeGuardsD:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P merge_guards c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule MergeGuardsD_sound)
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 
 lemma SubsetGuards_sound:
   assumes c_c': "c \<subseteq>\<^sub>g c'"
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c' Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   from exec_to_exec_subseteq_guards [OF c_c' exec] obtain t' where
     exec_c': "\<Gamma>\<turnstile>\<langle>c',Normal s\<rangle> \<Rightarrow> t'" and
     t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
     by blast
   assume P: "s \<in> P"
   assume t_noFault: "t \<notin> Fault ` {}"
   from cvalidt_postD [OF valid [rule_format] ctxt exec_c' P] t'_noFault t_noFault
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
     by auto
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/{}\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have termi_c': "\<Gamma>\<turnstile>c' \<down> Normal s".
   from cvalidt_postD [OF valid ctxt _ P]
   have noFault_c': "\<Gamma>\<turnstile>\<langle>c',Normal s\<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
     by (auto simp add: final_notin_def)
   from termi_c' c_c' noFault_c'
   show "\<Gamma>\<turnstile>c \<down> Normal s"
     by (rule terminates_fewer_guards)
 qed
 
 lemma SubsetGuards:
   assumes c_c': "c \<subseteq>\<^sub>g c'"
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c' Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/{}\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule SubsetGuards_sound [OF c_c'])
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 lemma NormalizeD_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (normalize c) Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
   hence exec_norm: "\<Gamma>\<turnstile>\<langle>normalize c,Normal s\<rangle> \<Rightarrow> t"
     by (rule exec_to_exec_normalize)
   assume P: "s \<in> P"
   assume noFault: "t \<notin> Fault ` F"
   from cvalidt_postD [OF valid [rule_format] ctxt exec_norm P noFault]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have "\<Gamma>\<turnstile>normalize c \<down> Normal s".
   thus "\<Gamma>\<turnstile>c \<down> Normal s"
     by (rule terminates_normalize_to_terminates)
 qed
 
 lemma NormalizeD:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (normalize c) Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 apply (rule hoaret_complete')
 apply (rule NormalizeD_sound)
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 lemma NormalizeI_sound:
   assumes valid: "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (normalize c) Q,A"
 proof (rule cvalidtI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume "\<Gamma>\<turnstile>\<langle>normalize c,Normal s\<rangle> \<Rightarrow> t"
   hence exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
     by (rule exec_normalize_to_exec)
   assume P: "s \<in> P"
   assume noFault: "t \<notin> Fault ` F"
   from cvalidt_postD [OF valid [rule_format] ctxt exec P noFault]
   show "t \<in> Normal ` Q \<union> Abrupt ` A".
 next
   fix s
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (Call p) Q,A"
   assume P: "s \<in> P"
   from cvalidt_termD [OF valid ctxt P]
   have "\<Gamma>\<turnstile> c \<down> Normal s".
   thus "\<Gamma>\<turnstile>normalize c \<down> Normal s"
     by (rule terminates_to_terminates_normalize)
 qed
 
 lemma NormalizeI:
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (normalize c) Q,A"
 apply (rule hoaret_complete')
 apply (rule NormalizeI_sound)
 apply (iprover intro: hoaret_sound [OF deriv])
 done
 
 subsubsection \<open>Restricting the Procedure Environment\<close>
 
 lemma validt_restrict_to_validt:
 assumes validt_c: "\<Gamma>|\<^bsub>M\<^esub>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 shows "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof -
   from validt_c
   have valid_c: "\<Gamma>|\<^bsub>M\<^esub>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A" by (simp add: validt_def)
   hence "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A" by (rule valid_restrict_to_valid)
   moreover
   {
     fix s
     assume P: "s \<in> P"
     have "\<Gamma>\<turnstile>c\<down>Normal s"
     proof -
       from P validt_c have "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>c\<down>Normal s"
         by (auto simp add: validt_def)
       moreover
       from P valid_c
       have "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
         by (auto simp add: valid_def  final_notin_def)
       ultimately show ?thesis
         by (rule terminates_restrict_to_terminates)
     qed
    }
    ultimately show ?thesis
      by (auto simp add: validt_def)
 qed
 
 
 lemma augment_procs:
 assumes deriv_c: "\<Gamma>|\<^bsub>M\<^esub>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 shows "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   apply (rule hoaret_complete)
   apply (rule validt_restrict_to_validt)
   apply (insert hoaret_sound [OF deriv_c])
   by (simp add: cvalidt_def)
 
 subsubsection \<open>Miscellaneous\<close>
 
 lemma augment_Faults:
 assumes deriv_c: "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 assumes F: "F \<subseteq> F'"
 shows "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F'\<^esub> P c Q,A"
   apply (rule hoaret_complete)
   apply (rule validt_augment_Faults [OF _ F])
   apply (insert hoaret_sound [OF deriv_c])
   by (simp add: cvalidt_def)
 
 lemma TerminationPartial_sound:
   assumes "termination": "\<forall>s \<in> P. \<Gamma>\<turnstile>c\<down>Normal s"
   assumes partial_corr: "\<Gamma>,\<Theta>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 using "termination" partial_corr
 by (auto simp add: cvalidt_def validt_def cvalid_def)
 
 lemma TerminationPartial:
   assumes partial_deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes "termination": "\<forall>s \<in> P. \<Gamma>\<turnstile>c\<down>Normal s"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   apply (rule hoaret_complete')
   apply (rule TerminationPartial_sound [OF "termination"])
   apply (rule hoare_sound [OF partial_deriv])
   done
 
 lemma TerminationPartialStrip:
   assumes partial_deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   assumes "termination": "\<forall>s \<in> P. strip F' \<Gamma>\<turnstile>strip_guards F' c\<down>Normal s"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof -
   from "termination" have "\<forall>s \<in> P. \<Gamma>\<turnstile>c\<down>Normal s"
     by (auto intro: terminates_strip_guards_to_terminates
       terminates_strip_to_terminates)
   with partial_deriv
   show ?thesis
     by (rule TerminationPartial)
 qed
 
 lemma SplitTotalPartial:
   assumes termi: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q',A'"
   assumes part: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof -
   from hoaret_sound [OF termi] hoare_sound [OF part]
   have "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
     by (fastforce simp add: cvalidt_def validt_def cvalid_def valid_def)
   thus ?thesis
     by (rule hoaret_complete')
 qed
 
 lemma SplitTotalPartial':
   assumes termi: "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/UNIV\<^esub> P c Q',A'"
   assumes part: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
 proof -
   from hoaret_sound [OF termi] hoare_sound [OF part]
   have "\<Gamma>,\<Theta>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
     by (fastforce simp add: cvalidt_def validt_def cvalid_def valid_def)
   thus ?thesis
     by (rule hoaret_complete')
 qed
 
 end
diff --git a/thys/Simpl/Language.thy b/thys/Simpl/Language.thy
--- a/thys/Simpl/Language.thy
+++ b/thys/Simpl/Language.thy
@@ -1,1150 +1,1242 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Language.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
 section \<open>The Simpl Syntax\<close>
 
 theory Language imports "HOL-Library.Old_Recdef" begin
 
 subsection \<open>The Core Language\<close>
 
 text \<open>We use a shallow embedding of boolean expressions as well as assertions
 as sets of states.
 \<close>
 
 type_synonym 's bexp = "'s set"
 type_synonym 's assn = "'s set"
 
 datatype (dead 's, 'p, 'f) com =
     Skip
   | Basic "'s \<Rightarrow> 's"
   | Spec "('s \<times> 's) set"
   | Seq "('s ,'p, 'f) com" "('s,'p, 'f) com"
   | Cond "'s bexp" "('s,'p,'f) com"  "('s,'p,'f) com"
   | While "'s bexp" "('s,'p,'f) com"
   | Call "'p"
   | DynCom "'s \<Rightarrow> ('s,'p,'f) com"
   | Guard "'f" "'s bexp" "('s,'p,'f) com"
   | Throw
   | Catch "('s,'p,'f) com" "('s,'p,'f) com"
 
 
 
 
 
 
 subsection \<open>Derived Language Constructs\<close>
 
 definition
   raise:: "('s \<Rightarrow> 's) \<Rightarrow> ('s,'p,'f) com" where
   "raise f = Seq (Basic f) Throw"
 
 definition
   condCatch:: "('s,'p,'f) com \<Rightarrow> 's bexp \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com" where
   "condCatch c\<^sub>1 b c\<^sub>2 = Catch c\<^sub>1 (Cond b c\<^sub>2 Throw)"
 
 definition
   bind:: "('s \<Rightarrow> 'v) \<Rightarrow> ('v \<Rightarrow> ('s,'p,'f) com) \<Rightarrow> ('s,'p,'f) com" where
   "bind e c = DynCom (\<lambda>s. c (e s))"
 
 definition
   bseq:: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com" where
   "bseq = Seq"
 
 definition
+  block_exn:: "['s\<Rightarrow>'s,('s,'p,'f) com,'s\<Rightarrow>'s\<Rightarrow>'s,'s\<Rightarrow>'s\<Rightarrow>'s,'s\<Rightarrow>'s\<Rightarrow>('s,'p,'f) com]\<Rightarrow>('s,'p,'f) com"
+where
+  "block_exn init bdy return result_exn c =
+    DynCom (\<lambda>s. (Seq (Catch (Seq (Basic init) bdy) (Seq (Basic (\<lambda>t. result_exn (return s t) t)) Throw))
+                            (DynCom (\<lambda>t. Seq (Basic (return s)) (c s t))))
+                        )"
+
+definition
+  call_exn:: "('s\<Rightarrow>'s) \<Rightarrow> 'p \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> 's)\<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> 's) \<Rightarrow>('s\<Rightarrow>'s\<Rightarrow>('s,'p,'f) com)\<Rightarrow>('s,'p,'f)com" where
+  "call_exn init p return result_exn c = block_exn init (Call p) return result_exn c"
+
+primrec guards:: "('f \<times> 's set ) list \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
+where
+"guards [] c = c" |
+"guards (g#gs) c = Guard (fst g) (snd g) (guards gs c)"
+
+
+definition maybe_guard:: "'f \<Rightarrow> 's set \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
+where
+"maybe_guard f g c = (if g = UNIV then c else Guard f g c)"
+
+lemma maybe_guard_UNIV [simp]: "maybe_guard f UNIV c = c"
+  by (simp add: maybe_guard_def)
+
+
+definition
+  dynCall_exn:: "'f \<Rightarrow> 's set \<Rightarrow> ('s \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 'p) \<Rightarrow>
+             ('s \<Rightarrow> 's \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> ('s,'p,'f) com) \<Rightarrow> ('s,'p,'f) com" where
+  "dynCall_exn f g init p return result_exn c =
+    maybe_guard f g (DynCom (\<lambda>s. call_exn init (p s) return result_exn c))"
+
+definition
   block:: "['s\<Rightarrow>'s,('s,'p,'f) com,'s\<Rightarrow>'s\<Rightarrow>'s,'s\<Rightarrow>'s\<Rightarrow>('s,'p,'f) com]\<Rightarrow>('s,'p,'f) com"
 where
-  "block init bdy return c =
-    DynCom (\<lambda>s. (Seq (Catch (Seq (Basic init) bdy) (Seq (Basic (return s)) Throw))
-                            (DynCom (\<lambda>t. Seq (Basic (return s)) (c s t))))
-                        )"
+  "block init bdy return c = block_exn init bdy return (\<lambda>s t. s) c"
+
 
 definition
   call:: "('s\<Rightarrow>'s) \<Rightarrow> 'p \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> 's)\<Rightarrow>('s\<Rightarrow>'s\<Rightarrow>('s,'p,'f) com)\<Rightarrow>('s,'p,'f)com" where
   "call init p return c = block init (Call p) return c"
 
 definition
   dynCall:: "('s \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 'p) \<Rightarrow>
              ('s \<Rightarrow> 's \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> ('s,'p,'f) com) \<Rightarrow> ('s,'p,'f) com" where
   "dynCall init p return c = DynCom (\<lambda>s. call init (p s) return c)"
 
+
+
 definition
   fcall:: "('s\<Rightarrow>'s) \<Rightarrow> 'p \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> 's)\<Rightarrow>('s \<Rightarrow> 'v) \<Rightarrow> ('v\<Rightarrow>('s,'p,'f) com)
             \<Rightarrow>('s,'p,'f)com" where
   "fcall init p return result c = call init p return (\<lambda>s t. c (result t))"
 
+
 definition
   lem:: "'x \<Rightarrow> ('s,'p,'f)com \<Rightarrow>('s,'p,'f)com" where
   "lem x c = c"
 
 primrec switch:: "('s \<Rightarrow> 'v) \<Rightarrow> ('v set \<times> ('s,'p,'f) com) list \<Rightarrow> ('s,'p,'f) com"
 where
 "switch v [] = Skip" |
 "switch v (Vc#vs) = Cond {s. v s \<in> fst Vc} (snd Vc) (switch v vs)"
 
 definition guaranteeStrip:: "'f \<Rightarrow> 's set \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
   where "guaranteeStrip f g c = Guard f g c"
 
 definition guaranteeStripPair:: "'f \<Rightarrow> 's set \<Rightarrow> ('f \<times> 's set)"
   where "guaranteeStripPair f g = (f,g)"
 
-primrec guards:: "('f \<times> 's set ) list \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
-where
-"guards [] c = c" |
-"guards (g#gs) c = Guard (fst g) (snd g) (guards gs c)"
 
 definition
   while::  "('f \<times> 's set) list \<Rightarrow> 's bexp \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s, 'p, 'f) com"
 where
   "while gs b c = guards gs (While b (Seq c (guards gs Skip)))"
 
 definition
   whileAnno::
   "'s bexp \<Rightarrow> 's assn \<Rightarrow> ('s \<times> 's) assn \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com" where
   "whileAnno b I V c = While b c"
 
 definition
   whileAnnoG::
   "('f \<times> 's set) list \<Rightarrow> 's bexp \<Rightarrow> 's assn \<Rightarrow> ('s \<times> 's) assn \<Rightarrow>
      ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com" where
   "whileAnnoG gs b I V c = while gs b c"
 
 definition
   specAnno::  "('a \<Rightarrow> 's assn) \<Rightarrow> ('a \<Rightarrow> ('s,'p,'f) com) \<Rightarrow>
                          ('a \<Rightarrow> 's assn) \<Rightarrow> ('a \<Rightarrow> 's assn) \<Rightarrow> ('s,'p,'f) com"
   where "specAnno P c Q A = (c undefined)"
 
 definition
   whileAnnoFix::
   "'s bexp \<Rightarrow> ('a \<Rightarrow> 's assn) \<Rightarrow> ('a \<Rightarrow> ('s \<times> 's) assn) \<Rightarrow> ('a \<Rightarrow> ('s,'p,'f) com) \<Rightarrow>
      ('s,'p,'f) com" where
   "whileAnnoFix b I V c = While b (c undefined)"
 
 definition
   whileAnnoGFix::
   "('f \<times> 's set) list \<Rightarrow> 's bexp \<Rightarrow> ('a \<Rightarrow> 's assn) \<Rightarrow> ('a \<Rightarrow> ('s \<times> 's) assn) \<Rightarrow>
      ('a \<Rightarrow> ('s,'p,'f) com) \<Rightarrow> ('s,'p,'f) com" where
   "whileAnnoGFix gs b I V c = while gs b (c undefined)"
 
 definition if_rel::"('s \<Rightarrow> bool) \<Rightarrow> ('s \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> 's) \<Rightarrow> ('s \<times> 's) set"
   where "if_rel b f g h = {(s,t). if b s then t = f s else t = g s \<or> t = h s}"
 
 lemma fst_guaranteeStripPair: "fst (guaranteeStripPair f g) = f"
   by (simp add: guaranteeStripPair_def)
 
 lemma snd_guaranteeStripPair: "snd (guaranteeStripPair f g) = g"
   by (simp add: guaranteeStripPair_def)
 
 
+lemma call_call_exn: "call init p return result = call_exn init p return (\<lambda>s t. s) result"
+  by (simp add: call_def call_exn_def block_def)
+
+lemma dynCall_dynCall_exn: "dynCall init p return result = dynCall_exn undefined UNIV init p return (\<lambda>s t. s) result"
+  by (simp add: dynCall_def dynCall_exn_def call_call_exn)
+
+
 subsection \<open>Operations on Simpl-Syntax\<close>
 
 
 subsubsection \<open>Normalisation of Sequential Composition: \<open>sequence\<close>, \<open>flatten\<close> and \<open>normalize\<close>\<close>
 
 primrec flatten:: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com list"
 where
 "flatten Skip = [Skip]" |
 "flatten (Basic f) = [Basic f]" |
 "flatten (Spec r) = [Spec r]" |
 "flatten (Seq c\<^sub>1 c\<^sub>2)  = flatten c\<^sub>1 @ flatten c\<^sub>2" |
 "flatten (Cond b c\<^sub>1 c\<^sub>2) = [Cond b c\<^sub>1 c\<^sub>2]" |
 "flatten (While b c) = [While b c]" |
 "flatten (Call p) = [Call p]" |
 "flatten (DynCom c) = [DynCom c]" |
 "flatten (Guard f g c) = [Guard f g c]" |
 "flatten Throw = [Throw]" |
 "flatten (Catch c\<^sub>1 c\<^sub>2) = [Catch c\<^sub>1 c\<^sub>2]"
 
 primrec sequence:: "(('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com) \<Rightarrow>
                       ('s,'p,'f) com list \<Rightarrow> ('s,'p,'f) com"
 where
 "sequence seq [] = Skip" |
 "sequence seq (c#cs) = (case cs of [] \<Rightarrow> c
                         | _ \<Rightarrow> seq c (sequence seq cs))"
 
 
 primrec normalize:: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
 where
 "normalize Skip = Skip" |
 "normalize (Basic f) = Basic f" |
 "normalize (Spec r) = Spec r" |
 "normalize (Seq c\<^sub>1 c\<^sub>2)  = sequence Seq
                             ((flatten (normalize c\<^sub>1)) @ (flatten (normalize c\<^sub>2)))" |
 "normalize (Cond b c\<^sub>1 c\<^sub>2) = Cond b (normalize c\<^sub>1) (normalize c\<^sub>2)" |
 "normalize (While b c) = While b (normalize c)" |
 "normalize (Call p) = Call p" |
 "normalize (DynCom c) = DynCom (\<lambda>s. (normalize (c s)))" |
 "normalize (Guard f g c) = Guard f g (normalize c)" |
 "normalize Throw = Throw" |
 "normalize (Catch c\<^sub>1 c\<^sub>2) = Catch (normalize c\<^sub>1) (normalize c\<^sub>2)"
 
 
 lemma flatten_nonEmpty: "flatten c \<noteq> []"
   by (induct c) simp_all
 
 lemma flatten_single: "\<forall>c \<in> set (flatten c'). flatten c = [c]"
 apply (induct c')
 apply           simp
 apply          simp
 apply         simp
 apply        (simp (no_asm_use) )
 apply        blast
 apply       (simp (no_asm_use) )
 apply      (simp (no_asm_use) )
 apply     simp
 apply    (simp (no_asm_use))
 apply   (simp (no_asm_use))
 apply  simp
 apply (simp (no_asm_use))
 done
 
 
 lemma flatten_sequence_id:
   "\<lbrakk>cs\<noteq>[];\<forall>c \<in> set cs. flatten c = [c]\<rbrakk> \<Longrightarrow> flatten (sequence Seq cs) = cs"
   apply (induct cs)
   apply  simp
   apply (case_tac cs)
   apply  simp
   apply auto
   done
 
 
 lemma flatten_app:
   "flatten (sequence Seq (flatten c1 @ flatten c2)) = flatten c1 @ flatten c2"
   apply (rule flatten_sequence_id)
   apply (simp add: flatten_nonEmpty)
   apply (simp)
   apply (insert flatten_single)
   apply blast
   done
 
 
 
 lemma flatten_sequence_flatten: "flatten (sequence Seq (flatten c)) = flatten c"
   apply (induct c)
   apply (auto simp add: flatten_app)
   done
 
 lemma sequence_flatten_normalize: "sequence Seq (flatten (normalize c)) = normalize c"
 apply (induct c)
 apply (auto simp add:  flatten_app)
 done
 
 
 lemma flatten_normalize: "\<And>x xs. flatten (normalize c) = x#xs
        \<Longrightarrow> (case xs of [] \<Rightarrow> normalize c = x
               | (x'#xs') \<Rightarrow> normalize c= Seq x (sequence Seq xs))"
 proof (induct c)
   case (Seq c1 c2)
   have "flatten (normalize (Seq c1 c2)) = x # xs" by fact
   hence "flatten (sequence Seq (flatten (normalize c1) @ flatten (normalize c2))) =
           x#xs"
     by simp
   hence x_xs: "flatten (normalize c1) @ flatten (normalize c2) = x # xs"
     by (simp add: flatten_app)
   show ?case
   proof (cases "flatten (normalize c1)")
     case Nil
     with flatten_nonEmpty show ?thesis by auto
   next
     case (Cons x1 xs1)
     note Cons_x1_xs1 = this
     with x_xs obtain
       x_x1: "x=x1" and xs_rest: "xs=xs1@flatten (normalize c2)"
       by auto
     show ?thesis
     proof (cases xs1)
       case Nil
       from Seq.hyps (1) [OF Cons_x1_xs1] Nil
       have "normalize c1 = x1"
         by simp
       with Cons_x1_xs1 Nil x_x1 xs_rest show ?thesis
         apply (cases "flatten (normalize c2)")
         apply (fastforce simp add: flatten_nonEmpty)
         apply simp
         done
     next
       case Cons
       from Seq.hyps (1) [OF Cons_x1_xs1] Cons
       have "normalize c1 = Seq x1 (sequence Seq xs1)"
         by simp
       with Cons_x1_xs1 Nil x_x1 xs_rest show ?thesis
         apply (cases "flatten (normalize c2)")
         apply (fastforce simp add: flatten_nonEmpty)
         apply (simp split: list.splits)
         done
     qed
   qed
 qed (auto)
 
 lemma flatten_raise [simp]: "flatten (raise f) = [Basic f, Throw]"
   by (simp add: raise_def)
 
 lemma flatten_condCatch [simp]: "flatten (condCatch c1 b c2) = [condCatch c1 b c2]"
   by (simp add: condCatch_def)
 
 lemma flatten_bind [simp]: "flatten (bind e c) = [bind e c]"
   by (simp add: bind_def)
 
 lemma flatten_bseq [simp]: "flatten (bseq c1 c2) = flatten c1 @ flatten c2"
   by (simp add: bseq_def)
 
+lemma flatten_block_exn [simp]:
+  "flatten (block_exn init bdy return result_exn result) = [block_exn init bdy return result_exn result]"
+  by (simp add: block_exn_def)
+
 lemma flatten_block [simp]:
   "flatten (block init bdy return result) = [block init bdy return result]"
   by (simp add: block_def)
 
 lemma flatten_call [simp]: "flatten (call init p return result) = [call init p return result]"
   by (simp add: call_def)
 
 lemma flatten_dynCall [simp]: "flatten (dynCall init p return result) = [dynCall init p return result]"
   by (simp add: dynCall_def)
 
+lemma flatten_call_exn [simp]: "flatten (call_exn init p return result_exn result) = [call_exn init p return result_exn result]"
+  by (simp add: call_exn_def)
+
+lemma flatten_dynCall_exn [simp]: "flatten (dynCall_exn f g init p return result_exn result) = [dynCall_exn f g init p return result_exn result]"
+  by (simp add: dynCall_exn_def maybe_guard_def)
+
 lemma flatten_fcall [simp]: "flatten (fcall init p return result c) = [fcall init p return result c]"
   by (simp add: fcall_def)
 
 lemma flatten_switch [simp]: "flatten (switch v Vcs) = [switch v Vcs]"
   by (cases Vcs) auto
 
 lemma flatten_guaranteeStrip [simp]:
   "flatten (guaranteeStrip f g c) = [guaranteeStrip f g c]"
   by (simp add: guaranteeStrip_def)
 
 lemma flatten_while [simp]: "flatten (while gs b c) = [while gs b c]"
   apply (simp add: while_def)
   apply (induct gs)
   apply  auto
   done
 
 lemma flatten_whileAnno [simp]:
   "flatten (whileAnno b I V c) = [whileAnno b I V c]"
   by (simp add: whileAnno_def)
 
 lemma flatten_whileAnnoG [simp]:
   "flatten (whileAnnoG gs b I V c) = [whileAnnoG gs b I V c]"
   by (simp add: whileAnnoG_def)
 
 lemma flatten_specAnno [simp]:
   "flatten (specAnno P c Q A) = flatten (c undefined)"
   by (simp add: specAnno_def)
 
 lemmas flatten_simps = flatten.simps flatten_raise flatten_condCatch flatten_bind
   flatten_block flatten_call flatten_dynCall flatten_fcall flatten_switch
   flatten_guaranteeStrip
   flatten_while flatten_whileAnno flatten_whileAnnoG flatten_specAnno
 
 lemma normalize_raise [simp]:
  "normalize (raise f) = raise f"
   by (simp add: raise_def)
 
 lemma normalize_condCatch [simp]:
  "normalize (condCatch c1 b c2) = condCatch (normalize c1) b (normalize c2)"
   by (simp add: condCatch_def)
 
 lemma normalize_bind [simp]:
  "normalize (bind e c) = bind e (\<lambda>v. normalize (c v))"
   by (simp add: bind_def)
 
 lemma normalize_bseq [simp]:
  "normalize (bseq c1 c2) = sequence bseq
                             ((flatten (normalize c1)) @ (flatten (normalize c2)))"
   by (simp add: bseq_def)
 
-lemma normalize_block [simp]: "normalize (block init bdy return c) =
-                         block init (normalize bdy) return (\<lambda>s t. normalize (c s t))"
-  apply (simp add: block_def)
+lemma normalize_block_exn [simp]: "normalize (block_exn init bdy return result_exn c) =
+                         block_exn init (normalize bdy) return result_exn (\<lambda>s t. normalize (c s t))"
+  apply (simp add: block_exn_def)
   apply (rule ext)
   apply (simp)
   apply (cases "flatten (normalize bdy)")
   apply  (simp add: flatten_nonEmpty)
   apply (rule conjI)
   apply  simp
   apply  (drule flatten_normalize)
   apply  (case_tac list)
   apply   simp
   apply  simp
   apply (rule ext)
   apply (case_tac "flatten (normalize (c s sa))")
   apply  (simp add: flatten_nonEmpty)
   apply  simp
   apply (thin_tac "flatten (normalize bdy) = P" for P)
   apply (drule flatten_normalize)
   apply (case_tac lista)
   apply  simp
   apply simp
   done
 
+lemma normalize_block [simp]: "normalize (block init bdy return c) =
+                         block init (normalize bdy) return (\<lambda>s t. normalize (c s t))"
+  by (simp add: block_def)
+
 lemma normalize_call [simp]:
   "normalize (call init p return c) = call init p return (\<lambda>i t. normalize (c i t))"
   by (simp add: call_def)
 
+lemma normalize_call_exn [simp]:
+  "normalize (call_exn init p return result_exn c) = call_exn init p return result_exn (\<lambda>i t. normalize (c i t))"
+  by (simp add: call_exn_def)
+
 lemma normalize_dynCall [simp]:
   "normalize (dynCall init p return c) =
     dynCall init p return (\<lambda>s t. normalize (c s t))"
   by (simp add: dynCall_def)
 
+lemma normalize_guards [simp]:
+  "normalize (guards gs c) = guards gs (normalize c)"
+  by (induct gs) auto
+
+lemma normalize_dynCall_exn [simp]:
+  "normalize (dynCall_exn f g init p return result_exn c) =
+    dynCall_exn f g init p return result_exn (\<lambda>s t. normalize (c s t))"
+  by  (simp add: dynCall_exn_def maybe_guard_def)
+
 lemma normalize_fcall [simp]:
   "normalize (fcall init p return result c) =
     fcall init p return result (\<lambda>v. normalize (c v))"
   by (simp add: fcall_def)
 
 lemma normalize_switch [simp]:
   "normalize (switch v Vcs) = switch v (map (\<lambda>(V,c). (V,normalize c)) Vcs)"
 apply (induct Vcs)
 apply auto
 done
 
 lemma normalize_guaranteeStrip [simp]:
   "normalize (guaranteeStrip f g c) = guaranteeStrip f g (normalize c)"
   by (simp add: guaranteeStrip_def)
 
-lemma normalize_guards [simp]:
-  "normalize (guards gs c) = guards gs (normalize c)"
-  by (induct gs) auto
 
 text \<open>Sequencial composition with guards in the body is not preserved by
         normalize\<close>
 lemma normalize_while [simp]:
   "normalize (while gs b c) = guards gs
       (While b (sequence Seq (flatten (normalize c) @ flatten (guards gs Skip))))"
   by (simp add: while_def)
 
 lemma normalize_whileAnno [simp]:
   "normalize (whileAnno b I V c) = whileAnno b I V (normalize c)"
   by (simp add: whileAnno_def)
 
 lemma normalize_whileAnnoG [simp]:
   "normalize (whileAnnoG gs b I V c) = guards gs
       (While b (sequence Seq (flatten (normalize c) @ flatten (guards gs Skip))))"
   by (simp add: whileAnnoG_def)
 
 lemma normalize_specAnno [simp]:
   "normalize (specAnno P c Q A) = specAnno P (\<lambda>s. normalize (c undefined)) Q A"
   by (simp add: specAnno_def)
 
 lemmas normalize_simps =
   normalize.simps normalize_raise normalize_condCatch normalize_bind
   normalize_block normalize_call normalize_dynCall normalize_fcall normalize_switch
   normalize_guaranteeStrip normalize_guards
   normalize_while normalize_whileAnno normalize_whileAnnoG normalize_specAnno
 
 
 subsubsection \<open>Stripping Guards: \<open>strip_guards\<close>\<close>
 
 primrec strip_guards:: "'f set \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
 where
 "strip_guards F Skip = Skip" |
 "strip_guards F (Basic f) = Basic f" |
 "strip_guards F (Spec r) = Spec r" |
 "strip_guards F (Seq c\<^sub>1 c\<^sub>2)  = (Seq (strip_guards F c\<^sub>1) (strip_guards F c\<^sub>2))" |
 "strip_guards F (Cond b c\<^sub>1 c\<^sub>2) = Cond b (strip_guards F c\<^sub>1) (strip_guards F c\<^sub>2)" |
 "strip_guards F (While b c) = While b (strip_guards F c)" |
 "strip_guards F (Call p) = Call p" |
 "strip_guards F (DynCom c) = DynCom (\<lambda>s. (strip_guards F (c s)))" |
 "strip_guards F (Guard f g c) = (if f \<in> F then strip_guards F c
                                   else Guard f g (strip_guards F c))" |
 "strip_guards F Throw = Throw" |
 "strip_guards F (Catch c\<^sub>1 c\<^sub>2) = Catch (strip_guards F c\<^sub>1) (strip_guards F c\<^sub>2)"
 
 definition strip:: "'f set \<Rightarrow>
                    ('p \<Rightarrow> ('s,'p,'f) com option) \<Rightarrow> ('p \<Rightarrow> ('s,'p,'f) com option)"
   where "strip F \<Gamma> = (\<lambda>p. map_option (strip_guards F) (\<Gamma> p))"
 
 
 lemma strip_simp [simp]: "(strip F \<Gamma>) p = map_option (strip_guards F) (\<Gamma> p)"
   by (simp add: strip_def)
 
 lemma dom_strip: "dom (strip F \<Gamma>) = dom \<Gamma>"
   by (auto)
 
 lemma strip_guards_idem: "strip_guards F (strip_guards F c) = strip_guards F c"
   by (induct c) auto
 
 lemma strip_idem: "strip F (strip F \<Gamma>) = strip F \<Gamma>"
   apply (rule ext)
   apply (case_tac "\<Gamma> x")
   apply (auto simp add: strip_guards_idem strip_def)
   done
 
 lemma strip_guards_raise [simp]:
   "strip_guards F (raise f) = raise f"
   by (simp add: raise_def)
 
 lemma strip_guards_condCatch [simp]:
   "strip_guards F (condCatch c1 b c2) =
     condCatch (strip_guards F c1) b (strip_guards F c2)"
   by (simp add: condCatch_def)
 
 lemma strip_guards_bind [simp]:
   "strip_guards F (bind e c) = bind e (\<lambda>v. strip_guards F (c v))"
   by (simp add: bind_def)
 
 lemma strip_guards_bseq [simp]:
   "strip_guards F (bseq c1 c2) = bseq (strip_guards F c1) (strip_guards F c2)"
   by (simp add: bseq_def)
 
+lemma strip_guards_block_exn [simp]:
+  "strip_guards F (block_exn init bdy return result_exn c) =
+    block_exn init (strip_guards F bdy) return result_exn (\<lambda>s t. strip_guards F (c s t))"
+  by (simp add: block_exn_def)
+
 lemma strip_guards_block [simp]:
   "strip_guards F (block init bdy return c) =
     block init (strip_guards F bdy) return (\<lambda>s t. strip_guards F (c s t))"
   by (simp add: block_def)
 
 lemma strip_guards_call [simp]:
   "strip_guards F (call init p return c) =
      call init p return (\<lambda>s t. strip_guards F (c s t))"
   by (simp add: call_def)
 
+lemma strip_guards_call_exn [simp]:
+  "strip_guards F (call_exn init p return result_exn c) =
+     call_exn init p return result_exn (\<lambda>s t. strip_guards F (c s t))"
+  by (simp add: call_exn_def)
+
 lemma strip_guards_dynCall [simp]:
   "strip_guards F (dynCall init p return c) =
      dynCall init p return (\<lambda>s t. strip_guards F (c s t))"
   by (simp add: dynCall_def)
 
+lemma strip_guards_guards [simp]: "strip_guards F (guards gs c) =
+        guards (filter (\<lambda>(f,g). f \<notin> F) gs) (strip_guards F c)"
+  by (induct gs) auto
+
+lemma strip_guards_dynCall_exn [simp]:
+  "strip_guards F (dynCall_exn f g init p return result_exn c) =
+     dynCall_exn f (if f \<in> F then UNIV else g) init p return result_exn (\<lambda>s t. strip_guards F (c s t))"
+  by (simp add: dynCall_exn_def maybe_guard_def)
+
 lemma strip_guards_fcall [simp]:
   "strip_guards F (fcall init p return result c) =
      fcall init p return result (\<lambda>v. strip_guards F (c v))"
   by (simp add: fcall_def)
 
 lemma strip_guards_switch [simp]:
   "strip_guards F (switch v Vc) =
     switch v (map (\<lambda>(V,c). (V,strip_guards F c)) Vc)"
   by (induct Vc) auto
 
 lemma strip_guards_guaranteeStrip [simp]:
   "strip_guards F (guaranteeStrip f g c) =
     (if f \<in> F then strip_guards F c
      else guaranteeStrip f g (strip_guards F c))"
   by (simp add: guaranteeStrip_def)
 
 lemma guaranteeStripPair_split_conv [simp]: "case_prod c (guaranteeStripPair f g) = c f g"
   by (simp add: guaranteeStripPair_def)
 
-lemma strip_guards_guards [simp]: "strip_guards F (guards gs c) =
-        guards (filter (\<lambda>(f,g). f \<notin> F) gs) (strip_guards F c)"
-  by (induct gs) auto
+
 
 lemma strip_guards_while [simp]:
  "strip_guards F (while gs b  c) =
      while (filter (\<lambda>(f,g). f \<notin> F) gs) b (strip_guards F c)"
   by (simp add: while_def)
 
 lemma strip_guards_whileAnno [simp]:
  "strip_guards F (whileAnno b I V c) = whileAnno b I V (strip_guards F c)"
   by (simp add: whileAnno_def  while_def)
 
 lemma strip_guards_whileAnnoG [simp]:
  "strip_guards F (whileAnnoG gs b I V c) =
      whileAnnoG (filter (\<lambda>(f,g). f \<notin> F) gs) b I V (strip_guards F c)"
   by (simp add: whileAnnoG_def)
 
 lemma strip_guards_specAnno [simp]:
   "strip_guards F (specAnno P c Q A) =
     specAnno P (\<lambda>s. strip_guards F (c undefined)) Q A"
   by (simp add: specAnno_def)
 
 lemmas strip_guards_simps = strip_guards.simps strip_guards_raise
   strip_guards_condCatch strip_guards_bind strip_guards_bseq strip_guards_block
   strip_guards_dynCall strip_guards_fcall strip_guards_switch
   strip_guards_guaranteeStrip guaranteeStripPair_split_conv strip_guards_guards
   strip_guards_while strip_guards_whileAnno strip_guards_whileAnnoG
   strip_guards_specAnno
 
 subsubsection \<open>Marking Guards: \<open>mark_guards\<close>\<close>
 
 primrec mark_guards:: "'f \<Rightarrow> ('s,'p,'g) com \<Rightarrow> ('s,'p,'f) com"
 where
 "mark_guards f Skip = Skip" |
 "mark_guards f (Basic g) = Basic g" |
 "mark_guards f (Spec r) = Spec r" |
 "mark_guards f (Seq c\<^sub>1 c\<^sub>2)  = (Seq (mark_guards f c\<^sub>1) (mark_guards f c\<^sub>2))" |
 "mark_guards f (Cond b c\<^sub>1 c\<^sub>2) = Cond b (mark_guards f c\<^sub>1) (mark_guards f c\<^sub>2)" |
 "mark_guards f (While b c) = While b (mark_guards f c)" |
 "mark_guards f (Call p) = Call p" |
 "mark_guards f (DynCom c) = DynCom (\<lambda>s. (mark_guards f (c s)))" |
 "mark_guards f (Guard f' g c) = Guard f g (mark_guards f c)" |
 "mark_guards f Throw = Throw" |
 "mark_guards f (Catch c\<^sub>1 c\<^sub>2) = Catch (mark_guards f c\<^sub>1) (mark_guards f c\<^sub>2)"
 
 lemma mark_guards_raise: "mark_guards f (raise g) = raise g"
   by (simp add: raise_def)
 
 lemma mark_guards_condCatch [simp]:
   "mark_guards f (condCatch c1 b c2) =
     condCatch (mark_guards f c1) b (mark_guards f c2)"
   by (simp add: condCatch_def)
 
 lemma mark_guards_bind [simp]:
   "mark_guards f (bind e c) = bind e (\<lambda>v. mark_guards f (c v))"
   by (simp add: bind_def)
 
 lemma mark_guards_bseq [simp]:
   "mark_guards f (bseq c1 c2) = bseq (mark_guards f c1) (mark_guards f c2)"
   by (simp add: bseq_def)
 
+lemma mark_guards_block_exn [simp]:
+  "mark_guards f (block_exn init bdy return result_exn c) =
+    block_exn init (mark_guards f bdy) return result_exn (\<lambda>s t. mark_guards f (c s t))"
+  by (simp add: block_exn_def)
+
 lemma mark_guards_block [simp]:
   "mark_guards f (block init bdy return c) =
     block init (mark_guards f bdy) return (\<lambda>s t. mark_guards f (c s t))"
   by (simp add: block_def)
 
 lemma mark_guards_call [simp]:
   "mark_guards f (call init p return c) =
      call init p return (\<lambda>s t. mark_guards f (c s t))"
   by (simp add: call_def)
 
+lemma mark_guards_call_exn [simp]:
+  "mark_guards f (call_exn init p return result_exn c) =
+     call_exn init p return result_exn (\<lambda>s t. mark_guards f (c s t))"
+  by (simp add: call_exn_def)
+
 lemma mark_guards_dynCall [simp]:
   "mark_guards f (dynCall init p return c) =
      dynCall init p return (\<lambda>s t. mark_guards f (c s t))"
   by (simp add: dynCall_def)
 
+lemma mark_guards_guards [simp]:
+  "mark_guards f (guards gs c) = guards (map (\<lambda>(f',g). (f,g)) gs) (mark_guards f c)"
+  by (induct gs) auto
+
+lemma mark_guards_dynCall_exn [simp]:
+  "mark_guards f (dynCall_exn f' g init p return result_exn c) =
+     dynCall_exn f g init p return result_exn (\<lambda>s t. mark_guards f (c s t))"
+  by (simp add: dynCall_exn_def maybe_guard_def)
+
 lemma mark_guards_fcall [simp]:
   "mark_guards f (fcall init p return result c) =
      fcall init p return result (\<lambda>v. mark_guards f (c v))"
   by (simp add: fcall_def)
 
 lemma mark_guards_switch [simp]:
   "mark_guards f (switch v vs) =
      switch v (map (\<lambda>(V,c). (V,mark_guards f c)) vs)"
   by (induct vs) auto
 
 lemma mark_guards_guaranteeStrip [simp]:
   "mark_guards f (guaranteeStrip f' g c) = guaranteeStrip f g (mark_guards f c)"
   by (simp add: guaranteeStrip_def)
 
-lemma mark_guards_guards [simp]:
-  "mark_guards f (guards gs c) = guards (map (\<lambda>(f',g). (f,g)) gs) (mark_guards f c)"
-  by (induct gs) auto
 
 lemma mark_guards_while [simp]:
  "mark_guards f (while gs b c) =
     while (map (\<lambda>(f',g). (f,g)) gs) b (mark_guards f c)"
   by (simp add: while_def)
 
 lemma mark_guards_whileAnno [simp]:
  "mark_guards f (whileAnno b I V c) = whileAnno b I V (mark_guards f c)"
   by (simp add: whileAnno_def while_def)
 
 lemma mark_guards_whileAnnoG [simp]:
  "mark_guards f (whileAnnoG gs b I V c) =
     whileAnnoG (map (\<lambda>(f',g). (f,g)) gs) b I V (mark_guards f c)"
   by (simp add: whileAnno_def whileAnnoG_def while_def)
 
 lemma mark_guards_specAnno [simp]:
   "mark_guards f (specAnno P c Q A) =
     specAnno P (\<lambda>s. mark_guards f (c undefined)) Q A"
   by (simp add: specAnno_def)
 
 lemmas mark_guards_simps = mark_guards.simps mark_guards_raise
   mark_guards_condCatch mark_guards_bind mark_guards_bseq mark_guards_block
   mark_guards_dynCall mark_guards_fcall mark_guards_switch
   mark_guards_guaranteeStrip guaranteeStripPair_split_conv mark_guards_guards
   mark_guards_while mark_guards_whileAnno mark_guards_whileAnnoG
   mark_guards_specAnno
 
 definition is_Guard:: "('s,'p,'f) com \<Rightarrow> bool"
   where "is_Guard c = (case c of Guard f g c' \<Rightarrow> True | _ \<Rightarrow> False)"
 lemma is_Guard_basic_simps [simp]:
+ "is_Guard (guards (pg# pgs) c) = True"
  "is_Guard Skip = False"
  "is_Guard (Basic f) = False"
  "is_Guard (Spec r) = False"
  "is_Guard (Seq c1 c2) = False"
  "is_Guard (Cond b c1 c2) = False"
  "is_Guard (While b c) = False"
  "is_Guard (Call p) = False"
  "is_Guard (DynCom C) = False"
  "is_Guard (Guard F g c) = True"
  "is_Guard (Throw) = False"
  "is_Guard (Catch c1 c2) = False"
  "is_Guard (raise f) = False"
  "is_Guard (condCatch c1 b c2) = False"
  "is_Guard (bind e cv) = False"
  "is_Guard (bseq c1 c2) = False"
+ "is_Guard (block_exn init bdy return result_exn cont) = False"
  "is_Guard (block init bdy return cont) = False"
  "is_Guard (call init p return cont) = False"
  "is_Guard (dynCall init P return cont) = False"
+ "is_Guard (call_exn init p return result_exn cont) = False"
+ "is_Guard (dynCall_exn f UNIV init P return result_exn cont) = False"
  "is_Guard (fcall init p return result cont') = False"
  "is_Guard (whileAnno b I V c) = False"
  "is_Guard (guaranteeStrip F g c) = True"
   by (auto simp add: is_Guard_def raise_def condCatch_def bind_def bseq_def
-          block_def call_def dynCall_def fcall_def whileAnno_def guaranteeStrip_def)
+          block_def block_exn_def call_def dynCall_def call_exn_def dynCall_exn_def
+          fcall_def whileAnno_def guaranteeStrip_def)
 
 
 lemma is_Guard_switch [simp]:
  "is_Guard (switch v Vc) = False"
   by (induct Vc) auto
 
 lemmas is_Guard_simps = is_Guard_basic_simps is_Guard_switch
 
 primrec dest_Guard:: "('s,'p,'f) com \<Rightarrow> ('f \<times> 's set \<times> ('s,'p,'f) com)"
   where "dest_Guard (Guard f g c) = (f,g,c)"
 
 lemma dest_Guard_guaranteeStrip [simp]: "dest_Guard (guaranteeStrip f g c) = (f,g,c)"
   by (simp add: guaranteeStrip_def)
 
 lemmas dest_Guard_simps = dest_Guard.simps dest_Guard_guaranteeStrip
 
 subsubsection \<open>Merging Guards: \<open>merge_guards\<close>\<close>
 
 primrec merge_guards:: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
 where
 "merge_guards Skip = Skip" |
 "merge_guards (Basic g) = Basic g" |
 "merge_guards (Spec r) = Spec r" |
 "merge_guards (Seq c\<^sub>1 c\<^sub>2)  = (Seq (merge_guards c\<^sub>1) (merge_guards c\<^sub>2))" |
 "merge_guards (Cond b c\<^sub>1 c\<^sub>2) = Cond b (merge_guards c\<^sub>1) (merge_guards c\<^sub>2)" |
 "merge_guards (While b c) = While b (merge_guards c)" |
 "merge_guards (Call p) = Call p" |
 "merge_guards (DynCom c) = DynCom (\<lambda>s. (merge_guards (c s)))" |
 (*"merge_guards (Guard f g c) =
     (case (merge_guards c) of
       Guard f' g' c' \<Rightarrow> if f=f' then Guard f (g \<inter> g') c'
                         else Guard f g (Guard f' g' c')
      | _ \<Rightarrow>  Guard f g (merge_guards c))"*)
 (* the following version works better with derived language constructs *)
 "merge_guards (Guard f g c) =
     (let c' = (merge_guards c)
      in if is_Guard c'
         then let (f',g',c'') = dest_Guard c'
              in if f=f' then Guard f (g \<inter> g') c''
                         else Guard f g (Guard f' g' c'')
         else Guard f g c')" |
 "merge_guards Throw = Throw" |
 "merge_guards (Catch c\<^sub>1 c\<^sub>2) = Catch (merge_guards c\<^sub>1) (merge_guards c\<^sub>2)"
 
 lemma merge_guards_res_Skip: "merge_guards c = Skip \<Longrightarrow> c = Skip"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Basic: "merge_guards c = Basic f \<Longrightarrow> c = Basic f"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Spec: "merge_guards c = Spec r \<Longrightarrow> c = Spec r"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Seq: "merge_guards c = Seq c1 c2 \<Longrightarrow>
     \<exists>c1' c2'. c = Seq c1' c2' \<and> merge_guards c1' = c1 \<and> merge_guards c2' = c2"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Cond: "merge_guards c = Cond b c1 c2 \<Longrightarrow>
     \<exists>c1' c2'. c = Cond b c1' c2' \<and> merge_guards c1' = c1 \<and> merge_guards c2' = c2"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_While: "merge_guards c = While b c' \<Longrightarrow>
     \<exists>c''. c = While b c''  \<and> merge_guards c'' = c'"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Call: "merge_guards c = Call p \<Longrightarrow> c = Call p"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_DynCom: "merge_guards c = DynCom c' \<Longrightarrow>
     \<exists>c''. c = DynCom c''  \<and> (\<lambda>s. (merge_guards (c'' s))) = c'"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Throw: "merge_guards c = Throw \<Longrightarrow> c = Throw"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Catch: "merge_guards c = Catch c1 c2 \<Longrightarrow>
     \<exists>c1' c2'. c = Catch c1' c2' \<and> merge_guards c1' = c1 \<and> merge_guards c2' = c2"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemma merge_guards_res_Guard:
  "merge_guards c = Guard f g c' \<Longrightarrow> \<exists>c'' f' g'. c = Guard f' g' c''"
   by (cases c) (auto split: com.splits if_split_asm simp add: is_Guard_def Let_def)
 
 lemmas merge_guards_res_simps = merge_guards_res_Skip merge_guards_res_Basic
  merge_guards_res_Spec merge_guards_res_Seq merge_guards_res_Cond
  merge_guards_res_While merge_guards_res_Call
  merge_guards_res_DynCom merge_guards_res_Throw merge_guards_res_Catch
  merge_guards_res_Guard
 
+lemma merge_guards_guards_empty: "merge_guards (guards [] c) = merge_guards c"
+  by (simp)
+
 lemma merge_guards_raise: "merge_guards (raise g) = raise g"
   by (simp add: raise_def)
 
 lemma merge_guards_condCatch [simp]:
   "merge_guards (condCatch c1 b c2) =
     condCatch (merge_guards c1) b (merge_guards c2)"
   by (simp add: condCatch_def)
 
 lemma merge_guards_bind [simp]:
   "merge_guards (bind e c) = bind e (\<lambda>v. merge_guards (c v))"
   by (simp add: bind_def)
 
 lemma merge_guards_bseq [simp]:
   "merge_guards (bseq c1 c2) = bseq (merge_guards c1) (merge_guards c2)"
   by (simp add: bseq_def)
 
+lemma merge_guards_block_exn [simp]:
+  "merge_guards (block_exn init bdy return result_exn c) =
+    block_exn init (merge_guards bdy) return result_exn (\<lambda>s t. merge_guards (c s t))"
+  by (simp add: block_exn_def)
+
 lemma merge_guards_block [simp]:
   "merge_guards (block init bdy return c) =
     block init (merge_guards bdy) return (\<lambda>s t. merge_guards (c s t))"
   by (simp add: block_def)
 
 lemma merge_guards_call [simp]:
   "merge_guards (call init p return c) =
      call init p return (\<lambda>s t. merge_guards (c s t))"
   by (simp add: call_def)
 
+lemma merge_guards_call_exn [simp]:
+  "merge_guards (call_exn init p return result_exn c) =
+     call_exn init p return result_exn (\<lambda>s t. merge_guards (c s t))"
+  by (simp add: call_exn_def)
+
 lemma merge_guards_dynCall [simp]:
   "merge_guards (dynCall init p return c) =
      dynCall init p return (\<lambda>s t. merge_guards (c s t))"
   by (simp add: dynCall_def)
 
 lemma merge_guards_fcall [simp]:
   "merge_guards (fcall init p return result c) =
      fcall init p return result (\<lambda>v. merge_guards (c v))"
   by (simp add: fcall_def)
 
 lemma merge_guards_switch [simp]:
   "merge_guards (switch v vs) =
      switch v (map (\<lambda>(V,c). (V,merge_guards c)) vs)"
   by (induct vs) auto
 
 lemma merge_guards_guaranteeStrip [simp]:
   "merge_guards (guaranteeStrip f g c) =
     (let c' = (merge_guards c)
      in if is_Guard c'
         then let (f',g',c') = dest_Guard c'
              in if f=f' then Guard f (g \<inter> g') c'
                         else Guard f g (Guard f' g' c')
         else Guard f g c')"
   by (simp add: guaranteeStrip_def)
 
 lemma merge_guards_whileAnno [simp]:
  "merge_guards (whileAnno b I V c) = whileAnno b I V (merge_guards c)"
   by (simp add: whileAnno_def while_def)
 
 lemma merge_guards_specAnno [simp]:
   "merge_guards (specAnno P c Q A) =
     specAnno P (\<lambda>s. merge_guards (c undefined)) Q A"
   by (simp add: specAnno_def)
 
 text \<open>@{term "merge_guards"} for guard-lists as in @{const guards}, @{const while}
  and @{const whileAnnoG} may have funny effects since the guard-list has to
  be merged with the body statement too.\<close>
 
 lemmas merge_guards_simps = merge_guards.simps merge_guards_raise
   merge_guards_condCatch merge_guards_bind merge_guards_bseq merge_guards_block
   merge_guards_dynCall merge_guards_fcall merge_guards_switch
+  merge_guards_block_exn merge_guards_call_exn
   merge_guards_guaranteeStrip merge_guards_whileAnno merge_guards_specAnno
 
 primrec noguards:: "('s,'p,'f) com \<Rightarrow> bool"
 where
 "noguards Skip = True" |
 "noguards (Basic f) = True" |
 "noguards (Spec r ) = True" |
 "noguards (Seq c\<^sub>1 c\<^sub>2)  = (noguards c\<^sub>1 \<and> noguards c\<^sub>2)" |
 "noguards (Cond b c\<^sub>1 c\<^sub>2) = (noguards c\<^sub>1 \<and> noguards c\<^sub>2)" |
 "noguards (While b c) = (noguards c)" |
 "noguards (Call p) = True" |
 "noguards (DynCom c) = (\<forall>s. noguards (c s))" |
 "noguards (Guard f g c) = False" |
 "noguards Throw = True" |
 "noguards (Catch c\<^sub>1 c\<^sub>2) = (noguards c\<^sub>1 \<and> noguards c\<^sub>2)"
 
 lemma noguards_strip_guards: "noguards (strip_guards UNIV c)"
   by (induct c) auto
 
 primrec nothrows:: "('s,'p,'f) com \<Rightarrow> bool"
 where
 "nothrows Skip = True" |
 "nothrows (Basic f) = True" |
 "nothrows (Spec r) = True" |
 "nothrows (Seq c\<^sub>1 c\<^sub>2)  = (nothrows c\<^sub>1 \<and> nothrows c\<^sub>2)" |
 "nothrows (Cond b c\<^sub>1 c\<^sub>2) = (nothrows c\<^sub>1 \<and> nothrows c\<^sub>2)" |
 "nothrows (While b c) = nothrows c" |
 "nothrows (Call p) = True" |
 "nothrows (DynCom c) = (\<forall>s. nothrows (c s))" |
 "nothrows (Guard f g c) = nothrows c" |
 "nothrows Throw = False" |
 "nothrows (Catch c\<^sub>1 c\<^sub>2) = (nothrows c\<^sub>1 \<and> nothrows c\<^sub>2)"
 
 subsubsection \<open>Intersecting Guards: \<open>c\<^sub>1 \<inter>\<^sub>g c\<^sub>2\<close>\<close>
 
 inductive_set com_rel ::"(('s,'p,'f) com \<times> ('s,'p,'f) com) set"
 where
   "(c1, Seq c1 c2) \<in> com_rel"
 | "(c2, Seq c1 c2) \<in> com_rel"
 | "(c1, Cond b c1 c2) \<in> com_rel"
 | "(c2, Cond b c1 c2) \<in> com_rel"
 | "(c, While b c) \<in> com_rel"
 | "(c x, DynCom c) \<in> com_rel"
 | "(c, Guard f g c) \<in> com_rel"
 | "(c1, Catch c1 c2) \<in> com_rel"
 | "(c2, Catch c1 c2) \<in> com_rel"
 
 inductive_cases com_rel_elim_cases:
  "(c, Skip) \<in> com_rel"
  "(c, Basic f) \<in> com_rel"
  "(c, Spec r) \<in> com_rel"
  "(c, Seq c1 c2) \<in> com_rel"
  "(c, Cond b c1 c2) \<in> com_rel"
  "(c, While b c1) \<in> com_rel"
  "(c, Call p) \<in> com_rel"
  "(c, DynCom c1) \<in> com_rel"
  "(c, Guard f g c1) \<in> com_rel"
  "(c, Throw) \<in> com_rel"
  "(c, Catch c1 c2) \<in> com_rel"
 
 lemma wf_com_rel: "wf com_rel"
 apply (rule wfUNIVI)
 apply (induct_tac x)
 apply           (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases)
 apply          (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases)
 apply         (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases)
 apply        (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases,
                simp,simp)
 apply       (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases,
               simp,simp)
 apply      (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases,simp)
 apply     (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases)
 apply    (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases,simp)
 apply   (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases,simp)
 apply  (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases)
 apply (erule allE, erule mp, (rule allI impI)+, erule com_rel_elim_cases,simp,simp)
 done
 
 consts inter_guards:: "('s,'p,'f) com \<times> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com option"
 
 abbreviation
   inter_guards_syntax :: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com option"
            ("_ \<inter>\<^sub>g _" [20,20] 19)
   where "c \<inter>\<^sub>g d == inter_guards (c,d)"
 
 recdef inter_guards "inv_image com_rel fst"
   "(Skip \<inter>\<^sub>g Skip) = Some Skip"
   "(Basic f1 \<inter>\<^sub>g Basic f2) = (if f1 = f2 then Some (Basic f1) else None)"
   "(Spec r1 \<inter>\<^sub>g Spec r2) = (if r1 = r2 then Some (Spec r1) else None)"
   "(Seq a1 a2 \<inter>\<^sub>g Seq b1 b2) =
      (case a1 \<inter>\<^sub>g b1 of
         None \<Rightarrow> None
       | Some c1 \<Rightarrow> (case a2 \<inter>\<^sub>g b2 of
           None \<Rightarrow> None
         | Some c2 \<Rightarrow> Some (Seq c1 c2)))"
   "(Cond cnd1 t1 e1 \<inter>\<^sub>g Cond cnd2 t2 e2) =
      (if cnd1 = cnd2
       then (case t1 \<inter>\<^sub>g t2 of
             None \<Rightarrow> None
           | Some t \<Rightarrow> (case e1 \<inter>\<^sub>g e2 of
               None \<Rightarrow> None
             | Some e \<Rightarrow> Some (Cond cnd1 t e)))
       else None)"
   "(While cnd1 c1 \<inter>\<^sub>g While cnd2 c2) =
       (if cnd1 = cnd2
        then (case c1 \<inter>\<^sub>g c2 of
            None \<Rightarrow> None
          | Some c \<Rightarrow> Some (While cnd1 c))
        else None)"
   "(Call p1 \<inter>\<^sub>g Call p2) =
      (if p1 = p2
       then Some (Call p1)
       else None)"
   "(DynCom P1 \<inter>\<^sub>g DynCom P2) =
      (if (\<forall>s. (P1 s \<inter>\<^sub>g P2 s) \<noteq> None)
      then Some (DynCom (\<lambda>s. the (P1 s \<inter>\<^sub>g P2 s)))
      else None)"
   "(Guard m1 g1 c1 \<inter>\<^sub>g Guard m2 g2 c2) =
      (if m1 = m2 then
        (case c1 \<inter>\<^sub>g c2 of
           None \<Rightarrow> None
         | Some c \<Rightarrow> Some (Guard m1 (g1 \<inter> g2) c))
       else None)"
   "(Throw \<inter>\<^sub>g Throw) = Some Throw"
   "(Catch a1 a2 \<inter>\<^sub>g Catch b1 b2) =
      (case a1 \<inter>\<^sub>g b1 of
         None \<Rightarrow> None
       | Some c1 \<Rightarrow> (case a2 \<inter>\<^sub>g b2 of
           None \<Rightarrow> None
         | Some c2 \<Rightarrow> Some (Catch c1 c2)))"
   "(c \<inter>\<^sub>g d) = None"
 (hints cong add: option.case_cong if_cong
        recdef_wf: wf_com_rel simp: com_rel.intros)
 
 lemma inter_guards_strip_eq:
   "\<And>c. (c1 \<inter>\<^sub>g c2) = Some c  \<Longrightarrow>
     (strip_guards UNIV c = strip_guards UNIV c1) \<and>
     (strip_guards UNIV c = strip_guards UNIV c2)"
 apply (induct c1 c2 rule: inter_guards.induct)
 prefer 8
 apply (simp split: if_split_asm)
 apply hypsubst
 apply simp
 apply (rule ext)
 apply (erule_tac x=s in allE, erule exE)
 apply (erule_tac x=s in allE)
 apply fastforce
 apply (fastforce split: option.splits if_split_asm)+
 done
 
 lemma inter_guards_sym: "\<And>c. (c1 \<inter>\<^sub>g c2) = Some c \<Longrightarrow> (c2 \<inter>\<^sub>g c1) = Some c"
 apply (induct c1 c2 rule: inter_guards.induct)
 apply (simp_all)
 prefer 7
 apply (simp split: if_split_asm add: not_None_eq)
 apply (rule conjI)
 apply  (clarsimp)
 apply  (rule ext)
 apply  (erule_tac x=s in allE)+
 apply  fastforce
 apply fastforce
 apply (fastforce split: option.splits if_split_asm)+
 done
 
 
 lemma inter_guards_Skip: "(Skip \<inter>\<^sub>g c2) = Some c = (c2=Skip \<and> c=Skip)"
   by (cases c2) auto
 
 lemma inter_guards_Basic:
   "((Basic f) \<inter>\<^sub>g c2) = Some c = (c2=Basic f \<and> c=Basic f)"
   by (cases c2) auto
 
 lemma inter_guards_Spec:
   "((Spec r) \<inter>\<^sub>g c2) = Some c = (c2=Spec r \<and> c=Spec r)"
   by (cases c2) auto
 
 lemma inter_guards_Seq:
   "(Seq a1 a2 \<inter>\<^sub>g c2) = Some c =
      (\<exists>b1 b2 d1 d2. c2=Seq b1 b2 \<and> (a1 \<inter>\<^sub>g b1) = Some d1 \<and>
         (a2 \<inter>\<^sub>g b2) = Some d2 \<and> c=Seq d1 d2)"
   by (cases c2) (auto split: option.splits)
 
 lemma inter_guards_Cond:
   "(Cond cnd t1 e1 \<inter>\<^sub>g c2) = Some c =
      (\<exists>t2 e2 t e. c2=Cond cnd t2 e2 \<and> (t1 \<inter>\<^sub>g t2) = Some t \<and>
         (e1 \<inter>\<^sub>g e2) = Some e \<and> c=Cond cnd t e)"
   by (cases c2) (auto split: option.splits)
 
 lemma inter_guards_While:
  "(While cnd bdy1 \<inter>\<^sub>g c2) = Some c =
      (\<exists>bdy2 bdy. c2 =While cnd bdy2 \<and> (bdy1 \<inter>\<^sub>g bdy2) = Some bdy \<and>
        c=While cnd bdy)"
   by (cases c2) (auto split: option.splits if_split_asm)
 
 lemma inter_guards_Call:
   "(Call p \<inter>\<^sub>g c2) = Some c =
      (c2=Call p \<and> c=Call p)"
   by (cases c2) (auto split: if_split_asm)
 
 lemma inter_guards_DynCom:
   "(DynCom f1 \<inter>\<^sub>g c2) = Some c =
      (\<exists>f2. c2=DynCom f2 \<and> (\<forall>s. ((f1 s) \<inter>\<^sub>g (f2 s)) \<noteq> None) \<and>
       c=DynCom (\<lambda>s. the ((f1 s) \<inter>\<^sub>g (f2 s))))"
   by (cases c2) (auto split: if_split_asm)
 
 
 lemma inter_guards_Guard:
   "(Guard f g1 bdy1 \<inter>\<^sub>g c2) = Some c =
      (\<exists>g2 bdy2 bdy. c2=Guard f g2 bdy2 \<and> (bdy1 \<inter>\<^sub>g bdy2) = Some bdy \<and>
        c=Guard f (g1 \<inter> g2) bdy)"
   by (cases c2) (auto split: option.splits)
 
 lemma inter_guards_Throw:
   "(Throw \<inter>\<^sub>g c2) = Some c = (c2=Throw \<and> c=Throw)"
   by (cases c2) auto
 
 lemma inter_guards_Catch:
   "(Catch a1 a2 \<inter>\<^sub>g c2) = Some c =
      (\<exists>b1 b2 d1 d2. c2=Catch b1 b2 \<and> (a1 \<inter>\<^sub>g b1) = Some d1 \<and>
         (a2 \<inter>\<^sub>g b2) = Some d2 \<and> c=Catch d1 d2)"
   by (cases c2) (auto split: option.splits)
 
 
 lemmas inter_guards_simps = inter_guards_Skip inter_guards_Basic inter_guards_Spec
   inter_guards_Seq inter_guards_Cond inter_guards_While inter_guards_Call
   inter_guards_DynCom inter_guards_Guard inter_guards_Throw
   inter_guards_Catch
 
 
 subsubsection \<open>Subset on Guards: \<open>c\<^sub>1 \<subseteq>\<^sub>g c\<^sub>2\<close>\<close>
 
 inductive subseteq_guards :: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com \<Rightarrow> bool"
   ("_ \<subseteq>\<^sub>g _" [20,20] 19) where
   "Skip \<subseteq>\<^sub>g Skip"
 | "f1 = f2 \<Longrightarrow> Basic f1 \<subseteq>\<^sub>g Basic f2"
 | "r1 = r2 \<Longrightarrow> Spec r1 \<subseteq>\<^sub>g Spec r2"
 | "a1 \<subseteq>\<^sub>g b1 \<Longrightarrow> a2 \<subseteq>\<^sub>g b2 \<Longrightarrow> Seq a1 a2 \<subseteq>\<^sub>g Seq b1 b2"
 | "cnd1 = cnd2 \<Longrightarrow> t1 \<subseteq>\<^sub>g t2 \<Longrightarrow> e1 \<subseteq>\<^sub>g e2 \<Longrightarrow> Cond cnd1 t1 e1 \<subseteq>\<^sub>g Cond cnd2 t2 e2"
 | "cnd1 = cnd2 \<Longrightarrow> c1 \<subseteq>\<^sub>g c2 \<Longrightarrow> While cnd1 c1 \<subseteq>\<^sub>g While cnd2 c2"
 | "p1 = p2 \<Longrightarrow> Call p1 \<subseteq>\<^sub>g Call p2"
 | "(\<And>s. P1 s \<subseteq>\<^sub>g P2 s) \<Longrightarrow> DynCom P1 \<subseteq>\<^sub>g DynCom P2"
 | "m1 = m2 \<Longrightarrow> g1 = g2 \<Longrightarrow> c1 \<subseteq>\<^sub>g c2 \<Longrightarrow> Guard m1 g1 c1 \<subseteq>\<^sub>g Guard m2 g2 c2"
 | "c1 \<subseteq>\<^sub>g c2 \<Longrightarrow> c1 \<subseteq>\<^sub>g Guard m2 g2 c2"
 | "Throw \<subseteq>\<^sub>g Throw"
 | "a1 \<subseteq>\<^sub>g b1 \<Longrightarrow> a2 \<subseteq>\<^sub>g b2 \<Longrightarrow> Catch a1 a2 \<subseteq>\<^sub>g Catch b1 b2"
 
 lemma subseteq_guards_Skip:
   "c = Skip" if "c \<subseteq>\<^sub>g Skip"
   using that by cases
 
 lemma subseteq_guards_Basic:
   "c = Basic f" if "c \<subseteq>\<^sub>g Basic f"
   using that by cases simp
 
 lemma subseteq_guards_Spec:
   "c = Spec r" if "c \<subseteq>\<^sub>g Spec r"
   using that by cases simp
 
 lemma subseteq_guards_Seq:
   "\<exists>c1' c2'. c = Seq c1' c2' \<and> (c1' \<subseteq>\<^sub>g c1) \<and> (c2' \<subseteq>\<^sub>g c2)" if "c \<subseteq>\<^sub>g Seq c1 c2"
   using that by cases simp
 
 lemma subseteq_guards_Cond:
   "\<exists>c1' c2'. c=Cond b c1' c2' \<and> (c1' \<subseteq>\<^sub>g c1) \<and> (c2' \<subseteq>\<^sub>g c2)" if "c \<subseteq>\<^sub>g Cond b c1 c2"
   using that by cases simp
 
 lemma subseteq_guards_While:
   "\<exists>c''. c=While b c'' \<and> (c'' \<subseteq>\<^sub>g c')" if "c \<subseteq>\<^sub>g While b c'"
   using that by cases simp
 
 lemma subseteq_guards_Call:
  "c = Call p" if "c \<subseteq>\<^sub>g Call p"
   using that by cases simp
 
 lemma subseteq_guards_DynCom:
   "\<exists>C'. c=DynCom C' \<and> (\<forall>s. C' s \<subseteq>\<^sub>g C s)" if "c \<subseteq>\<^sub>g DynCom C"
   using that by cases simp
 
 lemma subseteq_guards_Guard:
   "(c \<subseteq>\<^sub>g c') \<or> (\<exists>c''. c = Guard f g c'' \<and> (c'' \<subseteq>\<^sub>g c'))" if "c \<subseteq>\<^sub>g Guard f g c'"
   using that by cases simp_all
 
 lemma subseteq_guards_Throw:
   "c = Throw" if "c \<subseteq>\<^sub>g Throw"
   using that by cases
 
 lemma subseteq_guards_Catch:
   "\<exists>c1' c2'. c = Catch c1' c2' \<and> (c1' \<subseteq>\<^sub>g c1) \<and> (c2' \<subseteq>\<^sub>g c2)" if "c \<subseteq>\<^sub>g Catch c1 c2"
   using that by cases simp
 
 lemmas subseteq_guardsD = subseteq_guards_Skip subseteq_guards_Basic
  subseteq_guards_Spec subseteq_guards_Seq subseteq_guards_Cond subseteq_guards_While
  subseteq_guards_Call subseteq_guards_DynCom subseteq_guards_Guard
  subseteq_guards_Throw subseteq_guards_Catch
 
 lemma subseteq_guards_Guard':
   "\<exists>f' b' c'. d = Guard f' b' c'" if "Guard f b c \<subseteq>\<^sub>g d"
   using that by cases auto
 
 lemma subseteq_guards_refl: "c \<subseteq>\<^sub>g c"
   by (induct c) (auto intro: subseteq_guards.intros)
 
 (* Antisymmetry and transitivity should hold as well\<dots> *)
 
 end
diff --git a/thys/Simpl/Semantic.thy b/thys/Simpl/Semantic.thy
--- a/thys/Simpl/Semantic.thy
+++ b/thys/Simpl/Semantic.thy
@@ -1,4683 +1,5194 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Semantic.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
 section \<open>Big-Step Semantics for Simpl\<close>
 theory Semantic imports Language begin
 
 notation
 restrict_map  ("_|\<^bsub>_\<^esub>" [90, 91] 90)
 
 
 datatype ('s,'f) xstate = Normal 's | Abrupt 's | Fault 'f | Stuck
 
 definition isAbr::"('s,'f) xstate \<Rightarrow> bool"
   where "isAbr S = (\<exists>s. S=Abrupt s)"
 
 lemma isAbr_simps [simp]:
 "isAbr (Normal s) = False"
 "isAbr (Abrupt s) = True"
 "isAbr (Fault f) = False"
 "isAbr Stuck = False"
 by (auto simp add: isAbr_def)
 
 lemma isAbrE [consumes 1, elim?]: "\<lbrakk>isAbr S; \<And>s. S=Abrupt s \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by (auto simp add: isAbr_def)
 
 lemma not_isAbrD:
 "\<not> isAbr s \<Longrightarrow> (\<exists>s'. s=Normal s') \<or> s = Stuck \<or> (\<exists>f. s=Fault f)"
   by (cases s) auto
 
 definition isFault:: "('s,'f) xstate \<Rightarrow> bool"
   where "isFault S = (\<exists>f. S=Fault f)"
 
 lemma isFault_simps [simp]:
 "isFault (Normal s) = False"
 "isFault (Abrupt s) = False"
 "isFault (Fault f) = True"
 "isFault Stuck = False"
 by (auto simp add: isFault_def)
 
 lemma isFaultE [consumes 1, elim?]: "\<lbrakk>isFault s; \<And>f. s=Fault f \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by (auto simp add: isFault_def)
 
 lemma not_isFault_iff: "(\<not> isFault t) = (\<forall>f. t \<noteq> Fault f)"
   by (auto elim: isFaultE)
 
 (* ************************************************************************* *)
 subsection \<open>Big-Step Execution: \<open>\<Gamma>\<turnstile>\<langle>c, s\<rangle> \<Rightarrow> t\<close>\<close>
 (* ************************************************************************* *)
 
 text \<open>The procedure environment\<close>
 type_synonym ('s,'p,'f) body = "'p \<Rightarrow> ('s,'p,'f) com option"
 
 inductive
   "exec"::"[('s,'p,'f) body,('s,'p,'f) com,('s,'f) xstate,('s,'f) xstate]
                     \<Rightarrow> bool" ("_\<turnstile> \<langle>_,_\<rangle> \<Rightarrow> _"  [60,20,98,98] 89)
   for \<Gamma>::"('s,'p,'f) body"
 where
   Skip: "\<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow> Normal s"
 
 | Guard: "\<lbrakk>s\<in>g; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>  t"
 
 | GuardFault: "s\<notin>g \<Longrightarrow> \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>  Fault f"
 
 | FaultProp [intro,simp]: "\<Gamma>\<turnstile>\<langle>c,Fault f\<rangle> \<Rightarrow>  Fault f"
 
 | Basic: "\<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow>  Normal (f s)"
 
 | Spec: "(s,t) \<in> r
          \<Longrightarrow>
          \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>  Normal t"
 
 | SpecStuck: "\<forall>t. (s,t) \<notin> r
               \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>  Stuck"
 
 | Seq: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>  s'; \<Gamma>\<turnstile>\<langle>c\<^sub>2,s'\<rangle> \<Rightarrow>  t\<rbrakk>
         \<Longrightarrow>
         \<Gamma>\<turnstile>\<langle>Seq c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>  t"
 
 | CondTrue: "\<lbrakk>s \<in> b; \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>\<langle>Cond b c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>  t"
 
 | CondFalse: "\<lbrakk>s \<notin> b; \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
               \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>Cond b c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>  t"
 
 | WhileTrue: "\<lbrakk>s \<in> b; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>  s'; \<Gamma>\<turnstile>\<langle>While b c,s'\<rangle> \<Rightarrow>  t\<rbrakk>
               \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>  t"
 
 | WhileFalse: "\<lbrakk>s \<notin> b\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>  Normal s"
 
 | Call:  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>  t"
 
 | CallUndefined: "\<lbrakk>\<Gamma> p=None\<rbrakk>
                   \<Longrightarrow>
                   \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>  Stuck"
 
 | StuckProp [intro,simp]: "\<Gamma>\<turnstile>\<langle>c,Stuck\<rangle> \<Rightarrow>  Stuck"
 
 | DynCom:  "\<lbrakk>\<Gamma>\<turnstile>\<langle>(c s),Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>  t"
 
 | Throw: "\<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow>  Abrupt s"
 
 | AbruptProp [intro,simp]: "\<Gamma>\<turnstile>\<langle>c,Abrupt s\<rangle> \<Rightarrow>  Abrupt s"
 
 | CatchMatch: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>  Abrupt s'; \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s'\<rangle> \<Rightarrow>  t\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>  t"
 | CatchMiss: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow>  t; \<not>isAbr t\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> \<Rightarrow>  t"
 
 inductive_cases exec_elim_cases [cases set]:
   "\<Gamma>\<turnstile>\<langle>c,Fault f\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Stuck\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Abrupt s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Skip,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Guard f g c,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Basic f,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Spec r,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>While b c,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Call p,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>DynCom c,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Throw,s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Catch c1 c2,s\<rangle> \<Rightarrow>  t"
 
 
 inductive_cases exec_Normal_elim_cases [cases set]:
   "\<Gamma>\<turnstile>\<langle>c,Fault f\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Stuck\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Abrupt s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> \<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow>  t"
 
+
+lemma exec_block_exn:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t; \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> \<Rightarrow>  u\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> \<Rightarrow>  u"
+apply (unfold block_exn_def)
+  by (fastforce intro: exec.intros)
+
 lemma exec_block:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t; \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> \<Rightarrow>  u\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> \<Rightarrow>  u"
-apply (unfold block_def)
-by (fastforce intro: exec.intros)
+  unfolding block_def
+  by (rule exec_block_exn)
+
+lemma exec_block_exnAbrupt:
+     "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t\<rbrakk>
+       \<Longrightarrow>
+       \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> \<Rightarrow>  Abrupt (result_exn (return s t) t)"
+apply (unfold block_exn_def)
+  by (fastforce intro: exec.intros)
 
 lemma exec_blockAbrupt:
      "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t\<rbrakk>
        \<Longrightarrow>
        \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> \<Rightarrow>  Abrupt (return s t)"
-apply (unfold block_def)
-by (fastforce intro: exec.intros)
+  unfolding block_def
+  by (rule exec_block_exnAbrupt)
+
+lemma exec_block_exnFault:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f\<rbrakk>
+   \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> \<Rightarrow>  Fault f"
+apply (unfold block_exn_def)
+  by (fastforce intro: exec.intros)
 
 lemma exec_blockFault:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f\<rbrakk>
    \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> \<Rightarrow>  Fault f"
-apply (unfold block_def)
-by (fastforce intro: exec.intros)
+  unfolding block_def
+  by (rule exec_block_exnFault)
+
+lemma exec_block_exnStuck:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> \<Rightarrow>  Stuck"
+apply (unfold block_exn_def)
+  by (fastforce intro: exec.intros)
 
 lemma exec_blockStuck:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> \<Rightarrow>  Stuck"
-apply (unfold block_def)
-by (fastforce intro: exec.intros)
+  unfolding block_def
+  by (rule exec_block_exnStuck)
 
 lemma exec_call:
  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t; \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> \<Rightarrow>  u\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow>  u"
 apply (simp add: call_def)
 apply (rule exec_block)
 apply  (erule (1) Call)
 apply assumption
 done
 
-
 lemma exec_callAbrupt:
  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow>  Abrupt (return s t)"
 apply (simp add: call_def)
 apply (rule exec_blockAbrupt)
 apply (erule (1) Call)
 done
 
 lemma exec_callFault:
              "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f\<rbrakk>
                \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow>  Fault f"
 apply (simp add: call_def)
 apply (rule exec_blockFault)
 apply (erule (1) Call)
 done
 
 lemma exec_callStuck:
           "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck\<rbrakk>
            \<Longrightarrow>
            \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow>  Stuck"
 apply (simp add: call_def)
 apply (rule exec_blockStuck)
 apply (erule (1) Call)
 done
 
 lemma  exec_callUndefined:
        "\<lbrakk>\<Gamma> p=None\<rbrakk>
         \<Longrightarrow>
         \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow>  Stuck"
 apply (simp add: call_def)
 apply (rule exec_blockStuck)
 apply (erule CallUndefined)
 done
 
+lemma exec_call_exn:
+ "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t; \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> \<Rightarrow>  u\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow>  u"
+apply (simp add: call_exn_def)
+apply (rule exec_block_exn)
+apply  (erule (1) Call)
+apply assumption
+done
+
+lemma exec_call_exnAbrupt:
+ "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow>  Abrupt (result_exn (return s t) t)"
+apply (simp add: call_exn_def)
+apply (rule exec_block_exnAbrupt)
+apply (erule (1) Call)
+done
+
+lemma exec_call_exnFault:
+             "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f\<rbrakk>
+               \<Longrightarrow>
+              \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow>  Fault f"
+apply (simp add: call_exn_def)
+apply (rule exec_block_exnFault)
+apply (erule (1) Call)
+done
+
+lemma exec_call_exnStuck:
+          "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck\<rbrakk>
+           \<Longrightarrow>
+           \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow>  Stuck"
+apply (simp add: call_exn_def)
+apply (rule exec_block_exnStuck)
+apply (erule (1) Call)
+done
+
+lemma  exec_call_exnUndefined:
+       "\<lbrakk>\<Gamma> p=None\<rbrakk>
+        \<Longrightarrow>
+        \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow> Stuck"
+apply (simp add: call_exn_def)
+apply (rule exec_block_exnStuck)
+apply (erule CallUndefined)
+  done
+
 
 lemma Fault_end: assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>  t" and s: "s=Fault f"
   shows "t=Fault f"
 using exec s by (induct) auto
 
 lemma Stuck_end: assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>  t" and s: "s=Stuck"
   shows "t=Stuck"
 using exec s by (induct) auto
 
 lemma Abrupt_end: assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>  t" and s: "s=Abrupt s'"
   shows "t=Abrupt s'"
 using exec s by (induct) auto
 
 lemma exec_Call_body_aux:
   "\<Gamma> p=Some bdy \<Longrightarrow>
    \<Gamma>\<turnstile>\<langle>Call p,s\<rangle> \<Rightarrow> t = \<Gamma>\<turnstile>\<langle>bdy,s\<rangle> \<Rightarrow> t"
 apply (rule)
 apply (fastforce elim: exec_elim_cases )
 apply (cases s)
 apply   (cases t)
 apply (auto intro: exec.intros dest: Fault_end Stuck_end Abrupt_end)
 done
 
 lemma exec_Call_body':
   "p \<in> dom \<Gamma> \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>Call p,s\<rangle> \<Rightarrow> t = \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),s\<rangle> \<Rightarrow> t"
   apply clarsimp
   by (rule exec_Call_body_aux)
 
 
-
-lemma exec_block_Normal_elim [consumes 1]:
-assumes exec_block: "\<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> \<Rightarrow>  t"
+lemma exec_block_exn_Normal_elim [consumes 1]:
+assumes exec_block: "\<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> \<Rightarrow>  t"
 assumes Normal:
  "\<And>t'.
     \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t';
      \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow>  t\<rbrakk>
     \<Longrightarrow> P"
 assumes Abrupt:
  "\<And>t'.
     \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t';
-     t = Abrupt (return s t')\<rbrakk>
+     t = Abrupt (result_exn (return s t') t')\<rbrakk>
     \<Longrightarrow> P"
 assumes Fault:
  "\<And>f.
     \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f;
      t = Fault f\<rbrakk>
     \<Longrightarrow> P"
 assumes Stuck:
  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck;
      t = Stuck\<rbrakk>
     \<Longrightarrow> P"
 assumes
  "\<lbrakk>\<Gamma> p = None; t = Stuck\<rbrakk> \<Longrightarrow> P"
 shows "P"
   using exec_block
-apply (unfold block_def)
+apply (unfold block_exn_def)
 apply (elim exec_Normal_elim_cases)
 apply simp_all
 apply  (case_tac s')
 apply     simp_all
 apply     (elim exec_Normal_elim_cases)
 apply     simp
 apply    (drule Abrupt_end) apply simp
 apply    (erule exec_Normal_elim_cases)
 apply    simp
 apply    (rule Abrupt,assumption+)
 apply   (drule Fault_end) apply simp
 apply   (erule exec_Normal_elim_cases)
 apply   simp
 apply  (drule Stuck_end) apply simp
 apply  (erule exec_Normal_elim_cases)
 apply  simp
 apply (case_tac s')
 apply    simp_all
 apply   (elim exec_Normal_elim_cases)
 apply   simp
 apply   (rule Normal, assumption+)
 apply  (drule Fault_end) apply simp
 apply  (rule Fault,assumption+)
 apply (drule Stuck_end) apply simp
 apply (rule Stuck,assumption+)
 done
 
+
+lemma exec_block_Normal_elim [consumes 1]:
+assumes exec_block: "\<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> \<Rightarrow>  t"
+assumes Normal:
+ "\<And>t'.
+    \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t';
+     \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow>  t\<rbrakk>
+    \<Longrightarrow> P"
+assumes Abrupt:
+ "\<And>t'.
+    \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t';
+     t = Abrupt (return s t')\<rbrakk>
+    \<Longrightarrow> P"
+assumes Fault:
+ "\<And>f.
+    \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f;
+     t = Fault f\<rbrakk>
+    \<Longrightarrow> P"
+assumes Stuck:
+ "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck;
+     t = Stuck\<rbrakk>
+    \<Longrightarrow> P"
+assumes
+ Undef: "\<lbrakk>\<Gamma> p = None; t = Stuck\<rbrakk> \<Longrightarrow> P"
+shows "P"
+  by (rule exec_block_exn_Normal_elim [OF exec_block [simplified block_def]
+  Normal Abrupt Fault Stuck Undef ])
+
+lemma exec_call_exn_Normal_elim [consumes 1]:
+assumes exec_call: "\<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> \<Rightarrow>  t"
+assumes Normal:
+ "\<And>bdy t'.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t';
+     \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow>  t\<rbrakk>
+    \<Longrightarrow> P"
+assumes Abrupt:
+ "\<And>bdy t'.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t';
+     t = Abrupt (result_exn (return s t') t')\<rbrakk>
+    \<Longrightarrow> P"
+assumes Fault:
+ "\<And>bdy f.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f;
+     t = Fault f\<rbrakk>
+    \<Longrightarrow> P"
+assumes Stuck:
+ "\<And>bdy.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck;
+     t = Stuck\<rbrakk>
+    \<Longrightarrow> P"
+assumes Undef:
+ "\<lbrakk>\<Gamma> p = None; t = Stuck\<rbrakk> \<Longrightarrow> P"
+shows "P"
+  using exec_call
+  apply (unfold call_exn_def)
+  apply (cases "\<Gamma> p")
+  apply  (erule exec_block_exn_Normal_elim)
+  apply      (elim exec_Normal_elim_cases)
+  apply       simp
+  apply      simp
+  apply     (elim exec_Normal_elim_cases)
+  apply      simp
+  apply     simp
+  apply    (elim exec_Normal_elim_cases)
+  apply     simp
+  apply    simp
+  apply   (elim exec_Normal_elim_cases)
+  apply    simp
+  apply   (rule Undef,assumption,assumption)
+  apply  (rule Undef,assumption+)
+  apply (erule exec_block_exn_Normal_elim)
+  apply     (elim exec_Normal_elim_cases)
+  apply      simp
+  apply      (rule Normal,assumption+)
+  apply     simp
+  apply    (elim exec_Normal_elim_cases)
+  apply     simp
+  apply     (rule Abrupt,assumption+)
+  apply    simp
+  apply   (elim exec_Normal_elim_cases)
+  apply    simp
+  apply   (rule Fault, assumption+)
+  apply   simp
+  apply  (elim exec_Normal_elim_cases)
+  apply   simp
+  apply  (rule Stuck,assumption,assumption,assumption)
+  apply  simp
+  apply (rule Undef,assumption+)
+  done
+
 lemma exec_call_Normal_elim [consumes 1]:
 assumes exec_call: "\<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> \<Rightarrow>  t"
 assumes Normal:
  "\<And>bdy t'.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Normal t';
      \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> \<Rightarrow>  t\<rbrakk>
     \<Longrightarrow> P"
 assumes Abrupt:
  "\<And>bdy t'.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Abrupt t';
      t = Abrupt (return s t')\<rbrakk>
     \<Longrightarrow> P"
 assumes Fault:
  "\<And>bdy f.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Fault f;
      t = Fault f\<rbrakk>
     \<Longrightarrow> P"
 assumes Stuck:
  "\<And>bdy.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow>  Stuck;
      t = Stuck\<rbrakk>
     \<Longrightarrow> P"
 assumes Undef:
  "\<lbrakk>\<Gamma> p = None; t = Stuck\<rbrakk> \<Longrightarrow> P"
 shows "P"
-  using exec_call
-  apply (unfold call_def)
-  apply (cases "\<Gamma> p")
-  apply  (erule exec_block_Normal_elim)
-  apply      (elim exec_Normal_elim_cases)
-  apply       simp
-  apply      simp
-  apply     (elim exec_Normal_elim_cases)
-  apply      simp
-  apply     simp
-  apply    (elim exec_Normal_elim_cases)
-  apply     simp
-  apply    simp
-  apply   (elim exec_Normal_elim_cases)
-  apply    simp
-  apply   (rule Undef,assumption,assumption)
-  apply  (rule Undef,assumption+)
-  apply (erule exec_block_Normal_elim)
-  apply     (elim exec_Normal_elim_cases)
-  apply      simp
-  apply      (rule Normal,assumption+)
-  apply     simp
-  apply    (elim exec_Normal_elim_cases)
-  apply     simp
-  apply     (rule Abrupt,assumption+)
-  apply    simp
-  apply   (elim exec_Normal_elim_cases)
-  apply    simp
-  apply   (rule Fault, assumption+)
-  apply   simp
-  apply  (elim exec_Normal_elim_cases)
-  apply   simp
-  apply  (rule Stuck,assumption,assumption,assumption)
-  apply  simp
-  apply (rule Undef,assumption+)
-  done
+  using exec_call [simplified call_call_exn] Normal Abrupt Fault Stuck Undef
+  by (rule exec_call_exn_Normal_elim)
 
 
 lemma exec_dynCall:
           "\<lbrakk>\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
            \<Longrightarrow>
            \<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> \<Rightarrow>  t"
 apply (simp add: dynCall_def)
 by (rule DynCom)
 
+lemma exec_dynCall_exn:
+          "\<lbrakk>\<Gamma>\<turnstile>\<langle>call_exn init (p s) return result_exn c,Normal s\<rangle> \<Rightarrow>  t\<rbrakk>
+           \<Longrightarrow>
+           \<Gamma>\<turnstile>\<langle>dynCall_exn f UNIV init p return result_exn c,Normal s\<rangle> \<Rightarrow>  t"
+apply (simp add: dynCall_exn_def)
+  by (rule DynCom)
+
 lemma exec_dynCall_Normal_elim:
   assumes exec: "\<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> \<Rightarrow>  t"
   assumes call: "\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> \<Rightarrow>  t \<Longrightarrow> P"
   shows "P"
   using exec
   apply (simp add: dynCall_def)
   apply (erule exec_Normal_elim_cases)
   apply (rule call,assumption)
   done
 
+lemma exec_guards_Normal_elim_cases [consumes 1, case_names noFault someFault]:
+  assumes exec_guards: "\<Gamma>\<turnstile>\<langle>guards gs c,Normal s\<rangle> \<Rightarrow> t"
+  assumes noFault: "\<forall>f g. (f, g) \<in> set gs \<longrightarrow> s \<in> g \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t \<Longrightarrow> P"
+  assumes someFault: "\<And>f g. find (\<lambda>(f,g). s \<notin> g) gs = Some (f, g) \<Longrightarrow> t = Fault f \<Longrightarrow> P"
+  shows "P"
+  using exec_guards noFault someFault
+proof (induct gs)
+  case Nil
+  then show ?case by simp
+next
+  case (Cons pg gs)
+  obtain f g where pg: "pg = (f, g)"
+    by (cases pg) auto
+  show ?thesis
+  proof (cases "s \<in> g")
+    case True
+    from Cons.prems(1) have exec_gs: "\<Gamma>\<turnstile> \<langle>guards gs c,Normal s\<rangle> \<Rightarrow> t"
+      by (simp add: pg) (meson True pg exec_Normal_elim_cases)
+
+    from Cons.hyps [OF exec_gs] Cons.prems(2,3)
+    show ?thesis
+      by (simp add: pg True)
+  next
+    case False
+    from Cons.prems(1) have t: "t = Fault f"
+      by (simp add: pg) (meson False pg exec_Normal_elim_cases)
+
+    from t Cons.prems(3)
+    show ?thesis
+      by (simp add: pg False)
+  qed
+qed
+
+lemma exec_guards_noFault:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
+  assumes noFault: "\<forall>f g. (f, g) \<in> set gs \<longrightarrow> s \<in> g"
+  shows "\<Gamma>\<turnstile>\<langle>guards gs c,Normal s\<rangle> \<Rightarrow> t"
+  using exec noFault by (induct gs) (auto intro: exec.intros)
+
+lemma exec_guards_Fault:
+  assumes Fault: "find (\<lambda>(f,g). s \<notin> g) gs = Some (f, g)"
+  shows "\<Gamma>\<turnstile>\<langle>guards gs c,Normal s\<rangle> \<Rightarrow> Fault f"
+  using Fault by (induct gs) (auto intro: exec.intros  split: prod.splits if_split_asm)
+
+lemma exec_guards_DynCom:
+  assumes exec_c: "\<Gamma>\<turnstile>\<langle>guards gs (c s), Normal s\<rangle> \<Rightarrow> t"
+  shows "\<Gamma>\<turnstile>\<langle>guards gs (DynCom c), Normal s\<rangle> \<Rightarrow> t"
+  using exec_c apply (induct gs)
+   apply (fastforce intro: exec.intros)
+  apply simp
+  by (metis exec.Guard exec.GuardFault exec_Normal_elim_cases)
+
+lemma exec_guards_DynCom_Normal_elim:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>guards gs (DynCom c), Normal s\<rangle> \<Rightarrow> t"
+  assumes call: "\<Gamma>\<turnstile>\<langle>guards gs (c s), Normal s\<rangle> \<Rightarrow>  t \<Longrightarrow> P"
+  shows "P"
+  using exec call proof (induct gs)
+  case Nil
+  then show ?case
+    apply simp
+    apply (erule exec_Normal_elim_cases)
+    apply simp
+    done
+next
+  case (Cons g gs)
+  then show ?case
+    apply (cases g)
+    apply simp
+    apply (erule exec_Normal_elim_cases)
+     apply simp
+     apply (meson Guard)
+    apply simp
+    apply (meson GuardFault)
+    done
+qed
+
+lemma exec_maybe_guard_DynCom:
+  assumes exec_c: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (c s), Normal s\<rangle> \<Rightarrow> t"
+  shows "\<Gamma>\<turnstile>\<langle>maybe_guard f g (DynCom c), Normal s\<rangle> \<Rightarrow> t"
+  using exec_c
+  by (metis DynCom Guard GuardFault exec_Normal_elim_cases(5) maybe_guard_def)
+
+lemma exec_maybe_guard_Normal_elim_cases [consumes 1, case_names noFault someFault]:
+  assumes exec_guards: "\<Gamma>\<turnstile>\<langle>maybe_guard f g c,Normal s\<rangle> \<Rightarrow> t"
+  assumes noFault: "s \<in> g \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t \<Longrightarrow> P"
+  assumes someFault: "s \<notin> g \<Longrightarrow> t = Fault f \<Longrightarrow> P"
+  shows "P"
+  using exec_guards noFault someFault
+  by (metis UNIV_I exec_Normal_elim_cases(5) maybe_guard_def)
+
+lemma exec_maybe_guard_noFault:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> t"
+  assumes noFault: "s \<in> g"
+  shows "\<Gamma>\<turnstile>\<langle>maybe_guard f g c,Normal s\<rangle> \<Rightarrow> t"
+  using exec noFault
+  by (simp add: Guard maybe_guard_def)
+
+lemma exec_maybe_guard_Fault:
+  assumes Fault: "s \<notin> g"
+  shows "\<Gamma>\<turnstile>\<langle>maybe_guard f g c,Normal s\<rangle> \<Rightarrow> Fault f"
+  using Fault
+  by (metis GuardFault iso_tuple_UNIV_I maybe_guard_def)
+
+lemma exec_maybe_guard_DynCom_Normal_elim:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (DynCom c), Normal s\<rangle> \<Rightarrow> t"
+  assumes call: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (c s), Normal s\<rangle> \<Rightarrow>  t \<Longrightarrow> P"
+  shows "P"
+  using exec call
+  apply (cases "g=UNIV")
+  subgoal
+    apply simp
+    apply (erule exec_Normal_elim_cases)
+    apply simp
+    done
+  subgoal
+    apply (simp add: maybe_guard_def)
+    apply (erule exec_Normal_elim_cases)
+     apply (meson Guard exec_Normal_elim_cases(12))
+    by (meson GuardFault)
+  done
+
+
+lemma exec_dynCall_exn_Normal_elim:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return result_exn c,Normal s\<rangle> \<Rightarrow>  t"
+  assumes call: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (call_exn init (p s) return result_exn c),Normal s\<rangle> \<Rightarrow> t \<Longrightarrow> P"
+  shows "P"
+  using exec
+  apply (simp add: dynCall_exn_def)
+  apply (erule exec_maybe_guard_DynCom_Normal_elim)
+  by (rule call)
+
 
 lemma exec_Call_body:
   "\<Gamma> p=Some bdy \<Longrightarrow>
    \<Gamma>\<turnstile>\<langle>Call p,s\<rangle> \<Rightarrow>  t = \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),s\<rangle> \<Rightarrow>  t"
 apply (rule)
 apply (fastforce elim: exec_elim_cases )
 apply (cases s)
 apply   (cases t)
 apply (fastforce intro: exec.intros dest: Fault_end Abrupt_end Stuck_end)+
 done
 
 lemma exec_Seq': "\<lbrakk>\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow>  s'; \<Gamma>\<turnstile>\<langle>c2,s'\<rangle> \<Rightarrow>  s''\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>  s''"
   apply (cases s)
   apply    (fastforce intro: exec.intros)
   apply   (fastforce dest: Abrupt_end)
   apply  (fastforce dest: Fault_end)
   apply (fastforce dest: Stuck_end)
   done
 
 
 lemma exec_assoc: "\<Gamma>\<turnstile>\<langle>Seq c1 (Seq c2 c3),s\<rangle> \<Rightarrow>  t = \<Gamma>\<turnstile>\<langle>Seq (Seq c1 c2) c3,s\<rangle> \<Rightarrow>  t"
   by (blast elim!: exec_elim_cases intro: exec_Seq' )
 
 
 (* ************************************************************************* *)
 subsection \<open>Big-Step Execution with Recursion Limit: \<open>\<Gamma>\<turnstile>\<langle>c, s\<rangle> =n\<Rightarrow> t\<close>\<close>
 (* ************************************************************************* *)
 
 inductive "execn"::"[('s,'p,'f) body,('s,'p,'f) com,('s,'f) xstate,nat,('s,'f) xstate]
                       \<Rightarrow> bool" ("_\<turnstile> \<langle>_,_\<rangle> =_\<Rightarrow> _"  [60,20,98,65,98] 89)
   for \<Gamma>::"('s,'p,'f) body"
 where
   Skip: "\<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> =n\<Rightarrow>  Normal s"
 | Guard: "\<lbrakk>s\<in>g; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> =n\<Rightarrow>  t"
 
 | GuardFault: "s\<notin>g \<Longrightarrow> \<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> =n\<Rightarrow>  Fault f"
 
 | FaultProp [intro,simp]: "\<Gamma>\<turnstile>\<langle>c,Fault f\<rangle> =n\<Rightarrow>  Fault f"
 
 | Basic: "\<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> =n\<Rightarrow>  Normal (f s)"
 
 | Spec: "(s,t) \<in> r
          \<Longrightarrow>
          \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> =n\<Rightarrow>  Normal t"
 
 | SpecStuck: "\<forall>t. (s,t) \<notin> r
               \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> =n\<Rightarrow>  Stuck"
 
 | Seq: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow>  s'; \<Gamma>\<turnstile>\<langle>c\<^sub>2,s'\<rangle> =n\<Rightarrow>  t\<rbrakk>
         \<Longrightarrow>
         \<Gamma>\<turnstile>\<langle>Seq c\<^sub>1 c\<^sub>2,Normal s\<rangle> =n\<Rightarrow>  t"
 
 | CondTrue: "\<lbrakk>s \<in> b; \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>\<langle>Cond b c\<^sub>1 c\<^sub>2,Normal s\<rangle> =n\<Rightarrow>  t"
 
 | CondFalse: "\<lbrakk>s \<notin> b; \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
               \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>Cond b c\<^sub>1 c\<^sub>2,Normal s\<rangle> =n\<Rightarrow>  t"
 
 | WhileTrue: "\<lbrakk>s \<in> b; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow>  s';
               \<Gamma>\<turnstile>\<langle>While b c,s'\<rangle> =n\<Rightarrow>  t\<rbrakk>
               \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> =n\<Rightarrow>  t"
 
 | WhileFalse: "\<lbrakk>s \<notin> b\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> =n\<Rightarrow>  Normal s"
 
 | Call:  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>\<langle>Call p ,Normal s\<rangle> =Suc n\<Rightarrow>  t"
 
 | CallUndefined: "\<lbrakk>\<Gamma> p=None\<rbrakk>
                  \<Longrightarrow>
                  \<Gamma>\<turnstile>\<langle>Call p ,Normal s\<rangle> =Suc n\<Rightarrow>  Stuck"
 
 | StuckProp [intro,simp]: "\<Gamma>\<turnstile>\<langle>c,Stuck\<rangle> =n\<Rightarrow>  Stuck"
 
 | DynCom:  "\<lbrakk>\<Gamma>\<turnstile>\<langle>(c s),Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> =n\<Rightarrow>  t"
 
 | Throw: "\<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> =n\<Rightarrow>  Abrupt s"
 
 | AbruptProp [intro,simp]: "\<Gamma>\<turnstile>\<langle>c,Abrupt s\<rangle> =n\<Rightarrow>  Abrupt s"
 
 | CatchMatch: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow>  Abrupt s'; \<Gamma>\<turnstile>\<langle>c\<^sub>2,Normal s'\<rangle> =n\<Rightarrow> t\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> =n\<Rightarrow> t"
 | CatchMiss: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> =n\<Rightarrow>  t; \<not>isAbr t\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>\<langle>Catch c\<^sub>1 c\<^sub>2,Normal s\<rangle> =n\<Rightarrow>  t"
 
 inductive_cases execn_elim_cases [cases set]:
   "\<Gamma>\<turnstile>\<langle>c,Fault f\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Stuck\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Abrupt s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Skip,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Guard f g c,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Basic f,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Spec r,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>While b c,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Call p ,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>DynCom c,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Throw,s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Catch c1 c2,s\<rangle> =n\<Rightarrow>  t"
 
 
 inductive_cases execn_Normal_elim_cases [cases set]:
   "\<Gamma>\<turnstile>\<langle>c,Fault f\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Stuck\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>c,Abrupt s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Skip,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Basic f,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Throw,Normal s\<rangle> =n\<Rightarrow>  t"
   "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> =n\<Rightarrow>  t"
 
 lemma execn_Skip': "\<Gamma>\<turnstile>\<langle>Skip,t\<rangle> =n\<Rightarrow> t"
   by (cases t) (auto intro: execn.intros)
 
 lemma execn_Fault_end: assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t" and s: "s=Fault f"
   shows "t=Fault f"
 using exec s by (induct) auto
 
 lemma execn_Stuck_end: assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t" and s: "s=Stuck"
   shows "t=Stuck"
 using exec s by (induct) auto
 
 lemma execn_Abrupt_end: assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t" and s: "s=Abrupt s'"
   shows "t=Abrupt s'"
 using exec s by (induct) auto
 
+lemma execn_block_exn:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Normal t; \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> =n\<Rightarrow>  u\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> =n\<Rightarrow>  u"
+apply (unfold block_exn_def)
+  by (fastforce intro: execn.intros)
+
 lemma execn_block:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Normal t; \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> =n\<Rightarrow>  u\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> =n\<Rightarrow>  u"
-apply (unfold block_def)
-by (fastforce intro: execn.intros)
+  unfolding block_def
+  by (rule execn_block_exn)
+
+lemma execn_block_exnAbrupt:
+     "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Abrupt t\<rbrakk>
+       \<Longrightarrow>
+       \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> =n\<Rightarrow>  Abrupt (result_exn (return s t) t)"
+apply (unfold block_exn_def)
+  by (fastforce intro: execn.intros)
 
 lemma execn_blockAbrupt:
      "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Abrupt t\<rbrakk>
        \<Longrightarrow>
        \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> =n\<Rightarrow>  Abrupt (return s t)"
-apply (unfold block_def)
-by (fastforce intro: execn.intros)
+  unfolding block_def
+  by (rule execn_block_exnAbrupt)
+
+lemma execn_block_exnFault:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Fault f\<rbrakk>
+   \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> =n\<Rightarrow>  Fault f"
+apply (unfold block_exn_def)
+  by (fastforce intro: execn.intros)
 
 lemma execn_blockFault:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Fault f\<rbrakk>
    \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> =n\<Rightarrow>  Fault f"
-apply (unfold block_def)
-by (fastforce intro: execn.intros)
+  unfolding block_def
+by (rule execn_block_exnFault)
+
+lemma execn_block_exnStuck:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Stuck\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> =n\<Rightarrow>  Stuck"
+apply (unfold block_exn_def)
+  by (fastforce intro: execn.intros)
 
 lemma execn_blockStuck:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Stuck\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> =n\<Rightarrow>  Stuck"
-apply (unfold block_def)
-by (fastforce intro: execn.intros)
+  unfolding block_def
+by (rule execn_block_exnStuck)
 
 
 lemma execn_call:
  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Normal t;
    \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> =Suc n\<Rightarrow>  u\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =Suc n\<Rightarrow>  u"
 apply (simp add: call_def)
 apply (rule execn_block)
 apply  (erule (1) Call)
 apply assumption
 done
 
+lemma execn_call_exn:
+ "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Normal t;
+   \<Gamma>\<turnstile>\<langle>c s t,Normal (return s t)\<rangle> =Suc n\<Rightarrow>  u\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =Suc n\<Rightarrow>  u"
+apply (simp add: call_exn_def)
+apply (rule execn_block_exn)
+apply  (erule (1) Call)
+apply assumption
+done
+
 
 lemma execn_callAbrupt:
  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Abrupt t\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =Suc n\<Rightarrow>  Abrupt (return s t)"
 apply (simp add: call_def)
 apply (rule execn_blockAbrupt)
 apply (erule (1) Call)
 done
 
+lemma execn_call_exnAbrupt:
+ "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Abrupt t\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =Suc n\<Rightarrow>  Abrupt (result_exn (return s t) t)"
+apply (simp add: call_exn_def)
+apply (rule execn_block_exnAbrupt)
+apply (erule (1) Call)
+  done
+
 lemma execn_callFault:
              "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Fault f\<rbrakk>
                \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =Suc n\<Rightarrow>  Fault f"
 apply (simp add: call_def)
 apply (rule execn_blockFault)
 apply (erule (1) Call)
 done
 
+lemma execn_call_exnFault:
+             "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Fault f\<rbrakk>
+               \<Longrightarrow>
+              \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =Suc n\<Rightarrow>  Fault f"
+apply (simp add: call_exn_def)
+apply (rule execn_block_exnFault)
+apply (erule (1) Call)
+done
+
 lemma execn_callStuck:
           "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Stuck\<rbrakk>
            \<Longrightarrow>
            \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =Suc n\<Rightarrow>  Stuck"
 apply (simp add: call_def)
 apply (rule execn_blockStuck)
 apply (erule (1) Call)
 done
 
+lemma execn_call_exnStuck:
+          "\<lbrakk>\<Gamma> p=Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Stuck\<rbrakk>
+           \<Longrightarrow>
+           \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =Suc n\<Rightarrow>  Stuck"
+apply (simp add: call_exn_def)
+apply (rule execn_block_exnStuck)
+apply (erule (1) Call)
+  done
+
 lemma  execn_callUndefined:
        "\<lbrakk>\<Gamma> p=None\<rbrakk>
         \<Longrightarrow>
         \<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =Suc n\<Rightarrow>  Stuck"
 apply (simp add: call_def)
 apply (rule execn_blockStuck)
 apply (erule CallUndefined)
 done
 
+lemma  execn_call_exnUndefined:
+       "\<lbrakk>\<Gamma> p=None\<rbrakk>
+        \<Longrightarrow>
+        \<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =Suc n\<Rightarrow>  Stuck"
+apply (simp add: call_exn_def)
+apply (rule execn_block_exnStuck)
+apply (erule CallUndefined)
+done
+
+lemma execn_block_exn_Normal_elim [consumes 1]:
+assumes execn_block: "\<Gamma>\<turnstile>\<langle>block_exn init bdy return result_exn c,Normal s\<rangle> =n\<Rightarrow>  t"
+assumes Normal:
+ "\<And>t'.
+    \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Normal t';
+     \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =n\<Rightarrow>  t\<rbrakk>
+    \<Longrightarrow> P"
+assumes Abrupt:
+ "\<And>t'.
+    \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Abrupt t';
+     t = Abrupt (result_exn (return s t') t')\<rbrakk>
+    \<Longrightarrow> P"
+assumes Fault:
+ "\<And>f.
+    \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Fault f;
+     t = Fault f\<rbrakk>
+    \<Longrightarrow> P"
+assumes Stuck:
+ "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Stuck;
+     t = Stuck\<rbrakk>
+    \<Longrightarrow> P"
+assumes Undef:
+ "\<lbrakk>\<Gamma> p = None; t = Stuck\<rbrakk> \<Longrightarrow> P"
+shows "P"
+  using execn_block
+apply (unfold block_exn_def)
+apply (elim execn_Normal_elim_cases)
+apply simp_all
+apply  (case_tac s')
+apply     simp_all
+apply     (elim execn_Normal_elim_cases)
+apply     simp
+apply    (drule execn_Abrupt_end) apply simp
+apply    (erule execn_Normal_elim_cases)
+apply    simp
+apply    (rule Abrupt,assumption+)
+apply   (drule execn_Fault_end) apply simp
+apply   (erule execn_Normal_elim_cases)
+apply   simp
+apply  (drule execn_Stuck_end) apply simp
+apply  (erule execn_Normal_elim_cases)
+apply  simp
+apply (case_tac s')
+apply    simp_all
+apply   (elim execn_Normal_elim_cases)
+apply   simp
+apply   (rule Normal,assumption+)
+apply  (drule execn_Fault_end) apply simp
+apply  (rule Fault,assumption+)
+apply (drule execn_Stuck_end) apply simp
+apply (rule Stuck,assumption+)
+done
+
 lemma execn_block_Normal_elim [consumes 1]:
 assumes execn_block: "\<Gamma>\<turnstile>\<langle>block init bdy return c,Normal s\<rangle> =n\<Rightarrow>  t"
 assumes Normal:
  "\<And>t'.
     \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Normal t';
      \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =n\<Rightarrow>  t\<rbrakk>
     \<Longrightarrow> P"
 assumes Abrupt:
  "\<And>t'.
     \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Abrupt t';
      t = Abrupt (return s t')\<rbrakk>
     \<Longrightarrow> P"
 assumes Fault:
  "\<And>f.
     \<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Fault f;
      t = Fault f\<rbrakk>
     \<Longrightarrow> P"
 assumes Stuck:
  "\<lbrakk>\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =n\<Rightarrow>  Stuck;
      t = Stuck\<rbrakk>
     \<Longrightarrow> P"
 assumes Undef:
  "\<lbrakk>\<Gamma> p = None; t = Stuck\<rbrakk> \<Longrightarrow> P"
 shows "P"
-  using execn_block
-apply (unfold block_def)
-apply (elim execn_Normal_elim_cases)
-apply simp_all
-apply  (case_tac s')
-apply     simp_all
-apply     (elim execn_Normal_elim_cases)
-apply     simp
-apply    (drule execn_Abrupt_end) apply simp
-apply    (erule execn_Normal_elim_cases)
-apply    simp
-apply    (rule Abrupt,assumption+)
-apply   (drule execn_Fault_end) apply simp
-apply   (erule execn_Normal_elim_cases)
-apply   simp
-apply  (drule execn_Stuck_end) apply simp
-apply  (erule execn_Normal_elim_cases)
-apply  simp
-apply (case_tac s')
-apply    simp_all
-apply   (elim execn_Normal_elim_cases)
-apply   simp
-apply   (rule Normal,assumption+)
-apply  (drule execn_Fault_end) apply simp
-apply  (rule Fault,assumption+)
-apply (drule execn_Stuck_end) apply simp
-apply (rule Stuck,assumption+)
-done
+  using execn_block [unfolded block_def] Normal Abrupt Fault Stuck Undef
+  by (rule execn_block_exn_Normal_elim)
+
+lemma execn_call_exn_Normal_elim [consumes 1]:
+assumes exec_call: "\<Gamma>\<turnstile>\<langle>call_exn init p return result_exn c,Normal s\<rangle> =n\<Rightarrow>  t"
+assumes Normal:
+ "\<And>bdy i t'.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Normal t';
+     \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc i\<Rightarrow>  t; n = Suc i\<rbrakk>
+    \<Longrightarrow> P"
+assumes Abrupt:
+ "\<And>bdy i t'.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Abrupt t'; n = Suc i;
+     t = Abrupt (result_exn (return s t') t')\<rbrakk>
+    \<Longrightarrow> P"
+assumes Fault:
+ "\<And>bdy i f.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Fault f; n = Suc i;
+     t = Fault f\<rbrakk>
+    \<Longrightarrow> P"
+assumes Stuck:
+ "\<And>bdy i.
+    \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Stuck; n = Suc i;
+     t = Stuck\<rbrakk>
+    \<Longrightarrow> P"
+assumes Undef:
+ "\<And>i. \<lbrakk>\<Gamma> p = None; n = Suc i; t = Stuck\<rbrakk> \<Longrightarrow> P"
+shows "P"
+  using exec_call
+  apply (unfold call_exn_def)
+  apply (cases n)
+  apply  (simp only: block_exn_def)
+  apply  (fastforce elim: execn_Normal_elim_cases)
+  apply (cases "\<Gamma> p")
+  apply  (erule execn_block_exn_Normal_elim)
+  apply      (elim execn_Normal_elim_cases)
+  apply       simp
+  apply      simp
+  apply     (elim execn_Normal_elim_cases)
+  apply      simp
+  apply     simp
+  apply    (elim execn_Normal_elim_cases)
+  apply     simp
+  apply    simp
+  apply   (elim execn_Normal_elim_cases)
+  apply    simp
+  apply   (rule Undef,assumption,assumption,assumption)
+  apply  (rule Undef,assumption+)
+  apply (erule execn_block_exn_Normal_elim)
+  apply     (elim execn_Normal_elim_cases)
+  apply      simp
+  apply      (rule Normal,assumption+)
+  apply     simp
+  apply    (elim execn_Normal_elim_cases)
+  apply     simp
+  apply     (rule Abrupt,assumption+)
+  apply    simp
+  apply   (elim execn_Normal_elim_cases)
+  apply    simp
+  apply   (rule Fault,assumption+)
+  apply   simp
+  apply  (elim execn_Normal_elim_cases)
+  apply   simp
+  apply  (rule Stuck,assumption,assumption,assumption,assumption)
+  apply  (rule Undef,assumption,assumption,assumption)
+  apply (rule Undef,assumption+)
+  done
+
 
 lemma execn_call_Normal_elim [consumes 1]:
 assumes exec_call: "\<Gamma>\<turnstile>\<langle>call init p return c,Normal s\<rangle> =n\<Rightarrow>  t"
 assumes Normal:
  "\<And>bdy i t'.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Normal t';
      \<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc i\<Rightarrow>  t; n = Suc i\<rbrakk>
     \<Longrightarrow> P"
 assumes Abrupt:
  "\<And>bdy i t'.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Abrupt t'; n = Suc i;
      t = Abrupt (return s t')\<rbrakk>
     \<Longrightarrow> P"
 assumes Fault:
  "\<And>bdy i f.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Fault f; n = Suc i;
      t = Fault f\<rbrakk>
     \<Longrightarrow> P"
 assumes Stuck:
  "\<And>bdy i.
     \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> =i\<Rightarrow>  Stuck; n = Suc i;
      t = Stuck\<rbrakk>
     \<Longrightarrow> P"
 assumes Undef:
  "\<And>i. \<lbrakk>\<Gamma> p = None; n = Suc i; t = Stuck\<rbrakk> \<Longrightarrow> P"
 shows "P"
-  using exec_call
-  apply (unfold call_def)
-  apply (cases n)
-  apply  (simp only: block_def)
-  apply  (fastforce elim: execn_Normal_elim_cases)
-  apply (cases "\<Gamma> p")
-  apply  (erule execn_block_Normal_elim)
-  apply      (elim execn_Normal_elim_cases)
-  apply       simp
-  apply      simp
-  apply     (elim execn_Normal_elim_cases)
-  apply      simp
-  apply     simp
-  apply    (elim execn_Normal_elim_cases)
-  apply     simp
-  apply    simp
-  apply   (elim execn_Normal_elim_cases)
-  apply    simp
-  apply   (rule Undef,assumption,assumption,assumption)
-  apply  (rule Undef,assumption+)
-  apply (erule execn_block_Normal_elim)
-  apply     (elim execn_Normal_elim_cases)
-  apply      simp
-  apply      (rule Normal,assumption+)
-  apply     simp
-  apply    (elim execn_Normal_elim_cases)
-  apply     simp
-  apply     (rule Abrupt,assumption+)
-  apply    simp
-  apply   (elim execn_Normal_elim_cases)
-  apply    simp
-  apply   (rule Fault,assumption+)
-  apply   simp
-  apply  (elim execn_Normal_elim_cases)
-  apply   simp
-  apply  (rule Stuck,assumption,assumption,assumption,assumption)
-  apply  (rule Undef,assumption,assumption,assumption)
-  apply (rule Undef,assumption+)
-  done
+  using exec_call [simplified call_call_exn] Normal Abrupt Fault Stuck Undef
+  by (rule execn_call_exn_Normal_elim)
+
 
 lemma execn_dynCall:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
   \<Longrightarrow>
   \<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> =n\<Rightarrow>  t"
 apply (simp add: dynCall_def)
 by (rule DynCom)
 
+lemma execn_dynCall_exn:
+  "\<lbrakk>\<Gamma>\<turnstile>\<langle>call_exn init (p s) return result_exn c,Normal s\<rangle> =n\<Rightarrow>  t\<rbrakk>
+  \<Longrightarrow>
+  \<Gamma>\<turnstile>\<langle>dynCall_exn f UNIV init p return result_exn c,Normal s\<rangle> =n\<Rightarrow>  t"
+apply (simp add: dynCall_exn_def)
+  by (rule DynCom)
+
 lemma execn_dynCall_Normal_elim:
   assumes exec: "\<Gamma>\<turnstile>\<langle>dynCall init p return c,Normal s\<rangle> =n\<Rightarrow>  t"
   assumes "\<Gamma>\<turnstile>\<langle>call init (p s) return c,Normal s\<rangle> =n\<Rightarrow>  t \<Longrightarrow> P"
   shows "P"
   using exec
   apply (simp add: dynCall_def)
   apply (erule execn_Normal_elim_cases)
   apply fact
   done
 
-
-
-
+lemma execn_guards_Normal_elim_cases [consumes 1, case_names noFault someFault]:
+  assumes exec_guards: "\<Gamma>\<turnstile>\<langle>guards gs c,Normal s\<rangle> =n\<Rightarrow> t"
+  assumes noFault: "\<forall>f g. (f, g) \<in> set gs \<longrightarrow> s \<in> g \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t \<Longrightarrow> P"
+  assumes someFault: "\<And>f g. find (\<lambda>(f,g). s \<notin> g) gs = Some (f, g) \<Longrightarrow> t = Fault f \<Longrightarrow> P"
+  shows "P"
+  using exec_guards noFault someFault
+proof (induct gs)
+  case Nil
+  then show ?case by simp
+next
+  case (Cons pg gs)
+  obtain f g where pg: "pg = (f, g)"
+    by (cases pg) auto
+  show ?thesis
+  proof (cases "s \<in> g")
+    case True
+    from Cons.prems(1) have exec_gs: "\<Gamma>\<turnstile> \<langle>guards gs c,Normal s\<rangle> =n\<Rightarrow> t"
+      by (simp add: pg) (meson True pg execn_Normal_elim_cases)
+
+    from Cons.hyps [OF exec_gs] Cons.prems(2,3)
+    show ?thesis
+      by (simp add: pg True)
+  next
+    case False
+    from Cons.prems(1) have t: "t = Fault f"
+      by (simp add: pg) (meson False pg execn_Normal_elim_cases)
+
+    from t Cons.prems(3)
+    show ?thesis
+      by (simp add: pg False)
+  qed
+qed
+
+lemma execn_maybe_guard_Normal_elim_cases [consumes 1, case_names noFault someFault]:
+  assumes exec_guards: "\<Gamma>\<turnstile>\<langle>maybe_guard f g c,Normal s\<rangle> =n\<Rightarrow> t"
+  assumes noFault: "s \<in> g \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t \<Longrightarrow> P"
+  assumes someFault: "s \<notin> g \<Longrightarrow> t = Fault f \<Longrightarrow> P"
+  shows "P"
+  using exec_guards noFault someFault
+  by (metis UNIV_I execn_Normal_elim_cases(5) maybe_guard_def)
+
+lemma execn_guards_noFault:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
+  assumes noFault: "\<forall>f g. (f, g) \<in> set gs \<longrightarrow> s \<in> g"
+  shows "\<Gamma>\<turnstile>\<langle>guards gs c,Normal s\<rangle> =n\<Rightarrow> t"
+  using exec noFault by (induct gs) (auto intro: execn.intros)
+
+lemma execn_guards_Fault:
+  assumes Fault: "find (\<lambda>(f,g). s \<notin> g) gs = Some (f, g)"
+  shows "\<Gamma>\<turnstile>\<langle>guards gs c,Normal s\<rangle> =n\<Rightarrow> Fault f"
+  using Fault by (induct gs) (auto intro: execn.intros  split: prod.splits if_split_asm)
+
+lemma execn_maybe_guard_noFault:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
+  assumes noFault: "s \<in> g"
+  shows "\<Gamma>\<turnstile>\<langle>maybe_guard f g c,Normal s\<rangle> =n\<Rightarrow> t"
+  using exec noFault
+  by (auto intro: execn.intros simp add: maybe_guard_def)
+
+lemma execn_maybe_guard_Fault:
+  assumes Fault: "s \<notin> g"
+  shows "\<Gamma>\<turnstile>\<langle>maybe_guard f g c,Normal s\<rangle> =n\<Rightarrow> Fault f"
+  using Fault by (auto simp add: maybe_guard_def intro: execn.intros  split: prod.splits if_split_asm)
+
+lemma execn_guards_DynCom_Normal_elim:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>guards gs (DynCom c), Normal s\<rangle> =n\<Rightarrow> t"
+  assumes call: "\<Gamma>\<turnstile>\<langle>guards gs (c s), Normal s\<rangle> =n\<Rightarrow>  t \<Longrightarrow> P"
+  shows "P"
+  using exec call proof (induct gs)
+  case Nil
+  then show ?case
+    apply simp
+    apply (erule execn_Normal_elim_cases)
+    apply simp
+    done
+next
+  case (Cons g gs)
+  then show ?case
+    apply (cases g)
+    apply simp
+    apply (erule execn_Normal_elim_cases)
+     apply simp
+     apply (meson execn.Guard)
+    apply simp
+    apply (meson execn.GuardFault)
+    done
+qed
+
+lemma execn_maybe_guard_DynCom_Normal_elim:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (DynCom c), Normal s\<rangle> =n\<Rightarrow> t"
+  assumes call: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (c s), Normal s\<rangle> =n\<Rightarrow>  t \<Longrightarrow> P"
+  shows "P"
+  using exec call
+  by (metis execn.Guard execn.GuardFault execn_Normal_elim_cases(12) execn_Normal_elim_cases(5) maybe_guard_def)
+
+lemma execn_guards_DynCom:
+  assumes exec_c: "\<Gamma>\<turnstile>\<langle>guards gs (c s), Normal s\<rangle> =n\<Rightarrow> t"
+  shows "\<Gamma>\<turnstile>\<langle>guards gs (DynCom c), Normal s\<rangle> =n\<Rightarrow> t"
+  using exec_c apply (induct gs)
+   apply (fastforce intro: execn.intros)
+  apply simp
+  by (metis execn.Guard execn.GuardFault execn_Normal_elim_cases)
+
+lemma execn_maybe_guard_DynCom:
+  assumes exec_c: "\<Gamma>\<turnstile>\<langle>maybe_guard f g (c s), Normal s\<rangle> =n\<Rightarrow> t"
+  shows "\<Gamma>\<turnstile>\<langle>maybe_guard f g (DynCom c), Normal s\<rangle> =n\<Rightarrow> t"
+  using exec_c
+  apply (cases "g = UNIV")
+  subgoal
+    apply simp
+    apply (rule execn.intros)
+    apply simp
+    done
+  subgoal
+    apply (simp add: maybe_guard_def)
+    by (metis execn.DynCom execn.Guard execn.GuardFault execn_Normal_elim_cases(5))
+  done
+
+
+lemma execn_dynCall_exn_Normal_elim:
+  assumes exec: "\<Gamma>\<turnstile>\<langle>dynCall_exn f g init p return result_exn c,Normal s\<rangle> =n\<Rightarrow>  t"
+  assumes "\<Gamma>\<turnstile>\<langle>maybe_guard f g (call_exn init (p s) return result_exn c),Normal s\<rangle> =n\<Rightarrow>  t \<Longrightarrow> P"
+  shows "P"
+  using exec
+  apply (simp add: dynCall_exn_def)
+  apply (erule execn_maybe_guard_DynCom_Normal_elim)
+  apply fact
+  done
 
 lemma  execn_Seq':
        "\<lbrakk>\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow>  s'; \<Gamma>\<turnstile>\<langle>c2,s'\<rangle> =n\<Rightarrow>  s''\<rbrakk>
         \<Longrightarrow>
         \<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> =n\<Rightarrow>  s''"
   apply (cases s)
   apply    (fastforce intro: execn.intros)
   apply   (fastforce dest: execn_Abrupt_end)
   apply  (fastforce dest: execn_Fault_end)
   apply (fastforce dest: execn_Stuck_end)
   done
 
 lemma execn_mono:
  assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t"
   shows "\<And> m. n \<le> m \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =m\<Rightarrow>  t"
 using exec
 by (induct) (auto intro: execn.intros dest: Suc_le_D)
 
 
 lemma execn_Suc:
   "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =Suc n\<Rightarrow>  t"
   by (rule execn_mono [OF _ le_refl [THEN le_SucI]])
 
 lemma execn_assoc:
  "\<Gamma>\<turnstile>\<langle>Seq c1 (Seq c2 c3),s\<rangle> =n\<Rightarrow>  t = \<Gamma>\<turnstile>\<langle>Seq (Seq c1 c2) c3,s\<rangle> =n\<Rightarrow>  t"
   by (auto elim!: execn_elim_cases intro: execn_Seq')
 
 
 lemma execn_to_exec:
   assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 using execn
 by induct (auto intro: exec.intros)
 
 lemma exec_to_execn:
   assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>n. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>  t"
 using execn
 proof (induct)
   case Skip thus ?case by (iprover intro: execn.intros)
 next
   case Guard thus ?case by (iprover intro: execn.intros)
 next
   case GuardFault thus ?case by (iprover intro: execn.intros)
 next
  case FaultProp thus ?case by (iprover intro: execn.intros)
 next
   case Basic thus ?case by (iprover intro: execn.intros)
 next
   case Spec thus ?case by (iprover intro: execn.intros)
 next
   case SpecStuck thus ?case by (iprover intro: execn.intros)
 next
   case (Seq c1 s s' c2 s'')
   then obtain n m where
     "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow>  s'" "\<Gamma>\<turnstile>\<langle>c2,s'\<rangle> =m\<Rightarrow>  s''"
     by blast
   then have
     "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =max n m\<Rightarrow>  s'"
     "\<Gamma>\<turnstile>\<langle>c2,s'\<rangle> =max n m\<Rightarrow>  s''"
     by (auto elim!: execn_mono intro: max.cobounded1 max.cobounded2)
   thus ?case
     by (iprover intro: execn.intros)
 next
   case CondTrue thus ?case by (iprover intro: execn.intros)
 next
   case CondFalse thus ?case by (iprover intro: execn.intros)
 next
   case (WhileTrue s b c s' s'')
   then obtain n m where
     "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow>  s'" "\<Gamma>\<turnstile>\<langle>While b c,s'\<rangle> =m\<Rightarrow>  s''"
     by blast
   then have
     "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =max n m\<Rightarrow>  s'" "\<Gamma>\<turnstile>\<langle>While b c,s'\<rangle> =max n m\<Rightarrow>  s''"
     by (auto elim!: execn_mono intro: max.cobounded1 max.cobounded2)
   with WhileTrue
   show ?case
     by (iprover intro: execn.intros)
 next
   case WhileFalse thus ?case by (iprover intro: execn.intros)
 next
   case Call thus ?case by (iprover intro: execn.intros)
 next
   case CallUndefined thus ?case by (iprover intro: execn.intros)
 next
   case StuckProp thus ?case by (iprover intro: execn.intros)
 next
   case DynCom thus ?case by (iprover intro: execn.intros)
 next
   case Throw thus ?case by (iprover intro: execn.intros)
 next
   case AbruptProp thus ?case by (iprover intro: execn.intros)
 next
   case (CatchMatch c1 s s' c2 s'')
   then obtain n m where
     "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow>  Abrupt s'" "\<Gamma>\<turnstile>\<langle>c2,Normal s'\<rangle> =m\<Rightarrow>  s''"
     by blast
   then have
     "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =max n m\<Rightarrow>  Abrupt s'"
     "\<Gamma>\<turnstile>\<langle>c2,Normal s'\<rangle> =max n m\<Rightarrow>  s''"
     by (auto elim!: execn_mono intro: max.cobounded1 max.cobounded2)
   with CatchMatch.hyps show ?case
     by (iprover intro: execn.intros)
 next
   case CatchMiss thus ?case by (iprover intro: execn.intros)
 qed
 
 theorem exec_iff_execn: "(\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t) = (\<exists>n. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t)"
   by (iprover intro: exec_to_execn execn_to_exec)
 
 
 definition nfinal_notin:: "('s,'p,'f) body \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'f) xstate \<Rightarrow>  nat
                        \<Rightarrow> ('s,'f) xstate set \<Rightarrow> bool"
   ("_\<turnstile> \<langle>_,_\<rangle> =_\<Rightarrow>\<notin>_"  [60,20,98,65,60] 89) where
 "\<Gamma>\<turnstile> \<langle>c,s\<rangle> =n\<Rightarrow>\<notin>T = (\<forall>t. \<Gamma>\<turnstile> \<langle>c,s\<rangle> =n\<Rightarrow> t \<longrightarrow> t\<notin>T)"
 
 definition final_notin:: "('s,'p,'f) body \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'f) xstate
                        \<Rightarrow> ('s,'f) xstate set \<Rightarrow> bool"
   ("_\<turnstile> \<langle>_,_\<rangle> \<Rightarrow>\<notin>_"  [60,20,98,60] 89) where
 "\<Gamma>\<turnstile> \<langle>c,s\<rangle> \<Rightarrow>\<notin>T = (\<forall>t. \<Gamma>\<turnstile> \<langle>c,s\<rangle> \<Rightarrow>t \<longrightarrow> t\<notin>T)"
 
 lemma final_notinI: "\<lbrakk>\<And>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<Longrightarrow> t \<notin> T\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>T"
   by (simp add: final_notin_def)
 
 lemma noFaultStuck_Call_body': "p \<in> dom \<Gamma> \<Longrightarrow>
 \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F)) =
 \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
   by (clarsimp simp add: final_notin_def exec_Call_body)
 
 lemma noFault_startn:
   assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" and t: "t\<noteq>Fault f"
   shows "s\<noteq>Fault f"
 using execn t by (induct) auto
 
 lemma noFault_start:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t" and t: "t\<noteq>Fault f"
   shows "s\<noteq>Fault f"
 using exec t by (induct) auto
 
 lemma noStuck_startn:
   assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" and t: "t\<noteq>Stuck"
   shows "s\<noteq>Stuck"
 using execn t by (induct) auto
 
 lemma noStuck_start:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t" and t: "t\<noteq>Stuck"
   shows "s\<noteq>Stuck"
 using exec t by (induct) auto
 
 lemma noAbrupt_startn:
   assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" and t: "\<forall>t'. t\<noteq>Abrupt t'"
   shows "s\<noteq>Abrupt s'"
 using execn t by (induct) auto
 
 lemma noAbrupt_start:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t" and t: "\<forall>t'. t\<noteq>Abrupt t'"
   shows "s\<noteq>Abrupt s'"
 using exec t by (induct) auto
 
 lemma noFaultn_startD: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Normal t \<Longrightarrow> s \<noteq> Fault f"
   by (auto dest: noFault_startn)
 
 lemma noFaultn_startD': "t\<noteq>Fault f \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t \<Longrightarrow> s \<noteq> Fault f"
   by (auto dest: noFault_startn)
 
 lemma noFault_startD: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Normal t \<Longrightarrow> s \<noteq> Fault f"
   by (auto dest: noFault_start)
 
 lemma noFault_startD': "t\<noteq>Fault f\<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<Longrightarrow> s \<noteq> Fault f"
   by (auto dest: noFault_start)
 
 lemma noStuckn_startD: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Normal t \<Longrightarrow> s \<noteq> Stuck"
   by (auto dest: noStuck_startn)
 
 lemma noStuckn_startD': "t\<noteq>Stuck \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t \<Longrightarrow> s \<noteq> Stuck"
   by (auto dest: noStuck_startn)
 
 lemma noStuck_startD: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Normal t \<Longrightarrow> s \<noteq> Stuck"
   by (auto dest: noStuck_start)
 
 lemma noStuck_startD': "t\<noteq>Stuck \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t \<Longrightarrow> s \<noteq> Stuck"
   by (auto dest: noStuck_start)
 
 lemma noAbruptn_startD: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Normal t \<Longrightarrow> s \<noteq> Abrupt s'"
   by (auto dest: noAbrupt_startn)
 
 lemma noAbrupt_startD: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Normal t \<Longrightarrow> s \<noteq> Abrupt s'"
   by (auto dest: noAbrupt_start)
 
 lemma noFaultnI: "\<lbrakk>\<And>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t \<Longrightarrow> t\<noteq>Fault f\<rbrakk> \<Longrightarrow>  \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault f}"
   by (simp add: nfinal_notin_def)
 
 lemma noFaultnI':
   assumes contr: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Fault f \<Longrightarrow> False"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault f}"
   proof (rule noFaultnI)
     fix t assume "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     with contr show "t \<noteq> Fault f"
       by (cases "t=Fault f") auto
   qed
 
 lemma noFaultn_def': "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault f} = (\<not>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Fault f)"
   apply rule
   apply  (fastforce simp add: nfinal_notin_def)
   apply (fastforce intro: noFaultnI')
   done
 
 lemma noStucknI: "\<lbrakk>\<And>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t \<Longrightarrow> t\<noteq>Stuck\<rbrakk> \<Longrightarrow>  \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Stuck}"
   by (simp add: nfinal_notin_def)
 
 lemma noStucknI':
   assumes contr: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Stuck \<Longrightarrow> False"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Stuck}"
   proof (rule noStucknI)
     fix t assume "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     with contr show "t \<noteq> Stuck"
       by (cases t) auto
   qed
 
 lemma noStuckn_def': "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Stuck} = (\<not>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Stuck)"
   apply rule
   apply  (fastforce simp add: nfinal_notin_def)
   apply (fastforce intro: noStucknI')
   done
 
 
 lemma noFaultI: "\<lbrakk>\<And>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t \<Longrightarrow> t\<noteq>Fault f\<rbrakk> \<Longrightarrow>  \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault f}"
   by (simp add: final_notin_def)
 
 lemma noFaultI':
   assumes contr: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f\<Longrightarrow> False"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault f}"
   proof (rule noFaultI)
     fix t assume "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
     with contr show "t \<noteq> Fault f"
       by (cases "t=Fault f") auto
   qed
 
 lemma noFaultE:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault f}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f\<rbrakk> \<Longrightarrow> P"
   by (auto simp add: final_notin_def)
 
 lemma noFault_def': "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault f} = (\<not>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f)"
   apply rule
   apply  (fastforce simp add: final_notin_def)
   apply (fastforce intro: noFaultI')
   done
 
 
 lemma noStuckI: "\<lbrakk>\<And>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t \<Longrightarrow> t\<noteq>Stuck\<rbrakk> \<Longrightarrow>  \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (simp add: final_notin_def)
 
 lemma noStuckI':
   assumes contr: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Stuck \<Longrightarrow> False"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   proof (rule noStuckI)
     fix t assume "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
     with contr show "t \<noteq> Stuck"
       by (cases t) auto
   qed
 
 lemma noStuckE:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Stuck\<rbrakk> \<Longrightarrow> P"
   by (auto simp add: final_notin_def)
 
 lemma noStuck_def': "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck} = (\<not>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Stuck)"
   apply rule
   apply  (fastforce simp add: final_notin_def)
   apply (fastforce intro: noStuckI')
   done
 
 
 lemma noFaultn_execD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault f}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t\<rbrakk> \<Longrightarrow> t\<noteq>Fault f"
   by (simp add: nfinal_notin_def)
 
 lemma noFault_execD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault f}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t\<rbrakk> \<Longrightarrow> t\<noteq>Fault f"
   by (simp add: final_notin_def)
 
 lemma noFaultn_exec_startD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault f}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t\<rbrakk> \<Longrightarrow> s\<noteq>Fault f"
   by (auto simp add: nfinal_notin_def dest: noFaultn_startD)
 
 lemma noFault_exec_startD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault f}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t\<rbrakk> \<Longrightarrow> s\<noteq>Fault f"
   by (auto simp add: final_notin_def dest: noFault_startD)
 
 lemma noStuckn_execD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t\<rbrakk> \<Longrightarrow> t\<noteq>Stuck"
   by (simp add: nfinal_notin_def)
 
 lemma noStuck_execD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t\<rbrakk> \<Longrightarrow> t\<noteq>Stuck"
   by (simp add: final_notin_def)
 
 lemma noStuckn_exec_startD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t\<rbrakk> \<Longrightarrow> s\<noteq>Stuck"
   by (auto simp add: nfinal_notin_def dest: noStuckn_startD)
 
 lemma noStuck_exec_startD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t\<rbrakk> \<Longrightarrow> s\<noteq>Stuck"
   by (auto simp add: final_notin_def dest: noStuck_startD)
 
 lemma noFaultStuckn_execD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault True,Fault False,Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t\<rbrakk> \<Longrightarrow>
        t\<notin>{Fault True,Fault False,Stuck}"
   by (simp add: nfinal_notin_def)
 
 lemma noFaultStuck_execD: "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault True,Fault False,Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t\<rbrakk>
  \<Longrightarrow> t\<notin>{Fault True,Fault False,Stuck}"
   by (simp add: final_notin_def)
 
 lemma noFaultStuckn_exec_startD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>{Fault True, Fault False,Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t\<rbrakk>
    \<Longrightarrow> s\<notin>{Fault True,Fault False,Stuck}"
   by (auto simp add: nfinal_notin_def )
 
 lemma noFaultStuck_exec_startD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>{Fault True, Fault False,Stuck}; \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>t\<rbrakk>
   \<Longrightarrow> s\<notin>{Fault True,Fault False,Stuck}"
   by (auto simp add: final_notin_def )
 
 lemma noStuck_Call:
   assumes noStuck: "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   shows "p \<in> dom \<Gamma>"
 proof (cases "p \<in> dom \<Gamma>")
   case True thus ?thesis by simp
 next
   case False
   hence "\<Gamma> p = None" by auto
   hence "\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>Stuck"
     by (rule exec.CallUndefined)
   with noStuck show ?thesis
     by (auto simp add: final_notin_def)
 qed
 
 
 lemma Guard_noFaultStuckD:
   assumes "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault ` (-F))"
   assumes "f \<notin> F"
   shows "s \<in> g"
   using assms
   by (auto simp add: final_notin_def intro: exec.intros)
 
 
 lemma final_notin_to_finaln:
   assumes notin: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>T"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>T"
 proof (clarsimp simp add: nfinal_notin_def)
   fix t assume "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" and "t\<in>T"
   with notin show "False"
     by (auto intro: execn_to_exec simp add: final_notin_def)
 qed
 
 lemma noFault_Call_body:
 "\<Gamma> p=Some bdy\<Longrightarrow>
  \<Gamma>\<turnstile>\<langle>Call p ,Normal s\<rangle> \<Rightarrow>\<notin>{Fault f} =
  \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>{Fault f}"
   by (simp add: noFault_def' exec_Call_body)
 
 lemma noStuck_Call_body:
 "\<Gamma> p=Some bdy\<Longrightarrow>
  \<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck} =
  \<Gamma>\<turnstile>\<langle>the (\<Gamma> p),Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (simp add: noStuck_def' exec_Call_body)
 
 lemma exec_final_notin_to_execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>T \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>T"
   by (auto simp add: final_notin_def nfinal_notin_def dest: execn_to_exec)
 
 lemma execn_final_notin_to_exec: "\<forall>n. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>T \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>T"
   by (auto simp add: final_notin_def nfinal_notin_def dest: exec_to_execn)
 
 lemma exec_final_notin_iff_execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow>\<notin>T = (\<forall>n. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>\<notin>T)"
   by (auto intro: exec_final_notin_to_execn execn_final_notin_to_exec)
 
 lemma Seq_NoFaultStuckD2:
   assumes noabort: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
   shows "\<forall>t. \<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> t \<longrightarrow> t\<notin> ({Stuck} \<union> Fault `  F) \<longrightarrow>
              \<Gamma>\<turnstile>\<langle>c2,t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
 using noabort
 by (auto simp add: final_notin_def intro: exec_Seq') lemma Seq_NoFaultStuckD1:
   assumes noabort: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
   shows "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
 proof (rule final_notinI)
   fix t
   assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> t"
   show "t \<notin> {Stuck} \<union> Fault `  F"
   proof
     assume "t \<in> {Stuck} \<union> Fault `  F"
     moreover
     {
       assume "t = Stuck"
       with exec_c1
       have "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow> Stuck"
         by (auto intro: exec_Seq')
       with noabort have False
         by (auto simp add: final_notin_def)
       hence False ..
     }
     moreover
     {
       assume "t \<in> Fault ` F"
       then obtain f where
       t: "t=Fault f" and f: "f \<in> F"
         by auto
       from t exec_c1
       have "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec_Seq')
       with noabort f have False
         by (auto simp add: final_notin_def)
       hence False ..
     }
     ultimately show False by auto
   qed
 qed
 
 lemma Seq_NoFaultStuckD2':
   assumes noabort: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
   shows "\<forall>t. \<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> t \<longrightarrow> t\<notin> ({Stuck} \<union> Fault `  F) \<longrightarrow>
              \<Gamma>\<turnstile>\<langle>c2,t\<rangle> \<Rightarrow>\<notin>({Stuck} \<union> Fault `  F)"
 using noabort
 by (auto simp add: final_notin_def intro: exec_Seq')
 
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "sequence"}, @{const "flatten"} and
  @{const "normalize"}\<close>
 (* ************************************************************************ *)
 
 lemma execn_sequence_app: "\<And>s s' t.
  \<lbrakk>\<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> =n\<Rightarrow> s'; \<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> =n\<Rightarrow> t\<rbrakk>
  \<Longrightarrow> \<Gamma>\<turnstile>\<langle>sequence Seq (xs@ys),Normal s\<rangle> =n\<Rightarrow> t"
 proof (induct xs)
   case Nil
   thus ?case by (auto elim: execn_Normal_elim_cases)
 next
   case (Cons x xs)
   have exec_x_xs: "\<Gamma>\<turnstile>\<langle>sequence Seq (x # xs),Normal s\<rangle> =n\<Rightarrow> s'" by fact
   have exec_ys: "\<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases xs)
     case Nil
     with exec_x_xs have "\<Gamma>\<turnstile>\<langle>x,Normal s\<rangle> =n\<Rightarrow> s'"
       by (auto elim: execn_Normal_elim_cases )
     with Nil exec_ys show ?thesis
       by (cases ys) (auto intro: execn.intros elim: execn_elim_cases)
   next
     case Cons
     with exec_x_xs
     obtain s'' where
       exec_x: "\<Gamma>\<turnstile>\<langle>x,Normal s\<rangle> =n\<Rightarrow> s''" and
       exec_xs: "\<Gamma>\<turnstile>\<langle>sequence Seq xs,s''\<rangle> =n\<Rightarrow> s'"
       by (auto elim: execn_Normal_elim_cases )
     show ?thesis
     proof (cases s'')
       case (Normal s''')
       from Cons.hyps [OF exec_xs [simplified Normal] exec_ys]
       have "\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s'''\<rangle> =n\<Rightarrow> t" .
       with Cons exec_x Normal
       show ?thesis
         by (auto intro: execn.intros)
     next
       case (Abrupt s''')
       with exec_xs have "s'=Abrupt s'''"
         by (auto dest: execn_Abrupt_end)
       with exec_ys have "t=Abrupt s'''"
         by (auto dest: execn_Abrupt_end)
       with exec_x Abrupt Cons show ?thesis
         by (auto intro: execn.intros)
     next
       case (Fault f)
       with exec_xs have "s'=Fault f"
         by (auto dest: execn_Fault_end)
       with exec_ys have "t=Fault f"
         by (auto dest: execn_Fault_end)
       with exec_x Fault Cons show ?thesis
         by (auto intro: execn.intros)
     next
       case Stuck
       with exec_xs have "s'=Stuck"
         by (auto dest: execn_Stuck_end)
       with exec_ys have "t=Stuck"
         by (auto dest: execn_Stuck_end)
       with exec_x Stuck Cons show ?thesis
         by (auto intro: execn.intros)
     qed
   qed
 qed
 
 lemma execn_sequence_appD: "\<And>s t. \<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s\<rangle> =n\<Rightarrow> t \<Longrightarrow>
          \<exists>s'. \<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> =n\<Rightarrow> s' \<and> \<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> =n\<Rightarrow> t"
 proof (induct xs)
   case Nil
   thus ?case
     by (auto intro: execn.intros)
 next
   case (Cons x xs)
   have exec_app: "\<Gamma>\<turnstile>\<langle>sequence Seq ((x # xs) @ ys),Normal s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases xs)
     case Nil
     with exec_app show ?thesis
       by (cases ys) (auto elim: execn_Normal_elim_cases intro: execn_Skip')
   next
     case Cons
     with exec_app obtain s' where
       exec_x: "\<Gamma>\<turnstile>\<langle>x,Normal s\<rangle> =n\<Rightarrow> s'" and
       exec_xs_ys: "\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),s'\<rangle> =n\<Rightarrow> t"
       by (auto elim: execn_Normal_elim_cases)
     show ?thesis
     proof (cases s')
       case (Normal s'')
       from Cons.hyps [OF exec_xs_ys [simplified Normal]] Normal exec_x Cons
       show ?thesis
         by (auto intro: execn.intros)
     next
       case (Abrupt s'')
       with exec_xs_ys have "t=Abrupt s''"
         by (auto dest: execn_Abrupt_end)
       with Abrupt exec_x Cons
       show ?thesis
         by (auto intro: execn.intros)
     next
       case (Fault f)
       with exec_xs_ys have "t=Fault f"
         by (auto dest: execn_Fault_end)
       with Fault exec_x Cons
       show ?thesis
         by (auto intro: execn.intros)
     next
       case Stuck
       with exec_xs_ys have "t=Stuck"
         by (auto dest: execn_Stuck_end)
       with Stuck exec_x Cons
       show ?thesis
         by (auto intro: execn.intros)
     qed
   qed
 qed
 
 lemma execn_sequence_appE [consumes 1]:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s\<rangle> =n\<Rightarrow> t;
    \<And>s'. \<lbrakk>\<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> =n\<Rightarrow> s';\<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> =n\<Rightarrow> t\<rbrakk> \<Longrightarrow> P
    \<rbrakk> \<Longrightarrow> P"
   by (auto dest: execn_sequence_appD)
 
 lemma execn_to_execn_sequence_flatten:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten c),s\<rangle> =n\<Rightarrow> t"
 using exec
 proof induct
   case (Seq c1 c2 n s s' s'') thus ?case
     by (auto intro: execn.intros execn_sequence_app)
 qed (auto intro: execn.intros)
 
 lemma execn_to_execn_normalize:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> =n\<Rightarrow> t"
 using exec
 proof induct
   case (Seq c1 c2 n s s' s'') thus ?case
     by (auto intro: execn_to_execn_sequence_flatten  execn_sequence_app )
 qed (auto intro: execn.intros)
 
 
 
 lemma execn_sequence_flatten_to_execn:
   shows "\<And>s t. \<Gamma>\<turnstile>\<langle>sequence Seq (flatten c),s\<rangle> =n\<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
 proof (induct c)
   case (Seq c1 c2)
   have exec_seq: "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten (Seq c1 c2)),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Normal s')
     with exec_seq obtain s'' where
       "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten c1),Normal s'\<rangle> =n\<Rightarrow> s''" and
       "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten c2),s''\<rangle> =n\<Rightarrow> t"
       by (auto elim: execn_sequence_appE)
     with Seq.hyps Normal
     show ?thesis
       by (fastforce intro: execn.intros)
   next
     case Abrupt
     with exec_seq
     show ?thesis by (auto intro: execn.intros dest: execn_Abrupt_end)
   next
     case Fault
     with exec_seq
     show ?thesis by (auto intro: execn.intros dest: execn_Fault_end)
   next
     case Stuck
     with exec_seq
     show ?thesis by (auto intro: execn.intros dest: execn_Stuck_end)
   qed
 qed auto
 
 lemma execn_normalize_to_execn:
   shows "\<And>s t n. \<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> =n\<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
 proof (induct c)
   case Skip thus ?case by simp
 next
   case Basic thus ?case by simp
 next
   case Spec thus ?case by simp
 next
   case (Seq c1 c2)
   have "\<Gamma>\<turnstile>\<langle>normalize (Seq c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   hence exec_norm_seq:
     "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten (normalize c1) @ flatten (normalize c2)),s\<rangle> =n\<Rightarrow> t"
     by simp
   show ?case
   proof (cases s)
     case (Normal s')
     with exec_norm_seq obtain s'' where
       exec_norm_c1: "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten (normalize c1)),Normal s'\<rangle> =n\<Rightarrow> s''" and
       exec_norm_c2: "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten (normalize c2)),s''\<rangle> =n\<Rightarrow> t"
       by (auto elim: execn_sequence_appE)
     from execn_sequence_flatten_to_execn [OF exec_norm_c1]
       execn_sequence_flatten_to_execn [OF exec_norm_c2] Seq.hyps Normal
     show ?thesis
       by (fastforce intro: execn.intros)
   next
     case (Abrupt s')
     with exec_norm_seq have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by (auto intro: execn.intros)
   next
     case (Fault f)
     with exec_norm_seq have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by (auto intro: execn.intros)
   next
     case Stuck
     with exec_norm_seq have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by (auto intro: execn.intros)
   qed
 next
   case Cond thus ?case
     by (auto intro: execn.intros elim!: execn_elim_cases)
 next
   case (While b c)
   have "\<Gamma>\<turnstile>\<langle>normalize (While b c),s\<rangle> =n\<Rightarrow> t" by fact
   hence exec_norm_w: "\<Gamma>\<turnstile>\<langle>While b (normalize c),s\<rangle> =n\<Rightarrow> t"
     by simp
   {
     fix s t w
     assume exec_w: "\<Gamma>\<turnstile>\<langle>w,s\<rangle> =n\<Rightarrow> t"
     have "w=While b (normalize c) \<Longrightarrow> \<Gamma>\<turnstile>\<langle>While b c,s\<rangle> =n\<Rightarrow> t"
       using exec_w
     proof (induct)
       case (WhileTrue s b' c' n w t)
       from WhileTrue obtain
         s_in_b: "s \<in> b" and
         exec_c: "\<Gamma>\<turnstile>\<langle>normalize c,Normal s\<rangle> =n\<Rightarrow> w" and
         hyp_w: "\<Gamma>\<turnstile>\<langle>While b c,w\<rangle> =n\<Rightarrow> t"
         by simp
       from While.hyps [OF exec_c]
       have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> w"
         by simp
       with hyp_w s_in_b
       have "\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> =n\<Rightarrow> t"
         by (auto intro: execn.intros)
       with WhileTrue show ?case by simp
     qed (auto intro: execn.intros)
   }
   from this [OF exec_norm_w]
   show ?case
     by simp
 next
   case Call thus ?case by simp
 next
   case DynCom thus ?case by (auto intro: execn.intros elim!: execn_elim_cases)
 next
   case Guard thus ?case by (auto intro: execn.intros elim!: execn_elim_cases)
 next
   case Throw thus ?case by simp
 next
   case Catch thus ?case by (fastforce intro: execn.intros elim!: execn_elim_cases)
 qed
 
 lemma execn_normalize_iff_execn:
  "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> =n\<Rightarrow> t = \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   by (auto intro: execn_to_execn_normalize execn_normalize_to_execn)
 
 lemma exec_sequence_app:
   assumes exec_xs: "\<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> \<Rightarrow> s'"
   assumes exec_ys: "\<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> \<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>sequence Seq (xs@ys),Normal s\<rangle> \<Rightarrow> t"
 proof -
   from exec_to_execn [OF exec_xs]
   obtain n where
     execn_xs: "\<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> =n\<Rightarrow> s'"..
   from exec_to_execn [OF exec_ys]
   obtain m where
     execn_ys: "\<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> =m\<Rightarrow> t"..
   with execn_xs obtain
     "\<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> =max n m\<Rightarrow> s'"
     "\<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> =max n m\<Rightarrow> t"
     by (auto intro: execn_mono max.cobounded1 max.cobounded2)
   from execn_sequence_app [OF this]
   have "\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s\<rangle> =max n m\<Rightarrow> t" .
   thus ?thesis
     by (rule execn_to_exec)
 qed
 
 lemma exec_sequence_appD:
   assumes exec_xs_ys: "\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s\<rangle> \<Rightarrow> t"
   shows "\<exists>s'. \<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> \<Rightarrow> s' \<and> \<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> \<Rightarrow> t"
 proof -
   from exec_to_execn [OF exec_xs_ys]
   obtain n where "\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s\<rangle> =n\<Rightarrow> t"..
   thus ?thesis
     by (cases rule: execn_sequence_appE) (auto intro: execn_to_exec)
 qed
 
 
 lemma exec_sequence_appE [consumes 1]:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>sequence Seq (xs @ ys),Normal s\<rangle> \<Rightarrow> t;
    \<And>s'. \<lbrakk>\<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s\<rangle> \<Rightarrow> s';\<Gamma>\<turnstile>\<langle>sequence Seq ys,s'\<rangle> \<Rightarrow> t\<rbrakk> \<Longrightarrow> P
    \<rbrakk> \<Longrightarrow> P"
   by (auto dest: exec_sequence_appD)
 
 lemma exec_to_exec_sequence_flatten:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten c),s\<rangle> \<Rightarrow> t"
 proof -
   from exec_to_execn [OF exec]
   obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"..
   from execn_to_execn_sequence_flatten [OF this]
   show ?thesis
     by (rule execn_to_exec)
 qed
 
 lemma exec_sequence_flatten_to_exec:
   assumes exec_seq: "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten c),s\<rangle> \<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_to_execn [OF exec_seq]
   obtain n where "\<Gamma>\<turnstile>\<langle>sequence Seq (flatten c),s\<rangle> =n\<Rightarrow> t"..
   from execn_sequence_flatten_to_execn [OF this]
   show ?thesis
     by (rule execn_to_exec)
 qed
 
 lemma exec_to_exec_normalize:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_to_execn [OF exec] obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"..
   hence "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> =n\<Rightarrow> t"
     by (rule execn_to_execn_normalize)
   thus ?thesis
     by (rule execn_to_exec)
 qed
 
 lemma exec_normalize_to_exec:
   assumes exec: "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> \<Rightarrow> t"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_to_execn [OF exec] obtain n where "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> =n\<Rightarrow> t"..
   hence "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     by (rule execn_normalize_to_execn)
   thus ?thesis
     by (rule execn_to_exec)
 qed
 
 lemma exec_normalize_iff_exec:
  "\<Gamma>\<turnstile>\<langle>normalize c,s\<rangle> \<Rightarrow> t = \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   by (auto intro: exec_to_exec_normalize exec_normalize_to_exec)
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{term "c\<^sub>1 \<subseteq>\<^sub>g c\<^sub>2"}\<close>
 (* ************************************************************************ *)
 
 lemma execn_to_execn_subseteq_guards: "\<And>c s t n. \<lbrakk>c \<subseteq>\<^sub>g c'; \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t\<rbrakk>
     \<Longrightarrow> \<exists>t'. \<Gamma>\<turnstile>\<langle>c',s\<rangle> =n\<Rightarrow> t' \<and>
             (isFault t \<longrightarrow> isFault t') \<and> (\<not> isFault t' \<longrightarrow> t'=t)"
 proof (induct c')
   case Skip thus ?case
     by (fastforce dest: subseteq_guardsD elim: execn_elim_cases)
 next
   case Basic thus ?case
     by (fastforce dest: subseteq_guardsD elim: execn_elim_cases)
 next
   case Spec thus ?case
     by (fastforce dest: subseteq_guardsD elim: execn_elim_cases)
 next
   case (Seq c1' c2')
   have "c \<subseteq>\<^sub>g Seq c1' c2'" by fact
   from subseteq_guards_Seq [OF this]
   obtain c1 c2 where
     c: "c = Seq c1 c2" and
     c1_c1': "c1 \<subseteq>\<^sub>g c1'" and
     c2_c2': "c2 \<subseteq>\<^sub>g c2'"
     by blast
   have exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" by fact
   with c obtain w where
     exec_c1: "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> w" and
     exec_c2: "\<Gamma>\<turnstile>\<langle>c2,w\<rangle> =n\<Rightarrow> t"
     by (auto elim: execn_elim_cases)
   from exec_c1 Seq.hyps c1_c1'
   obtain w' where
     exec_c1': "\<Gamma>\<turnstile>\<langle>c1',s\<rangle> =n\<Rightarrow> w'" and
     w_Fault: "isFault w \<longrightarrow> isFault w'" and
     w'_noFault: "\<not> isFault w' \<longrightarrow> w'=w"
     by blast
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "isFault w")
       case True
       then obtain f where w': "w=Fault f"..
       moreover with exec_c2
       have t: "t=Fault f"
         by (auto dest: execn_Fault_end)
       ultimately show ?thesis
         using Normal w_Fault exec_c1'
         by (fastforce intro: execn.intros elim: isFaultE)
     next
       case False
       note noFault_w = this
       show ?thesis
       proof (cases "isFault w'")
         case True
         then obtain f' where w': "w'=Fault f'"..
         with Normal exec_c1'
         have exec: "\<Gamma>\<turnstile>\<langle>Seq c1' c2',s\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         then show ?thesis
           by auto
       next
         case False
         with w'_noFault have w': "w'=w" by simp
         from Seq.hyps exec_c2 c2_c2'
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>c2',w\<rangle> =n\<Rightarrow> t'" and
           "isFault t \<longrightarrow> isFault t'" and
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with Normal exec_c1' w'
         show ?thesis
           by (fastforce intro: execn.intros)
       qed
     qed
   qed
 next
   case (Cond b c1' c2')
   have exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" by fact
   have "c \<subseteq>\<^sub>g Cond b c1' c2'" by fact
   from subseteq_guards_Cond [OF this]
   obtain c1 c2 where
     c: "c = Cond b c1 c2" and
     c1_c1': "c1 \<subseteq>\<^sub>g c1'" and
     c2_c2': "c2 \<subseteq>\<^sub>g c2'"
     by blast
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     from exec [simplified c Normal]
     show ?thesis
     proof (cases)
       assume s'_in_b: "s' \<in> b"
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> t"
       with c1_c1' Normal Cond.hyps obtain t' where
         "\<Gamma>\<turnstile>\<langle>c1',Normal s'\<rangle> =n\<Rightarrow> t'"
         "isFault t \<longrightarrow> isFault t'"
         "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with s'_in_b Normal show ?thesis
         by (fastforce intro: execn.intros)
     next
       assume s'_notin_b: "s' \<notin> b"
       assume "\<Gamma>\<turnstile>\<langle>c2,Normal s'\<rangle> =n\<Rightarrow> t"
       with c2_c2' Normal Cond.hyps obtain t' where
         "\<Gamma>\<turnstile>\<langle>c2',Normal s'\<rangle> =n\<Rightarrow> t'"
         "isFault t \<longrightarrow> isFault t'"
         "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with s'_notin_b Normal show ?thesis
         by (fastforce intro: execn.intros)
     qed
   qed
 next
   case (While b c')
   have exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" by fact
   have "c \<subseteq>\<^sub>g While b c'" by fact
   from subseteq_guards_While [OF this]
   obtain c'' where
     c: "c = While b c''" and
     c''_c': "c'' \<subseteq>\<^sub>g c'"
     by blast
   {
     fix c r w
     assume exec: "\<Gamma>\<turnstile>\<langle>c,r\<rangle> =n\<Rightarrow> w"
     assume c: "c=While b c''"
     have "\<exists>w'. \<Gamma>\<turnstile>\<langle>While b c',r\<rangle> =n\<Rightarrow> w' \<and>
                  (isFault w \<longrightarrow> isFault w') \<and> (\<not> isFault w' \<longrightarrow> w'=w)"
     using exec c
     proof (induct)
       case (WhileTrue r b' ca n u w)
       have eqs: "While b' ca = While b c''" by fact
       from WhileTrue have r_in_b: "r \<in> b" by simp
       from WhileTrue have exec_c'': "\<Gamma>\<turnstile>\<langle>c'',Normal r\<rangle> =n\<Rightarrow> u" by simp
       from While.hyps [OF c''_c' exec_c''] obtain u' where
         exec_c': "\<Gamma>\<turnstile>\<langle>c',Normal r\<rangle> =n\<Rightarrow> u'" and
         u_Fault: "isFault u \<longrightarrow> isFault u' "and
         u'_noFault: "\<not> isFault u' \<longrightarrow> u' = u"
         by blast
       from WhileTrue obtain w' where
         exec_w: "\<Gamma>\<turnstile>\<langle>While b c',u\<rangle> =n\<Rightarrow> w'" and
         w_Fault: "isFault w \<longrightarrow> isFault w'" and
         w'_noFault: "\<not> isFault w' \<longrightarrow> w' = w"
         by blast
       show ?case
       proof (cases "isFault u'")
         case True
         with exec_c' r_in_b
         show ?thesis
           by (fastforce intro: execn.intros elim: isFaultE)
       next
         case False
         with exec_c' r_in_b u'_noFault exec_w w_Fault w'_noFault
         show ?thesis
           by (fastforce intro: execn.intros)
       qed
     next
       case WhileFalse thus ?case by (fastforce intro: execn.intros)
     qed auto
   }
   from this [OF exec c]
   show ?case .
 next
   case Call thus ?case
     by (fastforce dest: subseteq_guardsD elim: execn_elim_cases)
 next
   case (DynCom C')
   have exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" by fact
   have "c \<subseteq>\<^sub>g DynCom C'" by fact
   from subseteq_guards_DynCom [OF this] obtain C where
     c: "c = DynCom C" and
     C_C': "\<forall>s. C s \<subseteq>\<^sub>g C' s"
     by blast
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     from exec [simplified c Normal]
     have "\<Gamma>\<turnstile>\<langle>C s',Normal s'\<rangle> =n\<Rightarrow> t"
       by cases
     from DynCom.hyps C_C' [rule_format] this obtain t' where
       "\<Gamma>\<turnstile>\<langle>C' s',Normal s'\<rangle> =n\<Rightarrow> t'"
       "isFault t \<longrightarrow> isFault t'"
       "\<not> isFault t' \<longrightarrow> t' = t"
       by blast
     with Normal show ?thesis
       by (fastforce intro: execn.intros)
   qed
 next
   case (Guard f' g' c')
   have exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" by fact
   have "c \<subseteq>\<^sub>g Guard f' g' c'" by fact
   hence subset_cases: "(c \<subseteq>\<^sub>g c') \<or> (\<exists>c''. c = Guard f' g' c'' \<and> (c'' \<subseteq>\<^sub>g c'))"
     by (rule subseteq_guards_Guard)
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     from subset_cases show ?thesis
     proof
       assume c_c': "c \<subseteq>\<^sub>g c'"
       from Guard.hyps [OF this exec] Normal obtain t' where
         exec_c': "\<Gamma>\<turnstile>\<langle>c',Normal s'\<rangle> =n\<Rightarrow> t'" and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with Normal
       show ?thesis
         by (cases "s' \<in> g'") (fastforce intro: execn.intros)+
     next
       assume "\<exists>c''. c = Guard f' g' c'' \<and> (c'' \<subseteq>\<^sub>g c')"
       then obtain c'' where
         c: "c = Guard f' g' c''" and
         c''_c': "c'' \<subseteq>\<^sub>g c'"
         by blast
       from c exec Normal
       have exec_Guard': "\<Gamma>\<turnstile>\<langle>Guard f' g' c'',Normal s'\<rangle> =n\<Rightarrow> t"
         by simp
       thus ?thesis
       proof (cases)
         assume s'_in_g': "s' \<in> g'"
         assume exec_c'': "\<Gamma>\<turnstile>\<langle>c'',Normal s'\<rangle> =n\<Rightarrow> t"
         from Guard.hyps [OF c''_c' exec_c'']  obtain t' where
           exec_c': "\<Gamma>\<turnstile>\<langle>c',Normal s'\<rangle> =n\<Rightarrow> t'" and
           t_Fault: "isFault t \<longrightarrow> isFault t'" and
           t_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
           by blast
         with Normal s'_in_g'
         show ?thesis
           by (fastforce intro: execn.intros)
       next
         assume "s' \<notin> g'" "t=Fault f'"
         with Normal show ?thesis
           by (fastforce intro: execn.intros)
       qed
     qed
   qed
 next
   case Throw thus ?case
     by (fastforce dest: subseteq_guardsD intro: execn.intros
          elim: execn_elim_cases)
 next
   case (Catch c1' c2')
   have "c \<subseteq>\<^sub>g Catch c1' c2'" by fact
   from subseteq_guards_Catch [OF this]
   obtain c1 c2 where
     c: "c = Catch c1 c2" and
     c1_c1': "c1 \<subseteq>\<^sub>g c1'" and
     c2_c2': "c2 \<subseteq>\<^sub>g c2'"
     by blast
   have exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     from exec [simplified c Normal]
     show ?thesis
     proof (cases)
       fix w
       assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> Abrupt w"
       assume exec_c2: "\<Gamma>\<turnstile>\<langle>c2,Normal w\<rangle> =n\<Rightarrow> t"
       from Normal exec_c1 c1_c1' Catch.hyps obtain w' where
         exec_c1': "\<Gamma>\<turnstile>\<langle>c1',Normal s'\<rangle> =n\<Rightarrow> w'" and
         w'_noFault:  "\<not> isFault w' \<longrightarrow> w' = Abrupt w"
         by blast
       show ?thesis
       proof (cases "isFault w'")
         case True
         with exec_c1' Normal show ?thesis
           by (fastforce intro: execn.intros elim: isFaultE)
       next
         case False
         with w'_noFault have w': "w'=Abrupt w" by simp
         from Normal exec_c2 c2_c2' Catch.hyps obtain t' where
           "\<Gamma>\<turnstile>\<langle>c2',Normal w\<rangle> =n\<Rightarrow> t'"
           "isFault t \<longrightarrow> isFault t'"
           "\<not> isFault t' \<longrightarrow> t' = t"
           by blast
         with exec_c1' w' Normal
         show ?thesis
           by (fastforce intro: execn.intros )
       qed
     next
       assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> t"
       assume t: "\<not> isAbr t"
       from Normal exec_c1 c1_c1' Catch.hyps obtain t' where
         exec_c1': "\<Gamma>\<turnstile>\<langle>c1',Normal s'\<rangle> =n\<Rightarrow> t'" and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         with exec_c1' Normal show ?thesis
           by (fastforce intro: execn.intros elim: isFaultE)
       next
         case False
         with exec_c1' Normal t_Fault t'_noFault t
         show ?thesis
           by (fastforce intro: execn.intros)
       qed
     qed
   qed
 qed
 
 lemma exec_to_exec_subseteq_guards:
   assumes c_c': "c \<subseteq>\<^sub>g c'"
   assumes  exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>\<turnstile>\<langle>c',s\<rangle> \<Rightarrow> t' \<and>
              (isFault t \<longrightarrow> isFault t') \<and> (\<not> isFault t' \<longrightarrow> t'=t)"
 proof -
   from exec_to_execn [OF exec] obtain n where
     "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" ..
   from execn_to_execn_subseteq_guards [OF c_c' this]
   show ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "merge_guards"}\<close>
 (* ************************************************************************ *)
 
 
 theorem execn_to_execn_merge_guards:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  shows "\<Gamma>\<turnstile>\<langle>merge_guards c,s\<rangle> =n\<Rightarrow> t "
 using exec_c
 proof (induct)
   case (Guard s g c n t f)
   have s_in_g: "s \<in> g"  by fact
   have exec_merge_c: "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases "\<exists>f' g' c'. merge_guards c = Guard f' g' c'")
     case False
     with exec_merge_c s_in_g
     show ?thesis
       by (cases "merge_guards c") (auto intro: execn.intros simp add: Let_def)
   next
     case True
     then obtain f' g' c' where
       merge_guards_c: "merge_guards c = Guard f' g' c'"
       by iprover
     show ?thesis
     proof (cases "f=f'")
       case False
       from exec_merge_c s_in_g merge_guards_c False show ?thesis
         by (auto intro: execn.intros simp add: Let_def)
     next
       case True
       from exec_merge_c s_in_g merge_guards_c True show ?thesis
         by (fastforce intro: execn.intros elim: execn.cases)
     qed
   qed
 next
   case (GuardFault s g f c n)
   have s_notin_g: "s \<notin> g"  by fact
   show ?case
   proof (cases "\<exists>f' g' c'. merge_guards c = Guard f' g' c'")
     case False
     with s_notin_g
     show ?thesis
       by (cases "merge_guards c") (auto intro: execn.intros simp add: Let_def)
   next
     case True
     then obtain f' g' c' where
       merge_guards_c: "merge_guards c = Guard f' g' c'"
       by iprover
     show ?thesis
     proof (cases "f=f'")
       case False
       from s_notin_g merge_guards_c False show ?thesis
         by (auto intro: execn.intros simp add: Let_def)
     next
       case True
       from  s_notin_g merge_guards_c True show ?thesis
         by (fastforce intro: execn.intros)
     qed
   qed
 qed (fastforce intro: execn.intros)+
 
 lemma execn_merge_guards_to_execn_Normal:
   "\<And>s n t. \<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t"
 proof (induct c)
   case Skip thus ?case by auto
 next
   case Basic thus ?case by auto
 next
   case Spec thus ?case by auto
 next
   case (Seq c1 c2)
   have "\<Gamma>\<turnstile>\<langle>merge_guards (Seq c1 c2),Normal s\<rangle> =n\<Rightarrow> t" by fact
   hence exec_merge: "\<Gamma>\<turnstile>\<langle>Seq (merge_guards c1) (merge_guards c2),Normal s\<rangle> =n\<Rightarrow> t"
     by simp
   then obtain s' where
     exec_merge_c1: "\<Gamma>\<turnstile>\<langle>merge_guards c1,Normal s\<rangle> =n\<Rightarrow> s'" and
     exec_merge_c2: "\<Gamma>\<turnstile>\<langle>merge_guards c2,s'\<rangle> =n\<Rightarrow> t"
     by cases
   from exec_merge_c1
   have exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> s'"
     by (rule Seq.hyps)
   show ?case
   proof (cases s')
     case (Normal s'')
     with exec_merge_c2
     have "\<Gamma>\<turnstile>\<langle>c2,s'\<rangle> =n\<Rightarrow> t"
       by (auto intro: Seq.hyps)
     with exec_c1 show ?thesis
       by (auto intro: execn.intros)
   next
     case (Abrupt s'')
     with exec_merge_c2 have "t=Abrupt s''"
       by (auto dest: execn_Abrupt_end)
     with exec_c1 Abrupt
     show ?thesis
       by (auto intro: execn.intros)
   next
     case (Fault f)
     with exec_merge_c2 have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with exec_c1 Fault
     show ?thesis
       by (auto intro: execn.intros)
   next
     case Stuck
     with exec_merge_c2 have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with exec_c1 Stuck
     show ?thesis
       by (auto intro: execn.intros)
   qed
 next
   case Cond thus ?case
     by (fastforce intro: execn.intros elim: execn_Normal_elim_cases)
 next
   case (While b c)
   {
     fix c' r w
     assume exec_c': "\<Gamma>\<turnstile>\<langle>c',r\<rangle> =n\<Rightarrow> w"
     assume c': "c'=While b (merge_guards c)"
     have "\<Gamma>\<turnstile>\<langle>While b c,r\<rangle> =n\<Rightarrow> w"
       using exec_c' c'
     proof (induct)
       case (WhileTrue r b' c'' n u w)
       have eqs: "While b' c'' = While b (merge_guards c)" by fact
       from WhileTrue
       have r_in_b: "r \<in> b"
         by simp
       from WhileTrue While.hyps have exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal r\<rangle> =n\<Rightarrow> u"
         by simp
       from WhileTrue have exec_w: "\<Gamma>\<turnstile>\<langle>While b c,u\<rangle> =n\<Rightarrow> w"
         by simp
       from r_in_b exec_c exec_w
       show ?case
         by (rule execn.WhileTrue)
     next
       case WhileFalse thus ?case by (auto intro: execn.WhileFalse)
     qed auto
   }
   with While.prems show ?case
     by (auto)
 next
   case Call thus ?case by simp
 next
   case DynCom thus ?case
     by (fastforce intro: execn.intros elim: execn_Normal_elim_cases)
 next
   case (Guard f g c)
   have exec_merge: "\<Gamma>\<turnstile>\<langle>merge_guards (Guard f g c),Normal s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases "s \<in> g")
     case False
     with exec_merge have "t=Fault f"
       by (auto split: com.splits if_split_asm elim: execn_Normal_elim_cases
         simp add: Let_def is_Guard_def)
     with False show ?thesis
       by (auto intro: execn.intros)
   next
     case True
     note s_in_g = this
     show ?thesis
     proof (cases "\<exists>f' g' c'. merge_guards c = Guard f' g' c'")
       case False
       then
       have "merge_guards (Guard f g c) = Guard f g (merge_guards c)"
         by (cases "merge_guards c") (auto simp add: Let_def)
       with exec_merge s_in_g
       obtain "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       from Guard.hyps [OF this] s_in_g
       show ?thesis
         by (auto intro: execn.intros)
     next
       case True
       then obtain f' g' c' where
         merge_guards_c: "merge_guards c = Guard f' g' c'"
         by iprover
       show ?thesis
       proof (cases "f=f'")
         case False
         with merge_guards_c
         have "merge_guards (Guard f g c) = Guard f g (merge_guards c)"
           by (simp add: Let_def)
         with exec_merge s_in_g
         obtain "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t"
           by (auto elim: execn_Normal_elim_cases)
         from Guard.hyps [OF this] s_in_g
         show ?thesis
           by (auto intro: execn.intros)
       next
         case True
         note f_eq_f' = this
         with merge_guards_c have
           merge_guards_Guard: "merge_guards (Guard f g c) = Guard f (g \<inter> g') c'"
           by simp
         show ?thesis
         proof (cases "s \<in> g'")
           case True
           with exec_merge merge_guards_Guard merge_guards_c s_in_g
           have "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t"
             by (auto intro: execn.intros elim: execn_Normal_elim_cases)
           with Guard.hyps [OF this] s_in_g
           show ?thesis
             by (auto intro: execn.intros)
         next
           case False
           with exec_merge merge_guards_Guard
           have "t=Fault f"
             by (auto elim: execn_Normal_elim_cases)
           with merge_guards_c f_eq_f' False
           have "\<Gamma>\<turnstile>\<langle>merge_guards c,Normal s\<rangle> =n\<Rightarrow> t"
             by (auto intro: execn.intros)
           from Guard.hyps [OF this] s_in_g
           show ?thesis
             by (auto intro: execn.intros)
         qed
       qed
     qed
   qed
 next
   case Throw thus ?case by simp
 next
   case (Catch c1 c2)
   have "\<Gamma>\<turnstile>\<langle>merge_guards (Catch c1 c2),Normal s\<rangle> =n\<Rightarrow> t"  by fact
   hence "\<Gamma>\<turnstile>\<langle>Catch (merge_guards c1) (merge_guards c2),Normal s\<rangle> =n\<Rightarrow> t" by simp
   thus ?case
     by cases (auto intro: execn.intros Catch.hyps)
 qed
 
 theorem execn_merge_guards_to_execn:
   "\<Gamma>\<turnstile>\<langle>merge_guards c,s\<rangle> =n\<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c, s\<rangle> =n\<Rightarrow> t"
 apply (cases s)
 apply    (fastforce intro: execn_merge_guards_to_execn_Normal)
 apply   (fastforce dest: execn_Abrupt_end)
 apply  (fastforce dest: execn_Fault_end)
 apply (fastforce dest: execn_Stuck_end)
 done
 
 corollary execn_iff_execn_merge_guards:
  "\<Gamma>\<turnstile>\<langle>c, s\<rangle> =n\<Rightarrow> t = \<Gamma>\<turnstile>\<langle>merge_guards c,s\<rangle> =n\<Rightarrow> t"
   by (blast intro: execn_merge_guards_to_execn execn_to_execn_merge_guards)
 
 theorem exec_iff_exec_merge_guards:
  "\<Gamma>\<turnstile>\<langle>c, s\<rangle> \<Rightarrow> t = \<Gamma>\<turnstile>\<langle>merge_guards c,s\<rangle> \<Rightarrow> t"
   by (blast dest: exec_to_execn intro: execn_to_exec
             intro: execn_to_execn_merge_guards
                    execn_merge_guards_to_execn)
 
 corollary exec_to_exec_merge_guards:
  "\<Gamma>\<turnstile>\<langle>c, s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>merge_guards c,s\<rangle> \<Rightarrow> t"
   by (rule iffD1 [OF exec_iff_exec_merge_guards])
 
 corollary exec_merge_guards_to_exec:
  "\<Gamma>\<turnstile>\<langle>merge_guards c,s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c, s\<rangle> \<Rightarrow> t"
   by (rule iffD2 [OF exec_iff_exec_merge_guards])
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "mark_guards"}\<close>
 (* ************************************************************************ *)
 
 lemma execn_to_execn_mark_guards:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes t_not_Fault: "\<not> isFault t"
  shows "\<Gamma>\<turnstile>\<langle>mark_guards f c,s\<rangle> =n\<Rightarrow> t "
 using exec_c t_not_Fault [simplified not_isFault_iff]
 by (induct) (auto intro: execn.intros dest: noFaultn_startD')
 
 lemma execn_to_execn_mark_guards_Fault:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  shows "\<And>f. \<lbrakk>t=Fault f\<rbrakk> \<Longrightarrow> \<exists>f'. \<Gamma>\<turnstile>\<langle>mark_guards x c,s\<rangle> =n\<Rightarrow> Fault f'"
 using exec_c
 proof (induct)
   case Skip thus ?case by auto
 next
   case Guard thus ?case by (fastforce intro: execn.intros)
 next
   case GuardFault thus ?case by (fastforce intro: execn.intros)
 next
   case FaultProp thus ?case by auto
 next
  case Basic thus ?case by auto
 next
  case Spec thus ?case by auto
 next
  case SpecStuck thus ?case by auto
 next
   case (Seq c1 s n w c2 t)
   have exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> w" by fact
   have exec_c2: "\<Gamma>\<turnstile>\<langle>c2,w\<rangle> =n\<Rightarrow> t" by fact
   have t: "t=Fault f" by fact
   show ?case
   proof (cases w)
     case (Fault f')
     with exec_c2 t have "f'=f"
       by (auto dest: execn_Fault_end)
     with Fault Seq.hyps obtain f'' where
       "\<Gamma>\<turnstile>\<langle>mark_guards x c1,Normal s\<rangle> =n\<Rightarrow> Fault f''"
       by auto
     moreover have "\<Gamma>\<turnstile>\<langle>mark_guards x c2,Fault f''\<rangle> =n\<Rightarrow> Fault f''"
       by auto
     ultimately show ?thesis
       by (auto intro: execn.intros)
   next
     case (Normal s')
     with execn_to_execn_mark_guards [OF exec_c1]
     have exec_mark_c1: "\<Gamma>\<turnstile>\<langle>mark_guards x c1,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with Seq.hyps t obtain f' where
       "\<Gamma>\<turnstile>\<langle>mark_guards x c2,w\<rangle> =n\<Rightarrow> Fault f'"
       by blast
     with exec_mark_c1 show ?thesis
       by (auto intro: execn.intros)
   next
     case (Abrupt s')
     with execn_to_execn_mark_guards [OF exec_c1]
     have exec_mark_c1: "\<Gamma>\<turnstile>\<langle>mark_guards x c1,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with Seq.hyps t obtain f' where
       "\<Gamma>\<turnstile>\<langle>mark_guards x c2,w\<rangle> =n\<Rightarrow> Fault f'"
       by (auto intro: execn.intros)
     with exec_mark_c1 show ?thesis
       by (auto intro: execn.intros)
   next
     case Stuck
     with exec_c2 have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with t show ?thesis by simp
   qed
 next
   case CondTrue thus ?case by (fastforce intro: execn.intros)
 next
   case CondFalse thus ?case by (fastforce intro: execn.intros)
 next
   case (WhileTrue s b c n w t)
   have exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> w" by fact
   have exec_w: "\<Gamma>\<turnstile>\<langle>While b c,w\<rangle> =n\<Rightarrow> t" by fact
   have t: "t = Fault f" by fact
   have s_in_b: "s \<in> b" by fact
   show ?case
   proof (cases w)
     case (Fault f')
     with exec_w t have "f'=f"
       by (auto dest: execn_Fault_end)
     with Fault WhileTrue.hyps obtain f'' where
       "\<Gamma>\<turnstile>\<langle>mark_guards x c,Normal s\<rangle> =n\<Rightarrow> Fault f''"
       by auto
     moreover have "\<Gamma>\<turnstile>\<langle>mark_guards x (While b c),Fault f''\<rangle> =n\<Rightarrow> Fault f''"
       by auto
     ultimately show ?thesis
       using s_in_b by (auto intro: execn.intros)
   next
     case (Normal s')
     with execn_to_execn_mark_guards [OF exec_c]
     have exec_mark_c: "\<Gamma>\<turnstile>\<langle>mark_guards x c,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with WhileTrue.hyps t obtain f' where
       "\<Gamma>\<turnstile>\<langle>mark_guards x (While b c),w\<rangle> =n\<Rightarrow> Fault f'"
       by blast
     with exec_mark_c s_in_b show ?thesis
       by (auto intro: execn.intros)
   next
     case (Abrupt s')
     with execn_to_execn_mark_guards [OF exec_c]
     have exec_mark_c: "\<Gamma>\<turnstile>\<langle>mark_guards x c,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with WhileTrue.hyps t obtain f' where
       "\<Gamma>\<turnstile>\<langle>mark_guards x (While b c),w\<rangle> =n\<Rightarrow> Fault f'"
       by (auto intro: execn.intros)
     with exec_mark_c s_in_b show ?thesis
       by (auto intro: execn.intros)
   next
     case Stuck
     with exec_w have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with t show ?thesis by simp
   qed
 next
   case WhileFalse thus ?case by (fastforce intro: execn.intros)
 next
   case Call thus ?case by (fastforce intro: execn.intros)
 next
   case CallUndefined thus ?case by simp
 next
   case StuckProp thus ?case by simp
 next
   case DynCom thus ?case by (fastforce intro: execn.intros)
 next
   case Throw thus ?case by simp
 next
   case AbruptProp thus ?case by simp
 next
   case (CatchMatch c1 s n w c2 t)
   have exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> Abrupt w" by fact
   have exec_c2: "\<Gamma>\<turnstile>\<langle>c2,Normal w\<rangle> =n\<Rightarrow> t" by fact
   have t: "t = Fault f" by fact
   from execn_to_execn_mark_guards [OF exec_c1]
   have exec_mark_c1: "\<Gamma>\<turnstile>\<langle>mark_guards x c1,Normal s\<rangle> =n\<Rightarrow> Abrupt w"
     by simp
   with CatchMatch.hyps t obtain f' where
     "\<Gamma>\<turnstile>\<langle>mark_guards x c2,Normal w\<rangle> =n\<Rightarrow> Fault f'"
     by blast
   with exec_mark_c1 show ?case
     by (auto intro: execn.intros)
 next
   case CatchMiss thus ?case by (fastforce intro: execn.intros)
 qed
 
 lemma execn_mark_guards_to_execn:
   "\<And>s n t. \<Gamma>\<turnstile>\<langle>mark_guards f c,s\<rangle> =n\<Rightarrow> t
   \<Longrightarrow> \<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t' \<and>
             (isFault t \<longrightarrow> isFault t') \<and>
             (t' = Fault f \<longrightarrow> t'=t) \<and>
             (isFault t' \<longrightarrow> isFault t) \<and>
             (\<not> isFault t' \<longrightarrow> t'=t)"
 proof (induct c)
   case Skip thus ?case by auto
 next
   case Basic thus ?case by auto
 next
   case Spec thus ?case by auto
 next
   case (Seq c1 c2 s n t)
   have exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f (Seq c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   then obtain w where
     exec_mark_c1: "\<Gamma>\<turnstile>\<langle>mark_guards f c1,s\<rangle> =n\<Rightarrow> w" and
     exec_mark_c2: "\<Gamma>\<turnstile>\<langle>mark_guards f c2,w\<rangle> =n\<Rightarrow> t"
     by (auto elim: execn_elim_cases)
   from Seq.hyps exec_mark_c1
   obtain w' where
     exec_c1: "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> w'" and
     w_Fault: "isFault w \<longrightarrow> isFault w'" and
     w'_Fault_f: "w' = Fault f \<longrightarrow> w'=w" and
     w'_Fault: "isFault w' \<longrightarrow> isFault w" and
     w'_noFault: "\<not> isFault w' \<longrightarrow> w'=w"
     by blast
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec_mark have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_mark have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_mark have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "isFault w")
       case True
       then obtain f where w': "w=Fault f"..
       moreover with exec_mark_c2
       have t: "t=Fault f"
         by (auto dest: execn_Fault_end)
       ultimately show ?thesis
         using Normal w_Fault w'_Fault_f exec_c1
         by (fastforce intro: execn.intros elim: isFaultE)
     next
       case False
       note noFault_w = this
       show ?thesis
       proof (cases "isFault w'")
         case True
         then obtain f' where w': "w'=Fault f'"..
         with Normal exec_c1
         have exec: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         from w'_Fault_f w' noFault_w
         have "f' \<noteq> f"
           by (cases w) auto
         moreover
         from w' w'_Fault exec_mark_c2 have "isFault t"
           by (auto dest: execn_Fault_end elim: isFaultE)
         ultimately
         show ?thesis
           using exec
           by auto
       next
         case False
         with w'_noFault have w': "w'=w" by simp
         from Seq.hyps exec_mark_c2
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>c2,w\<rangle> =n\<Rightarrow> t'" and
           "isFault t \<longrightarrow> isFault t'" and
           "t' = Fault f \<longrightarrow> t'=t" and
           "isFault t' \<longrightarrow> isFault t" and
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with Normal exec_c1 w'
         show ?thesis
           by (fastforce intro: execn.intros)
       qed
     qed
   qed
 next
   case (Cond b c1 c2 s n t)
   have exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f (Cond b c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Fault f)
     with exec_mark have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_mark have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_mark have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "s'\<in> b")
       case True
       with Normal exec_mark
       have "\<Gamma>\<turnstile>\<langle>mark_guards f c1 ,Normal s'\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       with Normal True Cond.hyps obtain t'
         where "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> t'"
             "isFault t \<longrightarrow> isFault t'"
             "t' = Fault f \<longrightarrow> t'=t"
             "isFault t' \<longrightarrow> isFault t"
             "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with Normal True
       show ?thesis
         by (blast intro: execn.intros)
     next
       case False
       with Normal exec_mark
       have "\<Gamma>\<turnstile>\<langle>mark_guards f c2 ,Normal s'\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       with Normal False Cond.hyps obtain t'
         where "\<Gamma>\<turnstile>\<langle>c2,Normal s'\<rangle> =n\<Rightarrow> t'"
             "isFault t  \<longrightarrow> isFault t'"
             "t' = Fault f  \<longrightarrow> t'=t"
             "isFault t' \<longrightarrow> isFault t"
             "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with Normal False
       show ?thesis
         by (blast intro: execn.intros)
     qed
   qed
 next
   case (While b c s n t)
   have exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f (While b c),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Fault f)
     with exec_mark have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_mark have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_mark have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     {
       fix c' r w
       assume exec_c': "\<Gamma>\<turnstile>\<langle>c',r\<rangle> =n\<Rightarrow> w"
       assume c': "c'=While b (mark_guards f c)"
       have "\<exists>w'. \<Gamma>\<turnstile>\<langle>While b c,r\<rangle> =n\<Rightarrow> w' \<and> (isFault w \<longrightarrow> isFault w') \<and>
                    (w' = Fault f \<longrightarrow> w'=w) \<and> (isFault w' \<longrightarrow> isFault w) \<and>
                    (\<not> isFault w' \<longrightarrow> w'=w)"
         using exec_c' c'
       proof (induct)
         case (WhileTrue r b' c'' n u w)
         have eqs: "While b' c'' = While b (mark_guards f c)" by fact
         from WhileTrue.hyps eqs
         have r_in_b: "r\<in>b" by simp
         from WhileTrue.hyps eqs
         have exec_mark_c: "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal r\<rangle> =n\<Rightarrow> u" by simp
         from WhileTrue.hyps eqs
         have exec_mark_w: "\<Gamma>\<turnstile>\<langle>While b (mark_guards f c),u\<rangle> =n\<Rightarrow> w"
           by simp
         show ?case
         proof -
           from WhileTrue.hyps eqs have "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal r\<rangle> =n\<Rightarrow> u"
             by simp
           with While.hyps
           obtain u' where
             exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal r\<rangle> =n\<Rightarrow> u'" and
             u_Fault: "isFault u \<longrightarrow> isFault u'" and
             u'_Fault_f: "u' = Fault f \<longrightarrow> u'=u" and
             u'_Fault: "isFault u' \<longrightarrow> isFault u" and
             u'_noFault: "\<not> isFault u' \<longrightarrow> u'=u"
             by blast
           show ?thesis
           proof (cases "isFault u'")
             case False
             with u'_noFault have u': "u'=u" by simp
             from WhileTrue.hyps eqs obtain w' where
               "\<Gamma>\<turnstile>\<langle>While b c,u\<rangle> =n\<Rightarrow> w'"
               "isFault w  \<longrightarrow> isFault w'"
               "w' = Fault f \<longrightarrow> w'=w"
               "isFault w' \<longrightarrow> isFault w"
               "\<not> isFault w' \<longrightarrow> w' = w"
               by blast
             with u' exec_c r_in_b
             show ?thesis
               by (blast intro: execn.WhileTrue)
           next
             case True
             then obtain f' where u': "u'=Fault f'"..
             with exec_c r_in_b
             have exec: "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> =n\<Rightarrow> Fault f'"
               by (blast intro: execn.intros)
             from True u'_Fault have "isFault u"
               by simp
             then obtain f where u: "u=Fault f"..
             with exec_mark_w have "w=Fault f"
               by (auto dest: execn_Fault_end)
             with exec u' u u'_Fault_f
             show ?thesis
               by auto
           qed
         qed
       next
         case (WhileFalse r b' c'' n)
         have eqs: "While b'  c'' = While b (mark_guards f c)" by fact
         from WhileFalse.hyps eqs
         have r_not_in_b: "r\<notin>b" by simp
         show ?case
         proof -
           from r_not_in_b
           have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> =n\<Rightarrow> Normal r"
             by (rule execn.WhileFalse)
           thus ?thesis
             by blast
         qed
       qed auto
     } note hyp_while = this
     show ?thesis
     proof (cases "s'\<in>b")
       case False
       with Normal exec_mark
       have "t=s"
         by (auto elim: execn_Normal_elim_cases)
       with Normal False show ?thesis
         by (auto intro: execn.intros)
     next
       case True note s'_in_b = this
       with Normal exec_mark obtain r where
         exec_mark_c: "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s'\<rangle> =n\<Rightarrow> r" and
         exec_mark_w: "\<Gamma>\<turnstile>\<langle>While b (mark_guards f c),r\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       from While.hyps exec_mark_c obtain r' where
         exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s'\<rangle> =n\<Rightarrow> r'" and
         r_Fault: "isFault r \<longrightarrow> isFault r'" and
         r'_Fault_f: "r' = Fault f \<longrightarrow> r'=r" and
         r'_Fault: "isFault r' \<longrightarrow> isFault r" and
         r'_noFault: "\<not> isFault r' \<longrightarrow> r'=r"
         by blast
       show ?thesis
       proof (cases "isFault r'")
         case False
         with r'_noFault have r': "r'=r" by simp
         from hyp_while exec_mark_w
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>While b c,r\<rangle> =n\<Rightarrow> t'"
           "isFault t \<longrightarrow> isFault t'"
           "t' = Fault f \<longrightarrow> t'=t"
           "isFault t' \<longrightarrow> isFault t"
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with r' exec_c Normal s'_in_b
         show ?thesis
           by (blast intro: execn.intros)
       next
         case True
         then obtain f' where r': "r'=Fault f'"..
         hence "\<Gamma>\<turnstile>\<langle>While b c,r'\<rangle> =n\<Rightarrow> Fault f'"
           by auto
         with Normal s'_in_b exec_c
         have exec: "\<Gamma>\<turnstile>\<langle>While b c,Normal s'\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         from True r'_Fault
         have "isFault r"
           by simp
         then obtain f where r: "r=Fault f"..
         with exec_mark_w have "t=Fault f"
           by (auto dest: execn_Fault_end)
         with Normal exec r' r r'_Fault_f
         show ?thesis
           by auto
       qed
     qed
   qed
 next
   case Call thus ?case by auto
 next
   case DynCom thus ?case
     by (fastforce elim!: execn_elim_cases intro: execn.intros)
 next
   case (Guard f' g c s n t)
   have exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f (Guard f' g c),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Fault f)
     with exec_mark have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_mark have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_mark have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "s'\<in>g")
       case False
       with Normal exec_mark have t: "t=Fault f"
         by (auto elim: execn_Normal_elim_cases)
       from False
       have "\<Gamma>\<turnstile>\<langle>Guard f' g c,Normal s'\<rangle> =n\<Rightarrow> Fault f'"
         by (blast intro: execn.intros)
       with Normal t show ?thesis
         by auto
     next
       case True
       with exec_mark Normal
       have "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s'\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       with Guard.hyps obtain t' where
         "\<Gamma>\<turnstile>\<langle>c,Normal s'\<rangle> =n\<Rightarrow> t'" and
         "isFault t \<longrightarrow> isFault t'" and
         "t' = Fault f \<longrightarrow> t'=t" and
         "isFault t' \<longrightarrow> isFault t" and
         "\<not> isFault t' \<longrightarrow> t'=t"
         by blast
       with Normal True
       show ?thesis
         by (blast intro: execn.intros)
     qed
   qed
 next
   case Throw thus ?case by auto
 next
   case (Catch c1 c2 s n t)
   have exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f (Catch c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec_mark have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_mark have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_mark have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s') note s=this
     with exec_mark have
       "\<Gamma>\<turnstile>\<langle>Catch (mark_guards f c1) (mark_guards f c2),Normal s'\<rangle> =n\<Rightarrow> t" by simp
     thus ?thesis
     proof (cases)
       fix w
       assume exec_mark_c1: "\<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s'\<rangle> =n\<Rightarrow> Abrupt w"
       assume exec_mark_c2: "\<Gamma>\<turnstile>\<langle>mark_guards f c2,Normal w\<rangle> =n\<Rightarrow> t"
       from exec_mark_c1 Catch.hyps
       obtain w' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> w'" and
         w'_Fault_f: "w' = Fault f \<longrightarrow> w'=Abrupt w" and
         w'_Fault: "isFault w' \<longrightarrow> isFault (Abrupt w)" and
         w'_noFault: "\<not> isFault w' \<longrightarrow> w'=Abrupt w"
         by fastforce
       show ?thesis
       proof (cases "w'")
         case (Fault f')
         with Normal exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,s\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         with w'_Fault Fault show ?thesis
           by auto
       next
         case Stuck
         with w'_noFault have False
           by simp
         thus ?thesis ..
       next
         case (Normal w'')
         with w'_noFault have False by simp thus ?thesis ..
       next
         case (Abrupt w'')
         with w'_noFault have w'': "w''=w" by simp
         from  exec_mark_c2 Catch.hyps
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>c2,Normal w\<rangle> =n\<Rightarrow> t'"
           "isFault t \<longrightarrow> isFault t'"
           "t' = Fault f \<longrightarrow> t'=t"
           "isFault t' \<longrightarrow> isFault t"
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with w'' Abrupt s exec_c1
         show ?thesis
           by (blast intro: execn.intros)
       qed
     next
       assume t: "\<not> isAbr t"
       assume "\<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s'\<rangle> =n\<Rightarrow> t"
       with Catch.hyps
       obtain t' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> t'"  and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t'_Fault_f: "t' = Fault f \<longrightarrow> t'=t" and
         t'_Fault: "isFault t' \<longrightarrow> isFault t" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t'=t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         then obtain f' where t': "t'=Fault f'"..
         with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s'\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         with t'_Fault_f t'_Fault t' s show ?thesis
           by auto
       next
         case False
         with t'_noFault have "t'=t" by simp
         with t exec_c1 s show ?thesis
           by (blast intro: execn.intros)
       qed
     qed
   qed
 qed
 
 lemma exec_to_exec_mark_guards:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes t_not_Fault: "\<not> isFault t"
  shows "\<Gamma>\<turnstile>\<langle>mark_guards f c,s\<rangle> \<Rightarrow> t "
 proof -
   from exec_to_execn [OF exec_c] obtain n where
     "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t" ..
   from execn_to_execn_mark_guards [OF this t_not_Fault]
   show ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 lemma exec_to_exec_mark_guards_Fault:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f"
  shows "\<exists>f'. \<Gamma>\<turnstile>\<langle>mark_guards x c,s\<rangle> \<Rightarrow> Fault f'"
 proof -
   from exec_to_execn [OF exec_c] obtain n where
     "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Fault f" ..
   from execn_to_execn_mark_guards_Fault [OF this]
   show ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 
 lemma exec_mark_guards_to_exec:
   assumes exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t' \<and>
             (isFault t \<longrightarrow> isFault t') \<and>
             (t' = Fault f \<longrightarrow> t'=t) \<and>
             (isFault t' \<longrightarrow> isFault t) \<and>
             (\<not> isFault t' \<longrightarrow> t'=t)"
 proof -
   from exec_to_execn [OF exec_mark] obtain n where
     "\<Gamma>\<turnstile>\<langle>mark_guards f c,s\<rangle> =n\<Rightarrow> t" ..
   from execn_mark_guards_to_execn [OF this]
   show ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "strip_guards"}\<close>
 (* ************************************************************************* *)
 
 lemma execn_to_execn_strip_guards:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes t_not_Fault: "\<not> isFault t"
  shows "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> t "
 using exec_c t_not_Fault [simplified not_isFault_iff]
 by (induct) (auto intro: execn.intros dest: noFaultn_startD')
 
 
 lemma execn_to_execn_strip_guards_Fault:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  shows "\<And>f. \<lbrakk>t=Fault f; f \<notin> F\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> Fault f"
 using exec_c
 proof (induct)
   case Skip thus ?case by auto
 next
   case Guard thus ?case by (fastforce intro: execn.intros)
 next
   case GuardFault thus ?case by (fastforce intro: execn.intros)
 next
   case FaultProp thus ?case by auto
 next
  case Basic thus ?case by auto
 next
  case Spec thus ?case by auto
 next
  case SpecStuck thus ?case by auto
 next
   case (Seq c1 s n w c2 t)
   have exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> w" by fact
   have exec_c2: "\<Gamma>\<turnstile>\<langle>c2,w\<rangle> =n\<Rightarrow> t" by fact
   have t: "t=Fault f" by fact
   have notinF: "f \<notin> F" by fact
   show ?case
   proof (cases w)
     case (Fault f')
     with exec_c2 t have "f'=f"
       by (auto dest: execn_Fault_end)
     with Fault notinF Seq.hyps
     have "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by auto
     moreover have "\<Gamma>\<turnstile>\<langle>strip_guards F c2,Fault f\<rangle> =n\<Rightarrow> Fault f"
       by auto
     ultimately show ?thesis
       by (auto intro: execn.intros)
   next
     case (Normal s')
     with execn_to_execn_strip_guards [OF exec_c1]
     have exec_strip_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with Seq.hyps t notinF
     have "\<Gamma>\<turnstile>\<langle>strip_guards F c2,w\<rangle> =n\<Rightarrow> Fault f"
       by blast
     with exec_strip_c1 show ?thesis
       by (auto intro: execn.intros)
   next
     case (Abrupt s')
     with execn_to_execn_strip_guards [OF exec_c1]
     have exec_strip_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with Seq.hyps t notinF
     have "\<Gamma>\<turnstile>\<langle>strip_guards F c2,w\<rangle> =n\<Rightarrow> Fault f"
       by (auto intro: execn.intros)
     with exec_strip_c1 show ?thesis
       by (auto intro: execn.intros)
   next
     case Stuck
     with exec_c2 have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with t show ?thesis by simp
   qed
 next
   case CondTrue thus ?case by (fastforce intro: execn.intros)
 next
   case CondFalse thus ?case by (fastforce intro: execn.intros)
 next
   case (WhileTrue s b c n w t)
   have exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> w" by fact
   have exec_w: "\<Gamma>\<turnstile>\<langle>While b c,w\<rangle> =n\<Rightarrow> t" by fact
   have t: "t = Fault f" by fact
   have notinF: "f \<notin> F" by fact
   have s_in_b: "s \<in> b" by fact
   show ?case
   proof (cases w)
     case (Fault f')
     with exec_w t have "f'=f"
       by (auto dest: execn_Fault_end)
     with Fault notinF WhileTrue.hyps
     have "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by auto
     moreover have "\<Gamma>\<turnstile>\<langle>strip_guards F (While b c),Fault f\<rangle> =n\<Rightarrow> Fault f"
       by auto
     ultimately show ?thesis
       using s_in_b by (auto intro: execn.intros)
   next
     case (Normal s')
     with execn_to_execn_strip_guards [OF exec_c]
     have exec_strip_c: "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with WhileTrue.hyps t notinF
     have "\<Gamma>\<turnstile>\<langle>strip_guards F (While b c),w\<rangle> =n\<Rightarrow> Fault f"
       by blast
     with exec_strip_c s_in_b show ?thesis
       by (auto intro: execn.intros)
   next
     case (Abrupt s')
     with execn_to_execn_strip_guards [OF exec_c]
     have exec_strip_c: "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s\<rangle> =n\<Rightarrow> w"
       by simp
     with WhileTrue.hyps t notinF
     have "\<Gamma>\<turnstile>\<langle>strip_guards F (While b c),w\<rangle> =n\<Rightarrow> Fault f"
       by (auto intro: execn.intros)
     with exec_strip_c s_in_b show ?thesis
       by (auto intro: execn.intros)
   next
     case Stuck
     with exec_w have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with t show ?thesis by simp
   qed
 next
   case WhileFalse thus ?case by (fastforce intro: execn.intros)
 next
   case Call thus ?case by (fastforce intro: execn.intros)
 next
   case CallUndefined thus ?case by simp
 next
   case StuckProp thus ?case by simp
 next
   case DynCom thus ?case by (fastforce intro: execn.intros)
 next
   case Throw thus ?case by simp
 next
   case AbruptProp thus ?case by simp
 next
   case (CatchMatch c1 s n w c2 t)
   have exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> Abrupt w" by fact
   have exec_c2: "\<Gamma>\<turnstile>\<langle>c2,Normal w\<rangle> =n\<Rightarrow> t" by fact
   have t: "t = Fault f" by fact
   have notinF: "f \<notin> F" by fact
   from execn_to_execn_strip_guards [OF exec_c1]
   have exec_strip_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s\<rangle> =n\<Rightarrow> Abrupt w"
     by simp
   with CatchMatch.hyps t notinF
   have "\<Gamma>\<turnstile>\<langle>strip_guards F c2,Normal w\<rangle> =n\<Rightarrow> Fault f"
     by blast
   with exec_strip_c1 show ?case
     by (auto intro: execn.intros)
 next
   case CatchMiss thus ?case by (fastforce intro: execn.intros)
 qed
 
 lemma execn_to_execn_strip_guards':
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes t_not_Fault: "t \<notin> Fault ` F"
  shows "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> t"
 proof (cases t)
   case (Fault f)
   with t_not_Fault exec_c show ?thesis
     by (auto intro: execn_to_execn_strip_guards_Fault)
 qed (insert exec_c, auto intro: execn_to_execn_strip_guards)
 
 lemma execn_strip_guards_to_execn:
   "\<And>s n t. \<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> t
   \<Longrightarrow> \<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t' \<and>
             (isFault t \<longrightarrow> isFault t') \<and>
             (t' \<in> Fault ` (- F) \<longrightarrow> t'=t) \<and>
             (\<not> isFault t' \<longrightarrow> t'=t)"
 proof (induct c)
   case Skip thus ?case by auto
 next
   case Basic thus ?case by auto
 next
   case Spec thus ?case by auto
 next
   case (Seq c1 c2 s n t)
   have exec_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F (Seq c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   then obtain w where
     exec_strip_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,s\<rangle> =n\<Rightarrow> w" and
     exec_strip_c2: "\<Gamma>\<turnstile>\<langle>strip_guards F c2,w\<rangle> =n\<Rightarrow> t"
     by (auto elim: execn_elim_cases)
   from Seq.hyps exec_strip_c1
   obtain w' where
     exec_c1: "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> w'" and
     w_Fault: "isFault w \<longrightarrow> isFault w'" and
     w'_Fault: "w' \<in> Fault ` (- F) \<longrightarrow> w'=w" and
     w'_noFault: "\<not> isFault w' \<longrightarrow> w'=w"
     by blast
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec_strip have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_strip have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_strip have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "isFault w")
       case True
       then obtain f where w': "w=Fault f"..
       moreover with exec_strip_c2
       have t: "t=Fault f"
         by (auto dest: execn_Fault_end)
       ultimately show ?thesis
         using Normal w_Fault w'_Fault exec_c1
         by (fastforce intro: execn.intros elim: isFaultE)
     next
       case False
       note noFault_w = this
       show ?thesis
       proof (cases "isFault w'")
         case True
         then obtain f' where w': "w'=Fault f'"..
         with Normal exec_c1
         have exec: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,s\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         from w'_Fault w' noFault_w
         have "f' \<in> F"
           by (cases w) auto
         with exec
         show ?thesis
           by auto
       next
         case False
         with w'_noFault have w': "w'=w" by simp
         from Seq.hyps exec_strip_c2
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>c2,w\<rangle> =n\<Rightarrow> t'" and
           "isFault t \<longrightarrow> isFault t'" and
           "t' \<in> Fault ` (-F) \<longrightarrow> t'=t" and
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with Normal exec_c1 w'
         show ?thesis
           by (fastforce intro: execn.intros)
       qed
     qed
   qed
 next
 next
   case (Cond b c1 c2 s n t)
   have exec_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F (Cond b c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Fault f)
     with exec_strip have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_strip have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_strip have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "s'\<in> b")
       case True
       with Normal exec_strip
       have "\<Gamma>\<turnstile>\<langle>strip_guards F c1 ,Normal s'\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       with Normal True Cond.hyps obtain t'
         where "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> t'"
             "isFault t \<longrightarrow> isFault t'"
             "t' \<in> Fault ` (-F) \<longrightarrow> t'=t"
             "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with Normal True
       show ?thesis
         by (blast intro: execn.intros)
     next
       case False
       with Normal exec_strip
       have "\<Gamma>\<turnstile>\<langle>strip_guards F c2 ,Normal s'\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       with Normal False Cond.hyps obtain t'
         where "\<Gamma>\<turnstile>\<langle>c2,Normal s'\<rangle> =n\<Rightarrow> t'"
             "isFault t  \<longrightarrow> isFault t'"
             "t' \<in> Fault ` (-F) \<longrightarrow> t'=t"
             "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       with Normal False
       show ?thesis
         by (blast intro: execn.intros)
     qed
   qed
 next
   case (While b c s n t)
   have exec_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F (While b c),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Fault f)
     with exec_strip have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_strip have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_strip have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     {
       fix c' r w
       assume exec_c': "\<Gamma>\<turnstile>\<langle>c',r\<rangle> =n\<Rightarrow> w"
       assume c': "c'=While b (strip_guards F c)"
       have "\<exists>w'. \<Gamma>\<turnstile>\<langle>While b c,r\<rangle> =n\<Rightarrow> w' \<and> (isFault w \<longrightarrow> isFault w') \<and>
                    (w' \<in> Fault ` (-F) \<longrightarrow> w'=w) \<and>
                    (\<not> isFault w' \<longrightarrow> w'=w)"
         using exec_c' c'
       proof (induct)
         case (WhileTrue r b' c'' n u w)
         have eqs: "While b' c'' = While b (strip_guards F c)" by fact
         from WhileTrue.hyps eqs
         have r_in_b: "r\<in>b" by simp
         from WhileTrue.hyps eqs
         have exec_strip_c: "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal r\<rangle> =n\<Rightarrow> u" by simp
         from WhileTrue.hyps eqs
         have exec_strip_w: "\<Gamma>\<turnstile>\<langle>While b (strip_guards F c),u\<rangle> =n\<Rightarrow> w"
           by simp
         show ?case
         proof -
           from WhileTrue.hyps eqs have "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal r\<rangle> =n\<Rightarrow> u"
             by simp
           with While.hyps
           obtain u' where
             exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal r\<rangle> =n\<Rightarrow> u'" and
             u_Fault: "isFault u \<longrightarrow> isFault u'" and
             u'_Fault: "u' \<in> Fault ` (-F) \<longrightarrow> u'=u" and
             u'_noFault: "\<not> isFault u' \<longrightarrow> u'=u"
             by blast
           show ?thesis
           proof (cases "isFault u'")
             case False
             with u'_noFault have u': "u'=u" by simp
             from WhileTrue.hyps eqs obtain w' where
               "\<Gamma>\<turnstile>\<langle>While b c,u\<rangle> =n\<Rightarrow> w'"
               "isFault w  \<longrightarrow> isFault w'"
               "w' \<in> Fault ` (-F) \<longrightarrow> w'=w"
               "\<not> isFault w' \<longrightarrow> w' = w"
               by blast
             with u' exec_c r_in_b
             show ?thesis
               by (blast intro: execn.WhileTrue)
           next
             case True
             then obtain f' where u': "u'=Fault f'"..
             with exec_c r_in_b
             have exec: "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> =n\<Rightarrow> Fault f'"
               by (blast intro: execn.intros)
             show ?thesis
             proof (cases "isFault u")
               case True
               then obtain f where u: "u=Fault f"..
               with exec_strip_w have "w=Fault f"
                 by (auto dest: execn_Fault_end)
               with exec u' u u'_Fault
               show ?thesis
                 by auto
             next
               case False
               with u'_Fault u' have "f' \<in> F"
                 by (cases u) auto
               with exec show ?thesis
                 by auto
             qed
           qed
         qed
       next
         case (WhileFalse r b' c'' n)
         have eqs: "While b'  c'' = While b (strip_guards F c)" by fact
         from WhileFalse.hyps eqs
         have r_not_in_b: "r\<notin>b" by simp
         show ?case
         proof -
           from r_not_in_b
           have "\<Gamma>\<turnstile>\<langle>While b c,Normal r\<rangle> =n\<Rightarrow> Normal r"
             by (rule execn.WhileFalse)
           thus ?thesis
             by blast
         qed
       qed auto
     } note hyp_while = this
     show ?thesis
     proof (cases "s'\<in>b")
       case False
       with Normal exec_strip
       have "t=s"
         by (auto elim: execn_Normal_elim_cases)
       with Normal False show ?thesis
         by (auto intro: execn.intros)
     next
       case True note s'_in_b = this
       with Normal exec_strip obtain r where
         exec_strip_c: "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s'\<rangle> =n\<Rightarrow> r" and
         exec_strip_w: "\<Gamma>\<turnstile>\<langle>While b (strip_guards F c),r\<rangle> =n\<Rightarrow> t"
         by (auto elim: execn_Normal_elim_cases)
       from While.hyps exec_strip_c obtain r' where
         exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s'\<rangle> =n\<Rightarrow> r'" and
         r_Fault: "isFault r \<longrightarrow> isFault r'" and
         r'_Fault: "r' \<in> Fault ` (-F) \<longrightarrow> r'=r" and
         r'_noFault: "\<not> isFault r' \<longrightarrow> r'=r"
         by blast
       show ?thesis
       proof (cases "isFault r'")
         case False
         with r'_noFault have r': "r'=r" by simp
         from hyp_while exec_strip_w
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>While b c,r\<rangle> =n\<Rightarrow> t'"
           "isFault t \<longrightarrow> isFault t'"
           "t' \<in> Fault ` (-F) \<longrightarrow> t'=t"
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with r' exec_c Normal s'_in_b
         show ?thesis
           by (blast intro: execn.intros)
       next
         case True
         then obtain f' where r': "r'=Fault f'"..
         hence "\<Gamma>\<turnstile>\<langle>While b c,r'\<rangle> =n\<Rightarrow> Fault f'"
           by auto
         with Normal s'_in_b exec_c
         have exec: "\<Gamma>\<turnstile>\<langle>While b c,Normal s'\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         show ?thesis
         proof (cases "isFault r")
           case True
           then obtain f where r: "r=Fault f"..
           with exec_strip_w have "t=Fault f"
             by (auto dest: execn_Fault_end)
           with Normal exec r' r r'_Fault
           show ?thesis
             by auto
         next
           case False
           with r'_Fault r' have "f' \<in> F"
             by (cases r) auto
           with Normal exec show ?thesis
             by auto
         qed
       qed
     qed
   qed
 next
   case Call thus ?case by auto
 next
   case DynCom thus ?case
     by (fastforce elim!: execn_elim_cases intro: execn.intros)
 next
   case (Guard f g c s n t)
   have exec_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F (Guard f g c),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Fault f)
     with exec_strip have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_strip have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_strip have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s')
     show ?thesis
     proof (cases "f\<in>F")
       case True
       with exec_strip Normal
       have exec_strip_c: "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s'\<rangle> =n\<Rightarrow> t"
         by simp
       with Guard.hyps obtain t' where
         "\<Gamma>\<turnstile>\<langle>c,Normal s'\<rangle> =n\<Rightarrow> t'" and
         "isFault t \<longrightarrow> isFault t'" and
         "t' \<in> Fault ` (-F) \<longrightarrow> t'=t" and
         "\<not> isFault t' \<longrightarrow> t'=t"
         by blast
       with Normal True
       show ?thesis
         by (cases "s'\<in> g") (fastforce intro: execn.intros)+
     next
       case False
       note f_notin_F = this
       show ?thesis
       proof (cases "s'\<in>g")
         case False
         with Normal exec_strip f_notin_F have t: "t=Fault f"
           by (auto elim: execn_Normal_elim_cases)
         from False
         have "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s'\<rangle> =n\<Rightarrow> Fault f"
           by (blast intro: execn.intros)
         with False Normal t show ?thesis
           by auto
       next
         case True
         with exec_strip Normal f_notin_F
         have "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s'\<rangle> =n\<Rightarrow> t"
           by (auto elim: execn_Normal_elim_cases)
         with Guard.hyps obtain t' where
           "\<Gamma>\<turnstile>\<langle>c,Normal s'\<rangle> =n\<Rightarrow> t'" and
           "isFault t \<longrightarrow> isFault t'" and
           "t' \<in> Fault ` (-F) \<longrightarrow> t'=t" and
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with Normal True
         show ?thesis
           by (blast intro: execn.intros)
       qed
     qed
   qed
 next
   case Throw thus ?case by auto
 next
   case (Catch c1 c2 s n t)
   have exec_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F (Catch c1 c2),s\<rangle> =n\<Rightarrow> t" by fact
   show ?case
   proof (cases "s")
     case (Fault f)
     with exec_strip have "t=Fault f"
       by (auto dest: execn_Fault_end)
     with Fault show ?thesis
       by auto
   next
     case Stuck
     with exec_strip have "t=Stuck"
       by (auto dest: execn_Stuck_end)
     with Stuck show ?thesis
       by auto
   next
     case (Abrupt s')
     with exec_strip have "t=Abrupt s'"
       by (auto dest: execn_Abrupt_end)
     with Abrupt show ?thesis
       by auto
   next
     case (Normal s') note s=this
     with exec_strip have
       "\<Gamma>\<turnstile>\<langle>Catch (strip_guards F c1) (strip_guards F c2),Normal s'\<rangle> =n\<Rightarrow> t" by simp
     thus ?thesis
     proof (cases)
       fix w
       assume exec_strip_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s'\<rangle> =n\<Rightarrow> Abrupt w"
       assume exec_strip_c2: "\<Gamma>\<turnstile>\<langle>strip_guards F c2,Normal w\<rangle> =n\<Rightarrow> t"
       from exec_strip_c1 Catch.hyps
       obtain w' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> w'" and
         w'_Fault: "w' \<in> Fault ` (-F) \<longrightarrow> w'=Abrupt w" and
         w'_noFault: "\<not> isFault w' \<longrightarrow> w'=Abrupt w"
         by blast
       show ?thesis
       proof (cases "w'")
         case (Fault f')
         with Normal exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,s\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         with w'_Fault Fault show ?thesis
           by auto
       next
         case Stuck
         with w'_noFault have False
           by simp
         thus ?thesis ..
       next
         case (Normal w'')
         with w'_noFault have False by simp thus ?thesis ..
       next
         case (Abrupt w'')
         with w'_noFault have w'': "w''=w" by simp
         from  exec_strip_c2 Catch.hyps
         obtain t' where
           "\<Gamma>\<turnstile>\<langle>c2,Normal w\<rangle> =n\<Rightarrow> t'"
           "isFault t \<longrightarrow> isFault t'"
           "t' \<in> Fault ` (-F) \<longrightarrow> t'=t"
           "\<not> isFault t' \<longrightarrow> t'=t"
           by blast
         with w'' Abrupt s exec_c1
         show ?thesis
           by (blast intro: execn.intros)
       qed
     next
       assume t: "\<not> isAbr t"
       assume "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s'\<rangle> =n\<Rightarrow> t"
       with Catch.hyps
       obtain t' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s'\<rangle> =n\<Rightarrow> t'"  and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t'_Fault: "t' \<in> Fault ` (-F) \<longrightarrow> t'=t" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t'=t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         then obtain f' where t': "t'=Fault f'"..
         with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s'\<rangle> =n\<Rightarrow> Fault f'"
           by (auto intro: execn.intros)
         with t'_Fault t' s show ?thesis
           by auto
       next
         case False
         with t'_noFault have "t'=t" by simp
         with t exec_c1 s show ?thesis
           by (blast intro: execn.intros)
       qed
     qed
   qed
 qed
 
 
 lemma execn_strip_to_execn:
   assumes exec_strip: "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t' \<and>
                  (isFault t \<longrightarrow> isFault t') \<and>
                  (t' \<in> Fault ` (- F) \<longrightarrow> t'=t) \<and>
                  (\<not> isFault t' \<longrightarrow> t'=t)"
 using exec_strip
 proof (induct)
   case Skip thus ?case by (blast intro: execn.intros)
 next
   case Guard thus ?case by (blast intro: execn.intros)
 next
   case GuardFault thus ?case by (blast intro: execn.intros)
 next
   case FaultProp thus ?case by (blast intro: execn.intros)
 next
   case Basic thus ?case by (blast intro: execn.intros)
 next
   case Spec thus ?case by (blast intro: execn.intros)
 next
   case SpecStuck thus ?case by (blast intro: execn.intros)
 next
   case Seq thus ?case by (blast intro: execn.intros elim: isFaultE)
 next
   case CondTrue thus ?case by (blast intro: execn.intros)
 next
   case CondFalse thus ?case by (blast intro: execn.intros)
 next
   case WhileTrue thus ?case by (blast intro: execn.intros elim: isFaultE)
 next
   case WhileFalse thus ?case by (blast intro: execn.intros)
 next
   case Call thus ?case
     by simp (blast intro: execn.intros dest: execn_strip_guards_to_execn)
 next
   case CallUndefined thus ?case
     by simp (blast intro: execn.intros)
 next
   case StuckProp thus ?case
     by blast
 next
   case DynCom thus ?case by (blast intro: execn.intros)
 next
   case Throw thus ?case by (blast intro: execn.intros)
 next
   case AbruptProp thus ?case by (blast intro: execn.intros)
 next
   case (CatchMatch c1 s n r c2 t)
   then obtain r' t' where
     exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> r'"  and
     r'_Fault: "r' \<in> Fault ` (-F) \<longrightarrow> r' = Abrupt r" and
     r'_noFault: "\<not> isFault r' \<longrightarrow> r' = Abrupt r" and
     exec_c2: "\<Gamma>\<turnstile>\<langle>c2,Normal r\<rangle> =n\<Rightarrow> t'" and
     t_Fault: "isFault t \<longrightarrow> isFault t'" and
     t'_Fault: "t' \<in> Fault ` (-F) \<longrightarrow> t' = t" and
     t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
     by blast
   show ?case
   proof (cases "isFault r'")
     case True
     then obtain f' where r': "r'=Fault f'"..
     with exec_c1 have "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> =n\<Rightarrow> Fault f'"
       by (auto intro: execn.intros)
     with r' r'_Fault show ?thesis
       by (auto intro: execn.intros)
   next
     case False
     with r'_noFault have "r'=Abrupt r" by simp
     with exec_c1 exec_c2 t_Fault t'_noFault t'_Fault
     show ?thesis
       by (blast intro: execn.intros)
   qed
 next
   case CatchMiss thus ?case by (fastforce intro: execn.intros elim: isFaultE)
 qed
 
 lemma exec_strip_guards_to_exec:
   assumes exec_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t' \<and>
               (isFault t \<longrightarrow> isFault t') \<and>
               (t' \<in> Fault ` (-F) \<longrightarrow> t'=t) \<and>
               (\<not> isFault t' \<longrightarrow> t'=t)"
 proof -
   from exec_strip obtain n where
     execn_strip: "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> t"
     by (auto simp add: exec_iff_execn)
   then obtain t' where
     "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t'"
     "isFault t \<longrightarrow> isFault t'" "t' \<in> Fault ` (-F) \<longrightarrow> t'=t" "\<not> isFault t' \<longrightarrow> t'=t"
     by (blast dest: execn_strip_guards_to_execn)
   thus ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 lemma exec_strip_to_exec:
   assumes exec_strip: "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t' \<and>
               (isFault t \<longrightarrow> isFault t') \<and>
               (t' \<in> Fault ` (-F) \<longrightarrow> t'=t) \<and>
               (\<not> isFault t' \<longrightarrow> t'=t)"
 proof -
   from exec_strip obtain n where
     execn_strip: "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     by (auto simp add: exec_iff_execn)
   then obtain t' where
     "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t'"
     "isFault t \<longrightarrow> isFault t'" "t' \<in> Fault ` (-F) \<longrightarrow> t'=t" "\<not> isFault t' \<longrightarrow> t'=t"
     by (blast dest: execn_strip_to_execn)
   thus ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 
 lemma exec_to_exec_strip_guards:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes t_not_Fault: "\<not> isFault t"
  shows "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t"
     by (auto simp add: exec_iff_execn)
   from this t_not_Fault
   have "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> t"
     by (rule execn_to_execn_strip_guards )
   thus "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> t"
     by (rule execn_to_exec)
 qed
 
 lemma exec_to_exec_strip_guards':
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes t_not_Fault: "t \<notin> Fault ` F"
  shows "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t"
     by (auto simp add: exec_iff_execn)
   from this t_not_Fault
   have "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> t"
     by (rule execn_to_execn_strip_guards' )
   thus "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> t"
     by (rule execn_to_exec)
 qed
 
 lemma execn_to_execn_strip:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes t_not_Fault: "\<not> isFault t"
  shows "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
 using exec_c t_not_Fault
 proof (induct)
   case (Call p bdy s n  s')
   have bdy: "\<Gamma> p = Some bdy" by fact
   from Call have "strip F \<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =n\<Rightarrow> s'"
     by blast
   from execn_to_execn_strip_guards [OF this] Call
   have "strip F \<Gamma>\<turnstile>\<langle>strip_guards F bdy,Normal s\<rangle> =n\<Rightarrow> s'"
     by simp
   moreover from bdy have "(strip F \<Gamma>) p = Some (strip_guards F bdy)"
     by simp
   ultimately
   show ?case
     by (blast intro: execn.intros)
 next
   case CallUndefined thus ?case by (auto intro: execn.CallUndefined)
 qed (auto intro: execn.intros dest: noFaultn_startD' simp add: not_isFault_iff)
 
 lemma execn_to_execn_strip':
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes t_not_Fault: "t \<notin> Fault ` F"
  shows "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
 using exec_c t_not_Fault
 proof (induct)
   case (Call p bdy s n s')
   have bdy: "\<Gamma> p = Some bdy" by fact
   from Call have "strip F \<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =n\<Rightarrow> s'"
     by blast
   from execn_to_execn_strip_guards' [OF this] Call
   have "strip F \<Gamma>\<turnstile>\<langle>strip_guards F bdy,Normal s\<rangle> =n\<Rightarrow> s'"
     by simp
   moreover from bdy have "(strip F \<Gamma>) p = Some (strip_guards F bdy)"
     by simp
   ultimately
   show ?case
     by (blast intro: execn.intros)
 next
   case CallUndefined thus ?case by (auto intro: execn.CallUndefined)
 next
   case (Seq c1 s n s' c2 t)
   show ?case
   proof (cases "isFault s'")
     case False
     with Seq show ?thesis
       by (auto intro: execn.intros simp add: not_isFault_iff)
   next
     case True
     then obtain f' where s': "s'=Fault f'" by (auto simp add: isFault_def)
     with Seq obtain "t=Fault f'" and "f' \<notin> F"
       by (force dest: execn_Fault_end)
     with Seq s' show ?thesis
       by (auto intro: execn.intros)
   qed
 next
   case (WhileTrue b c s n s' t)
   show ?case
   proof (cases "isFault s'")
     case False
     with WhileTrue show ?thesis
       by (auto intro: execn.intros simp add: not_isFault_iff)
   next
     case True
     then obtain f' where s': "s'=Fault f'" by (auto simp add: isFault_def)
     with WhileTrue obtain "t=Fault f'" and "f' \<notin> F"
       by (force dest: execn_Fault_end)
     with WhileTrue s' show ?thesis
       by (auto intro: execn.intros)
   qed
 qed (auto intro: execn.intros)
 
 lemma exec_to_exec_strip:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes t_not_Fault: "\<not> isFault t"
  shows "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t"
     by (auto simp add: exec_iff_execn)
   from this t_not_Fault
   have "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     by (rule execn_to_execn_strip)
   thus "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
     by (rule execn_to_exec)
 qed
 
 lemma exec_to_exec_strip':
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes t_not_Fault: "t \<notin> Fault ` F"
  shows "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>t"
     by (auto simp add: exec_iff_execn)
   from this t_not_Fault
   have "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     by (rule execn_to_execn_strip' )
   thus "strip F \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
     by (rule execn_to_exec)
 qed
 
 lemma exec_to_exec_strip_guards_Fault:
  assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f"
  assumes f_notin_F: "f \<notin> F"
  shows"\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> Fault f"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow>Fault f"
     by (auto simp add: exec_iff_execn)
   from execn_to_execn_strip_guards_Fault [OF this _ f_notin_F]
   have "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> =n\<Rightarrow> Fault f"
     by simp
   thus "\<Gamma>\<turnstile>\<langle>strip_guards F c,s\<rangle> \<Rightarrow> Fault f"
     by (rule execn_to_exec)
 qed
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{term "c\<^sub>1 \<inter>\<^sub>g c\<^sub>2"}\<close>
 (* ************************************************************************* *)
 
 lemma inter_guards_execn_Normal_noFault:
   "\<And>c c2 s t n. \<lbrakk>(c1 \<inter>\<^sub>g c2) = Some c; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t; \<not> isFault t\<rbrakk>
         \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> t \<and> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> =n\<Rightarrow> t"
 proof (induct c1)
   case Skip
   have "(Skip \<inter>\<^sub>g c2) = Some c" by fact
   then obtain c2: "c2=Skip" and c: "c=Skip"
     by (simp add: inter_guards_Skip)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c have "t=Normal s"
     by (auto elim: execn_Normal_elim_cases)
   with Skip c2
   show ?case
     by (auto intro: execn.intros)
 next
   case (Basic f)
   have "(Basic f \<inter>\<^sub>g c2) = Some c" by fact
   then obtain c2: "c2=Basic f" and c: "c=Basic f"
     by (simp add: inter_guards_Basic)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c have "t=Normal (f s)"
     by (auto elim: execn_Normal_elim_cases)
   with Basic c2
   show ?case
     by (auto intro: execn.intros)
 next
   case (Spec r)
   have "(Spec r \<inter>\<^sub>g c2) = Some c" by fact
   then obtain c2: "c2=Spec r" and c: "c=Spec r"
     by (simp add: inter_guards_Spec)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c have "\<Gamma>\<turnstile>\<langle>Spec r,Normal s\<rangle> =n\<Rightarrow> t" by simp
   from this Spec c2 show ?case
     by (cases) (auto intro: execn.intros)
 next
   case (Seq a1 a2)
   have noFault: "\<not> isFault t" by fact
   have "(Seq a1 a2 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain b1 b2 d1 d2 where
     c2: "c2=Seq b1 b2" and
     d1: "(a1 \<inter>\<^sub>g b1) = Some d1" and d2: "(a2 \<inter>\<^sub>g b2) = Some d2" and
     c: "c=Seq d1 d2"
     by (auto simp add: inter_guards_Seq)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c obtain s' where
     exec_d1: "\<Gamma>\<turnstile>\<langle>d1,Normal s\<rangle> =n\<Rightarrow> s'" and
     exec_d2: "\<Gamma>\<turnstile>\<langle>d2,s'\<rangle> =n\<Rightarrow> t"
     by (auto elim: execn_Normal_elim_cases)
   show ?case
   proof (cases s')
     case (Fault f')
     with exec_d2 have "t=Fault f'"
       by (auto intro: execn_Fault_end)
     with noFault show  ?thesis by simp
   next
     case (Normal s'')
     with d1 exec_d1 Seq.hyps
     obtain
       "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Normal s''" and "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Normal s''"
       by auto
     moreover
     from Normal d2 exec_d2 noFault Seq.hyps
     obtain "\<Gamma>\<turnstile>\<langle>a2,Normal s''\<rangle> =n\<Rightarrow> t" and "\<Gamma>\<turnstile>\<langle>b2,Normal s''\<rangle> =n\<Rightarrow> t"
       by auto
     ultimately
     show ?thesis
       using Normal c2 by (auto intro: execn.intros)
   next
     case (Abrupt s'')
     with exec_d2 have "t=Abrupt s''"
       by (auto simp add: execn_Abrupt_end)
     moreover
     from Abrupt d1 exec_d1 Seq.hyps
     obtain "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Abrupt s''" and "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Abrupt s''"
       by auto
     moreover
     obtain
       "\<Gamma>\<turnstile>\<langle>a2,Abrupt s''\<rangle> =n\<Rightarrow> Abrupt s''" and "\<Gamma>\<turnstile>\<langle>b2,Abrupt s''\<rangle> =n\<Rightarrow> Abrupt s''"
       by auto
     ultimately
     show ?thesis
       using Abrupt c2 by (auto intro: execn.intros)
   next
     case Stuck
     with exec_d2 have "t=Stuck"
       by (auto simp add: execn_Stuck_end)
     moreover
     from Stuck d1 exec_d1 Seq.hyps
     obtain "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Stuck" and "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Stuck"
       by auto
     moreover
     obtain
       "\<Gamma>\<turnstile>\<langle>a2,Stuck\<rangle> =n\<Rightarrow> Stuck" and "\<Gamma>\<turnstile>\<langle>b2,Stuck\<rangle> =n\<Rightarrow> Stuck"
       by auto
     ultimately
     show ?thesis
       using Stuck c2 by (auto intro: execn.intros)
   qed
 next
   case (Cond b t1 e1)
   have noFault: "\<not> isFault t" by fact
   have "(Cond b t1 e1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain t2 e2 t3 e3 where
     c2: "c2=Cond b t2 e2" and
     t3: "(t1 \<inter>\<^sub>g t2) = Some t3" and
     e3: "(e1 \<inter>\<^sub>g e2) = Some e3" and
     c: "c=Cond b t3 e3"
     by (auto simp add: inter_guards_Cond)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c have "\<Gamma>\<turnstile>\<langle>Cond b t3 e3,Normal s\<rangle> =n\<Rightarrow> t"
     by simp
   then show ?case
   proof (cases)
     assume s_in_b: "s\<in>b"
     assume "\<Gamma>\<turnstile>\<langle>t3,Normal s\<rangle> =n\<Rightarrow> t"
     with Cond.hyps t3 noFault
     obtain "\<Gamma>\<turnstile>\<langle>t1,Normal s\<rangle> =n\<Rightarrow> t" "\<Gamma>\<turnstile>\<langle>t2,Normal s\<rangle> =n\<Rightarrow> t"
       by auto
     with s_in_b c2 show ?thesis
       by (auto intro: execn.intros)
   next
     assume s_notin_b: "s\<notin>b"
     assume "\<Gamma>\<turnstile>\<langle>e3,Normal s\<rangle> =n\<Rightarrow> t"
     with Cond.hyps e3 noFault
     obtain "\<Gamma>\<turnstile>\<langle>e1,Normal s\<rangle> =n\<Rightarrow> t" "\<Gamma>\<turnstile>\<langle>e2,Normal s\<rangle> =n\<Rightarrow> t"
       by auto
     with s_notin_b c2 show ?thesis
       by (auto intro: execn.intros)
   qed
 next
   case (While b bdy1)
   have noFault: "\<not> isFault t" by fact
   have "(While b bdy1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain bdy2 bdy where
     c2: "c2=While b bdy2" and
     bdy: "(bdy1 \<inter>\<^sub>g bdy2) = Some bdy" and
     c: "c=While b bdy"
     by (auto simp add: inter_guards_While)
   have exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   {
     fix s t n w w1 w2
     assume exec_w: "\<Gamma>\<turnstile>\<langle>w,Normal s\<rangle> =n\<Rightarrow> t"
     assume w: "w=While b bdy"
     assume noFault: "\<not> isFault t"
     from exec_w w noFault
     have "\<Gamma>\<turnstile>\<langle>While b bdy1,Normal s\<rangle> =n\<Rightarrow> t \<and>
           \<Gamma>\<turnstile>\<langle>While b bdy2,Normal s\<rangle> =n\<Rightarrow> t"
     proof (induct)
       prefer 10
       case (WhileTrue s b' bdy' n s' s'')
       have eqs: "While b'  bdy' = While b bdy" by fact
       from WhileTrue have s_in_b: "s \<in> b" by simp
       have noFault_s'': "\<not> isFault s''"  by fact
       from WhileTrue
       have exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =n\<Rightarrow> s'" by simp
       from WhileTrue
       have exec_w: "\<Gamma>\<turnstile>\<langle>While b bdy,s'\<rangle> =n\<Rightarrow> s''" by simp
       show ?case
       proof (cases s')
         case (Fault f)
         with exec_w have "s''=Fault f"
           by (auto intro: execn_Fault_end)
         with noFault_s'' show ?thesis by simp
       next
         case (Normal s''')
         with exec_bdy bdy While.hyps
         obtain "\<Gamma>\<turnstile>\<langle>bdy1,Normal s\<rangle> =n\<Rightarrow> Normal s'''"
                "\<Gamma>\<turnstile>\<langle>bdy2,Normal s\<rangle> =n\<Rightarrow> Normal s'''"
           by auto
         moreover
         from Normal WhileTrue
         obtain
           "\<Gamma>\<turnstile>\<langle>While b bdy1,Normal s'''\<rangle> =n\<Rightarrow> s''"
           "\<Gamma>\<turnstile>\<langle>While b bdy2,Normal s'''\<rangle> =n\<Rightarrow> s''"
           by simp
         ultimately show ?thesis
           using s_in_b Normal
           by (auto intro: execn.intros)
       next
         case (Abrupt s''')
         with exec_bdy bdy While.hyps
         obtain "\<Gamma>\<turnstile>\<langle>bdy1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'''"
                "\<Gamma>\<turnstile>\<langle>bdy2,Normal s\<rangle> =n\<Rightarrow> Abrupt s'''"
           by auto
         moreover
         from Abrupt WhileTrue
         obtain
           "\<Gamma>\<turnstile>\<langle>While b bdy1,Abrupt s'''\<rangle> =n\<Rightarrow> s''"
           "\<Gamma>\<turnstile>\<langle>While b bdy2,Abrupt s'''\<rangle> =n\<Rightarrow> s''"
           by simp
         ultimately show ?thesis
           using s_in_b Abrupt
           by (auto intro: execn.intros)
       next
         case Stuck
         with exec_bdy bdy While.hyps
         obtain "\<Gamma>\<turnstile>\<langle>bdy1,Normal s\<rangle> =n\<Rightarrow> Stuck"
                "\<Gamma>\<turnstile>\<langle>bdy2,Normal s\<rangle> =n\<Rightarrow> Stuck"
           by auto
         moreover
         from Stuck WhileTrue
         obtain
           "\<Gamma>\<turnstile>\<langle>While b bdy1,Stuck\<rangle> =n\<Rightarrow> s''"
           "\<Gamma>\<turnstile>\<langle>While b bdy2,Stuck\<rangle> =n\<Rightarrow> s''"
           by simp
         ultimately show ?thesis
           using s_in_b Stuck
           by (auto intro: execn.intros)
       qed
     next
       case WhileFalse thus ?case by (auto intro: execn.intros)
     qed (simp_all)
   }
   with this [OF exec_c c noFault] c2
   show ?case
     by auto
 next
   case Call thus ?case by (simp add: inter_guards_Call)
 next
   case (DynCom f1)
   have noFault: "\<not> isFault t" by fact
   have "(DynCom f1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain f2 f where
     c2: "c2=DynCom f2" and
     f_defined: "\<forall>s. ((f1 s) \<inter>\<^sub>g (f2 s)) \<noteq> None" and
     c: "c=DynCom (\<lambda>s. the ((f1 s) \<inter>\<^sub>g (f2 s)))"
     by (auto simp add: inter_guards_DynCom)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c have "\<Gamma>\<turnstile>\<langle>DynCom (\<lambda>s. the ((f1 s) \<inter>\<^sub>g (f2 s))),Normal s\<rangle> =n\<Rightarrow> t" by simp
   then show ?case
   proof (cases)
     assume exec_f: "\<Gamma>\<turnstile>\<langle>the (f1 s \<inter>\<^sub>g f2 s),Normal s\<rangle> =n\<Rightarrow> t"
     from f_defined obtain f where "(f1 s \<inter>\<^sub>g f2 s) = Some f"
       by auto
     with DynCom.hyps this exec_f c2 noFault
     show ?thesis
       using execn.DynCom by fastforce
   qed
 next
   case Guard thus ?case
     by (fastforce elim: execn_Normal_elim_cases intro: execn.intros
         simp add: inter_guards_Guard)
 next
   case Throw thus ?case
     by (fastforce elim: execn_Normal_elim_cases
         simp add: inter_guards_Throw)
 next
   case (Catch a1 a2)
   have noFault: "\<not> isFault t" by fact
   have "(Catch a1 a2 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain b1 b2 d1 d2 where
     c2: "c2=Catch b1 b2" and
     d1: "(a1 \<inter>\<^sub>g b1) = Some d1" and d2: "(a2 \<inter>\<^sub>g b2) = Some d2" and
     c: "c=Catch d1 d2"
     by (auto simp add: inter_guards_Catch)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> t" by fact
   with c have "\<Gamma>\<turnstile>\<langle>Catch d1 d2,Normal s\<rangle> =n\<Rightarrow> t" by simp
   then show ?case
   proof (cases)
     fix s'
     assume "\<Gamma>\<turnstile>\<langle>d1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'"
     with d1 Catch.hyps
     obtain "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'" and "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'"
       by auto
     moreover
     assume "\<Gamma>\<turnstile>\<langle>d2,Normal s'\<rangle> =n\<Rightarrow> t"
     with d2 Catch.hyps noFault
     obtain "\<Gamma>\<turnstile>\<langle>a2,Normal s'\<rangle> =n\<Rightarrow> t" and "\<Gamma>\<turnstile>\<langle>b2,Normal s'\<rangle> =n\<Rightarrow> t"
       by auto
     ultimately
     show ?thesis
       using c2 by (auto intro: execn.intros)
   next
     assume "\<not> isAbr t"
     moreover
     assume "\<Gamma>\<turnstile>\<langle>d1,Normal s\<rangle> =n\<Rightarrow> t"
     with d1 Catch.hyps noFault
     obtain "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> t" and "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> t"
       by auto
     ultimately
     show ?thesis
       using c2 by (auto intro: execn.intros)
   qed
 qed
 
 
 lemma inter_guards_execn_noFault:
   assumes c: "(c1 \<inter>\<^sub>g c2) = Some c"
   assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   assumes noFault: "\<not> isFault t"
   shows "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> t \<and> \<Gamma>\<turnstile>\<langle>c2,s\<rangle> =n\<Rightarrow> t"
 proof (cases s)
   case (Fault f)
   with exec_c have "t = Fault f"
     by (auto intro: execn_Fault_end)
     with noFault show ?thesis
     by simp
 next
   case (Abrupt s')
   with exec_c have "t=Abrupt s'"
     by (simp add: execn_Abrupt_end)
   with Abrupt show ?thesis by auto
 next
   case Stuck
   with exec_c have "t=Stuck"
     by (simp add: execn_Stuck_end)
   with Stuck show ?thesis by auto
 next
   case (Normal s')
   with exec_c noFault inter_guards_execn_Normal_noFault [OF c]
   show ?thesis
     by blast
 qed
 
 lemma inter_guards_exec_noFault:
   assumes c: "(c1 \<inter>\<^sub>g c2) = Some c"
   assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   assumes noFault: "\<not> isFault t"
   shows "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> t \<and> \<Gamma>\<turnstile>\<langle>c2,s\<rangle> \<Rightarrow> t"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     by (auto simp add: exec_iff_execn)
   from c this noFault
   have "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> t \<and> \<Gamma>\<turnstile>\<langle>c2,s\<rangle> =n\<Rightarrow> t"
     by (rule inter_guards_execn_noFault)
   thus ?thesis
     by (auto intro: execn_to_exec)
 qed
 
 
 lemma inter_guards_execn_Normal_Fault:
   "\<And>c c2 s n. \<lbrakk>(c1 \<inter>\<^sub>g c2) = Some c; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f\<rbrakk>
         \<Longrightarrow> (\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> =n\<Rightarrow> Fault f)"
 proof (induct c1)
   case Skip thus ?case by (fastforce simp add: inter_guards_Skip)
 next
   case (Basic f) thus ?case by (fastforce simp add: inter_guards_Basic)
 next
   case (Spec r) thus ?case by (fastforce simp add: inter_guards_Spec)
 next
   case (Seq a1 a2)
   have "(Seq a1 a2 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain b1 b2 d1 d2 where
     c2: "c2=Seq b1 b2" and
     d1: "(a1 \<inter>\<^sub>g b1) = Some d1" and d2: "(a2 \<inter>\<^sub>g b2) = Some d2" and
     c: "c=Seq d1 d2"
     by (auto simp add: inter_guards_Seq)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f" by fact
   with c obtain s' where
     exec_d1: "\<Gamma>\<turnstile>\<langle>d1,Normal s\<rangle> =n\<Rightarrow> s'" and
     exec_d2: "\<Gamma>\<turnstile>\<langle>d2,s'\<rangle> =n\<Rightarrow> Fault f"
     by (auto elim: execn_Normal_elim_cases)
   show ?case
   proof (cases s')
     case (Fault f')
     with exec_d2 have "f'=f"
       by (auto dest: execn_Fault_end)
     with Fault d1 exec_d1
     have "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by (auto dest: Seq.hyps)
     thus ?thesis
     proof (cases rule: disjE [consumes 1])
       assume "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Fault f"
       hence "\<Gamma>\<turnstile>\<langle>Seq a1 a2,Normal s\<rangle> =n\<Rightarrow> Fault f"
         by (auto intro: execn.intros)
       thus ?thesis
         by simp
     next
       assume "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Fault f"
       hence "\<Gamma>\<turnstile>\<langle>Seq b1 b2,Normal s\<rangle> =n\<Rightarrow> Fault f"
         by (auto intro: execn.intros)
       with c2 show ?thesis
         by simp
     qed
   next
     case Abrupt with exec_d2 show ?thesis by (auto dest: execn_Abrupt_end)
   next
     case Stuck with exec_d2 show ?thesis by (auto dest: execn_Stuck_end)
   next
     case (Normal s'')
     with inter_guards_execn_noFault [OF d1 exec_d1] obtain
       exec_a1: "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Normal s''" and
       exec_b1: "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Normal s''"
       by simp
     moreover from d2 exec_d2 Normal
     have "\<Gamma>\<turnstile>\<langle>a2,Normal s''\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>b2,Normal s''\<rangle> =n\<Rightarrow> Fault f"
       by (auto dest: Seq.hyps)
     ultimately show ?thesis
       using c2 by (auto intro: execn.intros)
   qed
 next
   case (Cond b t1 e1)
   have "(Cond b t1 e1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain t2 e2 t e where
     c2: "c2=Cond b t2 e2" and
     t: "(t1 \<inter>\<^sub>g t2) = Some t" and
     e: "(e1 \<inter>\<^sub>g e2) = Some e" and
     c: "c=Cond b t e"
     by (auto simp add: inter_guards_Cond)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f" by fact
   with c have "\<Gamma>\<turnstile>\<langle>Cond b t e,Normal s\<rangle> =n\<Rightarrow> Fault f" by simp
   thus ?case
   proof (cases)
     assume "s \<in> b"
     moreover assume "\<Gamma>\<turnstile>\<langle>t,Normal s\<rangle> =n\<Rightarrow> Fault f"
     with t have "\<Gamma>\<turnstile>\<langle>t1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>t2,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by (auto dest: Cond.hyps)
     ultimately show ?thesis using c2 c by (fastforce intro: execn.intros)
   next
     assume "s \<notin> b"
     moreover assume "\<Gamma>\<turnstile>\<langle>e,Normal s\<rangle> =n\<Rightarrow> Fault f"
     with e have "\<Gamma>\<turnstile>\<langle>e1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>e2,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by (auto dest: Cond.hyps)
     ultimately show ?thesis using c2 c by (fastforce intro: execn.intros)
   qed
 next
   case (While b bdy1)
   have "(While b bdy1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain bdy2 bdy where
     c2: "c2=While b bdy2" and
     bdy: "(bdy1 \<inter>\<^sub>g bdy2) = Some bdy" and
     c: "c=While b bdy"
     by (auto simp add: inter_guards_While)
   have exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f" by fact
   {
     fix s t n w w1 w2
     assume exec_w: "\<Gamma>\<turnstile>\<langle>w,Normal s\<rangle> =n\<Rightarrow> t"
     assume w: "w=While b bdy"
     assume Fault: "t=Fault f"
     from exec_w w Fault
     have "\<Gamma>\<turnstile>\<langle>While b bdy1,Normal s\<rangle> =n\<Rightarrow> Fault f\<or>
           \<Gamma>\<turnstile>\<langle>While b bdy2,Normal s\<rangle> =n\<Rightarrow> Fault f"
     proof (induct)
       case (WhileTrue s b' bdy' n  s' s'')
       have eqs: "While b' bdy' = While b bdy" by fact
       from WhileTrue have s_in_b: "s \<in> b" by simp
       have Fault_s'': "s''=Fault f"  by fact
       from WhileTrue
       have exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =n\<Rightarrow> s'" by simp
       from WhileTrue
       have exec_w: "\<Gamma>\<turnstile>\<langle>While b bdy,s'\<rangle> =n\<Rightarrow> s''" by simp
       show ?case
       proof (cases s')
         case (Fault f')
         with exec_w Fault_s'' have "f'=f"
           by (auto dest: execn_Fault_end)
         with Fault exec_bdy bdy While.hyps
         have "\<Gamma>\<turnstile>\<langle>bdy1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>bdy2,Normal s\<rangle> =n\<Rightarrow> Fault f"
           by auto
         with s_in_b show ?thesis
           by (fastforce intro: execn.intros)
       next
         case (Normal s''')
         with inter_guards_execn_noFault [OF bdy exec_bdy]
         obtain "\<Gamma>\<turnstile>\<langle>bdy1,Normal s\<rangle> =n\<Rightarrow> Normal s'''"
                "\<Gamma>\<turnstile>\<langle>bdy2,Normal s\<rangle> =n\<Rightarrow> Normal s'''"
           by auto
         moreover
         from Normal WhileTrue
         have "\<Gamma>\<turnstile>\<langle>While b bdy1,Normal s'''\<rangle> =n\<Rightarrow> Fault f \<or>
               \<Gamma>\<turnstile>\<langle>While b bdy2,Normal s'''\<rangle> =n\<Rightarrow> Fault f"
           by simp
         ultimately show ?thesis
           using s_in_b by (fastforce intro: execn.intros)
       next
         case (Abrupt s''')
         with exec_w Fault_s'' show ?thesis by (fastforce dest: execn_Abrupt_end)
       next
         case Stuck
         with exec_w Fault_s'' show ?thesis by (fastforce dest: execn_Stuck_end)
       qed
     next
       case WhileFalse thus ?case by (auto intro: execn.intros)
     qed (simp_all)
   }
   with this [OF exec_c c] c2
   show ?case
     by auto
 next
   case Call thus ?case by (fastforce simp add: inter_guards_Call)
 next
   case (DynCom f1)
   have "(DynCom f1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain f2  where
     c2: "c2=DynCom f2" and
     F_defined: "\<forall>s. ((f1 s) \<inter>\<^sub>g (f2 s)) \<noteq> None" and
     c: "c=DynCom (\<lambda>s. the ((f1 s) \<inter>\<^sub>g (f2 s)))"
     by (auto simp add: inter_guards_DynCom)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f" by fact
   with c have "\<Gamma>\<turnstile>\<langle>DynCom (\<lambda>s. the ((f1 s) \<inter>\<^sub>g (f2 s))),Normal s\<rangle> =n\<Rightarrow> Fault f" by simp
   then show ?case
   proof (cases)
     assume exec_F: "\<Gamma>\<turnstile>\<langle>the (f1 s \<inter>\<^sub>g f2 s),Normal s\<rangle> =n\<Rightarrow> Fault f"
     from F_defined obtain F where "(f1 s \<inter>\<^sub>g f2 s) = Some F"
       by auto
     with DynCom.hyps this exec_F c2
     show ?thesis
       by (fastforce intro: execn.intros)
   qed
 next
   case (Guard m g1 bdy1)
   have "(Guard m g1 bdy1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain g2 bdy2 bdy where
     c2: "c2=Guard m g2 bdy2" and
     bdy: "(bdy1 \<inter>\<^sub>g bdy2) = Some bdy" and
     c: "c=Guard m (g1 \<inter> g2) bdy"
     by (auto simp add: inter_guards_Guard)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f" by fact
   with c have "\<Gamma>\<turnstile>\<langle>Guard m (g1 \<inter> g2) bdy,Normal s\<rangle> =n\<Rightarrow> Fault f"
     by simp
   thus ?case
   proof (cases)
     assume f_m: "Fault f = Fault m"
     assume "s \<notin> g1 \<inter> g2"
     hence "s\<notin>g1 \<or> s\<notin>g2"
       by blast
     with c2 f_m show ?thesis
       by (auto intro: execn.intros)
   next
     assume "s \<in> g1 \<inter> g2"
     moreover
     assume "\<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> =n\<Rightarrow> Fault f"
     with bdy have "\<Gamma>\<turnstile>\<langle>bdy1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>bdy2,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by (rule Guard.hyps)
     ultimately show ?thesis
       using c2
       by (auto intro: execn.intros)
   qed
 next
   case Throw thus ?case by (fastforce simp add: inter_guards_Throw)
 next
   case (Catch a1 a2)
   have "(Catch a1 a2 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain b1 b2 d1 d2 where
     c2: "c2=Catch b1 b2" and
     d1: "(a1 \<inter>\<^sub>g b1) = Some d1" and d2: "(a2 \<inter>\<^sub>g b2) = Some d2" and
     c: "c=Catch d1 d2"
     by (auto simp add: inter_guards_Catch)
   have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> =n\<Rightarrow> Fault f" by fact
   with c have "\<Gamma>\<turnstile>\<langle>Catch d1 d2,Normal s\<rangle> =n\<Rightarrow> Fault f" by simp
   thus ?case
   proof (cases)
     fix s'
     assume "\<Gamma>\<turnstile>\<langle>d1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'"
     from inter_guards_execn_noFault [OF d1 this] obtain
       exec_a1: "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'" and
       exec_b1: "\<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Abrupt s'"
       by simp
     moreover assume  "\<Gamma>\<turnstile>\<langle>d2,Normal s'\<rangle> =n\<Rightarrow> Fault f"
     with d2
     have "\<Gamma>\<turnstile>\<langle>a2,Normal s'\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>b2,Normal s'\<rangle> =n\<Rightarrow> Fault f"
       by (auto dest: Catch.hyps)
     ultimately show ?thesis
       using c2 by (fastforce intro: execn.intros)
   next
     assume "\<Gamma>\<turnstile>\<langle>d1,Normal s\<rangle> =n\<Rightarrow> Fault f"
     with d1 have "\<Gamma>\<turnstile>\<langle>a1,Normal s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>b1,Normal s\<rangle> =n\<Rightarrow> Fault f"
       by (auto dest: Catch.hyps)
     with c2 show ?thesis
       by (fastforce intro: execn.intros)
   qed
 qed
 
 
 lemma inter_guards_execn_Fault:
   assumes c: "(c1 \<inter>\<^sub>g c2) = Some c"
   assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Fault f"
   shows "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>c2,s\<rangle> =n\<Rightarrow> Fault f"
 proof (cases s)
   case (Fault f)
   with exec_c show ?thesis
     by (auto dest: execn_Fault_end)
 next
   case (Abrupt s')
   with exec_c show ?thesis
     by (fastforce dest: execn_Abrupt_end)
 next
   case Stuck
   with exec_c show ?thesis
     by (fastforce dest: execn_Stuck_end)
 next
   case (Normal s')
   with exec_c inter_guards_execn_Normal_Fault [OF c]
   show ?thesis
     by blast
 qed
 
 lemma inter_guards_exec_Fault:
   assumes c: "(c1 \<inter>\<^sub>g c2) = Some c"
   assumes exec_c: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f"
   shows "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> \<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>c2,s\<rangle> \<Rightarrow> Fault f"
 proof -
   from exec_c obtain n where "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> Fault f"
     by (auto simp add: exec_iff_execn)
   from c this
   have "\<Gamma>\<turnstile>\<langle>c1,s\<rangle> =n\<Rightarrow> Fault f \<or> \<Gamma>\<turnstile>\<langle>c2,s\<rangle> =n\<Rightarrow> Fault f"
     by (rule inter_guards_execn_Fault)
   thus ?thesis
     by (auto intro: execn_to_exec)
 qed
 
 
 (* ************************************************************************* *)
 subsection "Restriction of Procedure Environment"
 (* ************************************************************************* *)
 
 lemma restrict_SomeD: "(m|\<^bsub>A\<^esub>) x = Some y \<Longrightarrow> m x = Some y"
   by (auto simp add: restrict_map_def split: if_split_asm)
 
-(* FIXME: To Map *)
+(* fixme: To Map *)
 lemma restrict_dom_same [simp]: "m|\<^bsub>dom m\<^esub> = m"
   apply (rule ext)
   apply (clarsimp simp add: restrict_map_def)
   apply (simp only: not_None_eq [symmetric])
   apply rule
   apply (drule sym)
   apply blast
   done
 
 lemma restrict_in_dom: "x \<in> A \<Longrightarrow> (m|\<^bsub>A\<^esub>) x = m x"
   by (auto simp add: restrict_map_def)
 
 
 lemma exec_restrict_to_exec:
   assumes exec_restrict: "\<Gamma>|\<^bsub>A\<^esub>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   assumes notStuck: "t\<noteq>Stuck"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 using exec_restrict notStuck
 by (induct) (auto intro: exec.intros dest: restrict_SomeD Stuck_end)
 
 lemma execn_restrict_to_execn:
   assumes exec_restrict: "\<Gamma>|\<^bsub>A\<^esub>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   assumes notStuck: "t\<noteq>Stuck"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
 using exec_restrict notStuck
 by (induct) (auto intro: execn.intros dest: restrict_SomeD execn_Stuck_end)
 
 lemma restrict_NoneD: "m x = None \<Longrightarrow>  (m|\<^bsub>A\<^esub>) x = None"
   by (auto simp add: restrict_map_def split: if_split_asm)
 
 lemma execn_to_execn_restrict:
   assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t' \<and> (t=Stuck \<longrightarrow> t'=Stuck) \<and>
                 (\<forall>f. t=Fault f \<longrightarrow> t'\<in>{Fault f,Stuck}) \<and> (t'\<noteq>Stuck \<longrightarrow> t'=t)"
 using execn
 proof (induct)
   case Skip show ?case by (blast intro: execn.Skip)
 next
   case Guard thus ?case by (auto intro: execn.Guard)
 next
   case GuardFault thus ?case by (auto intro: execn.GuardFault)
 next
   case FaultProp thus ?case by (auto intro: execn.FaultProp)
 next
   case Basic thus ?case by (auto intro: execn.Basic)
 next
   case Spec thus ?case by (auto intro: execn.Spec)
 next
   case SpecStuck thus ?case by (auto intro: execn.SpecStuck)
 next
   case Seq thus ?case by (metis insertCI execn.Seq StuckProp)
 next
   case CondTrue thus ?case by (auto intro: execn.CondTrue)
 next
   case CondFalse thus ?case by (auto intro: execn.CondFalse)
 next
   case WhileTrue thus ?case by (metis insertCI execn.WhileTrue StuckProp)
 next
   case WhileFalse thus ?case by (auto intro: execn.WhileFalse)
 next
   case (Call p bdy n s s')
   have "\<Gamma> p = Some bdy" by fact
   show ?case
   proof (cases "p \<in> P")
     case True
     with Call have "(\<Gamma>|\<^bsub>P\<^esub>) p = Some bdy"
       by (simp)
     with Call show ?thesis
       by (auto intro: execn.intros)
   next
     case False
     hence "(\<Gamma>|\<^bsub>P\<^esub>) p = None" by simp
     thus ?thesis
       by (auto intro: execn.CallUndefined)
   qed
 next
   case (CallUndefined p n s)
   have "\<Gamma> p = None" by fact
   hence "(\<Gamma>|\<^bsub>P\<^esub>) p = None" by (rule restrict_NoneD)
   thus ?case by (auto intro: execn.CallUndefined)
 next
   case StuckProp thus ?case by (auto intro: execn.StuckProp)
 next
   case DynCom thus ?case by (auto intro: execn.DynCom)
 next
   case Throw thus ?case by (auto intro: execn.Throw)
 next
   case AbruptProp thus ?case by (auto intro: execn.AbruptProp)
 next
   case (CatchMatch c1 s n s' c2 s'')
   from CatchMatch.hyps
   obtain t' t'' where
     exec_res_c1: "\<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> t'" and
     t'_notStuck: "t' \<noteq> Stuck \<longrightarrow> t' = Abrupt s'" and
     exec_res_c2: "\<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>c2,Normal s'\<rangle> =n\<Rightarrow> t''" and
     s''_Stuck: "s'' = Stuck \<longrightarrow> t'' = Stuck" and
     s''_Fault: "\<forall>f. s'' = Fault f \<longrightarrow> t'' \<in> {Fault f, Stuck}" and
     t''_notStuck: "t'' \<noteq> Stuck \<longrightarrow> t'' = s''"
     by auto
   show ?case
   proof (cases "t'=Stuck")
     case True
     with exec_res_c1
     have "\<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> =n\<Rightarrow> Stuck"
       by (auto intro: execn.CatchMiss)
     thus ?thesis
       by auto
   next
     case False
     with t'_notStuck have "t'= Abrupt s'"
       by simp
     with exec_res_c1 exec_res_c2
     have "\<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> =n\<Rightarrow> t''"
       by (auto intro: execn.CatchMatch)
     with s''_Stuck s''_Fault t''_notStuck
     show ?thesis
       by blast
   qed
 next
   case (CatchMiss c1 s n w c2)
   have exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> w" by fact
   from CatchMiss.hyps obtain w' where
     exec_c1': "\<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>c1,Normal s\<rangle> =n\<Rightarrow> w'" and
     w_Stuck: "w = Stuck \<longrightarrow> w' = Stuck" and
     w_Fault: "\<forall>f. w = Fault f \<longrightarrow> w' \<in> {Fault f, Stuck}" and
     w'_noStuck: "w' \<noteq> Stuck \<longrightarrow> w' = w"
     by auto
   have noAbr_w: "\<not> isAbr w" by fact
   show ?case
   proof (cases w')
     case (Normal s')
     with w'_noStuck have "w'=w"
       by simp
     with exec_c1' Normal w_Stuck w_Fault w'_noStuck
     show ?thesis
       by (fastforce intro: execn.CatchMiss)
   next
     case (Abrupt s')
     with w'_noStuck have "w'=w"
       by simp
     with noAbr_w Abrupt show ?thesis by simp
   next
     case (Fault f)
     with w'_noStuck have "w'=w"
       by simp
     with exec_c1' Fault w_Stuck w_Fault w'_noStuck
     show ?thesis
       by (fastforce intro: execn.CatchMiss)
   next
     case Stuck
     with exec_c1' w_Stuck w_Fault w'_noStuck
     show ?thesis
       by (fastforce intro: execn.CatchMiss)
   qed
 qed
 
 
 lemma exec_to_exec_restrict:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t' \<and> (t=Stuck \<longrightarrow> t'=Stuck) \<and>
                 (\<forall>f. t=Fault f\<longrightarrow> t'\<in>{Fault f,Stuck}) \<and> (t'\<noteq>Stuck \<longrightarrow> t'=t)"
 proof -
   from exec obtain n where
     execn_strip: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
     by (auto simp add: exec_iff_execn)
   from execn_to_execn_restrict [where P=P,OF this]
   obtain t' where
     "\<Gamma>|\<^bsub>P\<^esub>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t'"
     "t=Stuck \<longrightarrow> t'=Stuck" "\<forall>f. t=Fault f\<longrightarrow> t'\<in>{Fault f,Stuck}" "t'\<noteq>Stuck \<longrightarrow> t'=t"
     by blast
   thus ?thesis
     by (blast intro: execn_to_exec)
 qed
 
 lemma notStuck_GuardD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Guard m g c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; s \<in> g\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.Guard )
 
 lemma notStuck_SeqD1:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.Seq )
 
 
 lemma notStuck_SeqD2:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>s'\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c2,s'\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.Seq )
 
 lemma notStuck_SeqD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}\<rbrakk> \<Longrightarrow>
      \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck} \<and> (\<forall>s'. \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>s' \<longrightarrow> \<Gamma>\<turnstile>\<langle>c2,s'\<rangle> \<Rightarrow>\<notin>{Stuck})"
   by (auto simp add: final_notin_def dest: exec.Seq )
 
 lemma notStuck_CondTrueD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; s \<in> b\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.CondTrue)
 
 lemma notStuck_CondFalseD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Cond b c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; s \<notin> b\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.CondFalse)
 
 lemma notStuck_WhileTrueD1:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; s \<in> b\<rbrakk>
    \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.WhileTrue)
 
 lemma notStuck_WhileTrueD2:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow>s'; s \<in> b\<rbrakk>
    \<Longrightarrow> \<Gamma>\<turnstile>\<langle>While b c,s'\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.WhileTrue)
 
 lemma notStuck_CallD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Call p ,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma> p = Some bdy\<rbrakk>
    \<Longrightarrow> \<Gamma>\<turnstile>\<langle>bdy,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.Call)
 
 lemma notStuck_CallDefinedD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}\<rbrakk>
    \<Longrightarrow> \<Gamma> p \<noteq> None"
   by (cases "\<Gamma> p")
      (auto simp add: final_notin_def dest:  exec.CallUndefined)
 
 lemma notStuck_DynComD:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>DynCom c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}\<rbrakk>
    \<Longrightarrow> \<Gamma>\<turnstile>\<langle>(c s),Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.DynCom)
 
 lemma notStuck_CatchD1:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.CatchMatch exec.CatchMiss )
 
 lemma notStuck_CatchD2:
   "\<lbrakk>\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}; \<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow>Abrupt s'\<rbrakk>
    \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c2,Normal s'\<rangle> \<Rightarrow>\<notin>{Stuck}"
   by (auto simp add: final_notin_def dest: exec.CatchMatch)
 
 
 (* ************************************************************************* *)
 subsection "Miscellaneous"
 (* ************************************************************************* *)
 
 lemma execn_noguards_no_Fault:
  assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes noguards_c: "noguards c"
  assumes noguards_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noguards (the (\<Gamma> p))"
  assumes s_no_Fault: "\<not> isFault s"
  shows "\<not> isFault t"
   using execn noguards_c s_no_Fault
   proof (induct)
     case (Call p bdy n s t) with noguards_\<Gamma> show ?case
       apply -
       apply (drule bspec [where x=p])
       apply auto
       done
   qed (auto)
 
 lemma exec_noguards_no_Fault:
  assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes noguards_c: "noguards c"
  assumes noguards_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. noguards (the (\<Gamma> p))"
  assumes s_no_Fault: "\<not> isFault s"
  shows "\<not> isFault t"
   using exec noguards_c s_no_Fault
   proof (induct)
     case (Call p bdy s t) with noguards_\<Gamma> show ?case
       apply -
       apply (drule bspec [where x=p])
       apply auto
       done
   qed auto
 
 lemma execn_nothrows_no_Abrupt:
  assumes execn: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> =n\<Rightarrow> t"
  assumes nothrows_c: "nothrows c"
  assumes nothrows_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. nothrows (the (\<Gamma> p))"
  assumes s_no_Abrupt: "\<not>(isAbr s)"
  shows "\<not>(isAbr t)"
   using execn nothrows_c s_no_Abrupt
   proof (induct)
     case (Call p bdy n s t) with nothrows_\<Gamma> show ?case
       apply -
       apply (drule bspec [where x=p])
       apply auto
       done
   qed (auto)
 
 lemma exec_nothrows_no_Abrupt:
  assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
  assumes nothrows_c: "nothrows c"
  assumes nothrows_\<Gamma>: "\<forall>p \<in> dom \<Gamma>. nothrows (the (\<Gamma> p))"
  assumes s_no_Abrupt: "\<not>(isAbr s)"
  shows "\<not>(isAbr t)"
   using exec nothrows_c s_no_Abrupt
   proof (induct)
     case (Call p bdy s t) with nothrows_\<Gamma> show ?case
       apply -
       apply (drule bspec [where x=p])
       apply auto
       done
   qed (auto)
 
 end
diff --git a/thys/Simpl/Simpl.thy b/thys/Simpl/Simpl.thy
--- a/thys/Simpl/Simpl.thy
+++ b/thys/Simpl/Simpl.thy
@@ -1,45 +1,24 @@
 (*  Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Simpl.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 (*<*)
 theory Simpl
 imports
   StateSpace
   AlternativeSmallStep
   SyntaxTest
   "ex/VcgEx"
   "ex/VcgExSP"
   "ex/VcgExTotal"
   "ex/Quicksort"
   "ex/XVcgEx"
   "ex/ProcParEx"
   "ex/ProcParExSP"
   "ex/ClosureEx"
   "ex/ComposeEx"
   UserGuide
 begin
 end
 (*>*)
diff --git a/thys/Simpl/Simpl_Heap.thy b/thys/Simpl/Simpl_Heap.thy
--- a/thys/Simpl/Simpl_Heap.thy
+++ b/thys/Simpl/Simpl_Heap.thy
@@ -1,119 +1,98 @@
 (*  Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Heap.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 theory Simpl_Heap
 imports Main
 begin
 
 subsection "References"
 
 definition "ref = (UNIV::nat set)"
 
 typedef ref = ref by (simp add: ref_def)
 
 code_datatype Abs_ref
 
 lemma finite_nat_ex_max:
   assumes fin: "finite (N::nat set)"
   shows "\<exists>m. \<forall>n\<in>N. n < m"
 using fin
 proof (induct)
   case empty
   show ?case by auto
 next
   case (insert k N)
   have "\<exists>m. \<forall>n\<in>N. n < m" by fact
   then obtain m where m_max: "\<forall>n\<in>N. n < m"..
   show "\<exists>m. \<forall>n\<in>insert k N. n < m"
   proof (rule exI [where x="Suc (max k m)"])
   qed (insert m_max, auto simp add: max_def)
 qed
 
 lemma infinite_nat: "\<not>finite (UNIV::nat set)"
 proof
   assume fin: "finite (UNIV::nat set)"
   then obtain m::nat where "\<forall>n\<in>UNIV. n < m"
     by (rule finite_nat_ex_max [elim_format] ) auto
   moreover have "m\<in>UNIV"..
   ultimately show False by blast
 qed
 
 lemma infinite_ref [simp,intro]: "\<not>finite (UNIV::ref set)"
 proof
   assume "finite (UNIV::ref set)"
   hence "finite (range Rep_ref)"
     by simp
   moreover
   have "range Rep_ref = ref"
   proof
     show "range Rep_ref \<subseteq> ref"
       by (simp add: ref_def)
   next
     show "ref \<subseteq> range Rep_ref"
     proof
       fix x
       assume x: "x \<in> ref"
       show "x \<in> range Rep_ref"
         by (rule Rep_ref_induct) (auto simp add: ref_def)
     qed
   qed
   ultimately have "finite ref"
     by simp
   thus False
     by (simp add: ref_def infinite_nat)
 qed
 
 consts Null :: ref
 
 definition new :: "ref set \<Rightarrow> ref" where
   "new A = (SOME a. a \<notin> {Null} \<union> A)"
 
 text \<open>
   Constant @{const "Null"} can be defined later on.  Conceptually
   @{const "Null"} and @{const "new"} are \<open>fixes\<close> of a locale
   with @{prop "finite A \<Longrightarrow> new A \<notin> A \<union> {Null}"}.  But since definitions
   relative to a locale do not yet work in Isabelle2005 we use this
   workaround to avoid lots of parameters in definitions.
 \<close>
 
 lemma new_notin [simp,intro]:
  "finite A \<Longrightarrow> new (A) \<notin> A"
   apply (unfold new_def)
   apply (rule someI2_ex)
   apply (fastforce intro: ex_new_if_finite)
   apply simp
   done
 
 lemma new_not_Null [simp,intro]:
   "finite A \<Longrightarrow> new (A) \<noteq> Null"
   apply (unfold new_def)
   apply (rule someI2_ex)
   apply (fastforce intro: ex_new_if_finite)
   apply simp
 done
 
 end
diff --git a/thys/Simpl/SmallStep.thy b/thys/Simpl/SmallStep.thy
--- a/thys/Simpl/SmallStep.thy
+++ b/thys/Simpl/SmallStep.thy
@@ -1,3120 +1,3099 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      SmallStep.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>Small-Step Semantics and Infinite Computations\<close>
 
 theory SmallStep imports Termination
 begin
 
 text \<open>The redex of a statement is the substatement, which is actually altered
 by the next step in the small-step semantics.
 \<close>
 
 primrec redex:: "('s,'p,'f)com \<Rightarrow> ('s,'p,'f)com"
 where
 "redex Skip = Skip" |
 "redex (Basic f) = (Basic f)" |
 "redex (Spec r) = (Spec r)" |
 "redex (Seq c\<^sub>1 c\<^sub>2) = redex c\<^sub>1" |
 "redex (Cond b c\<^sub>1 c\<^sub>2) = (Cond b c\<^sub>1 c\<^sub>2)" |
 "redex (While b c) = (While b c)" |
 "redex (Call p) = (Call p)" |
 "redex (DynCom d) = (DynCom d)" |
 "redex (Guard f b c) = (Guard f b c)" |
 "redex (Throw) = Throw" |
 "redex (Catch c\<^sub>1 c\<^sub>2) = redex c\<^sub>1"
 
 
 subsection \<open>Small-Step Computation: \<open>\<Gamma>\<turnstile>(c, s) \<rightarrow> (c', s')\<close>\<close>
 
 type_synonym ('s,'p,'f) config = "('s,'p,'f)com  \<times> ('s,'f) xstate"
 inductive "step"::"[('s,'p,'f) body,('s,'p,'f) config,('s,'p,'f) config] \<Rightarrow> bool"
                                 ("_\<turnstile> (_ \<rightarrow>/ _)" [81,81,81] 100)
   for \<Gamma>::"('s,'p,'f) body"
 where
 
   Basic: "\<Gamma>\<turnstile>(Basic f,Normal s) \<rightarrow> (Skip,Normal (f s))"
 
 | Spec: "(s,t) \<in> r \<Longrightarrow> \<Gamma>\<turnstile>(Spec r,Normal s) \<rightarrow> (Skip,Normal t)"
 | SpecStuck: "\<forall>t. (s,t) \<notin> r \<Longrightarrow> \<Gamma>\<turnstile>(Spec r,Normal s) \<rightarrow> (Skip,Stuck)"
 
 | Guard: "s\<in>g \<Longrightarrow> \<Gamma>\<turnstile>(Guard f g c,Normal s) \<rightarrow> (c,Normal s)"
 
 | GuardFault: "s\<notin>g \<Longrightarrow> \<Gamma>\<turnstile>(Guard f g c,Normal s) \<rightarrow> (Skip,Fault f)"
 
 
 | Seq: "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s')
         \<Longrightarrow>
         \<Gamma>\<turnstile>(Seq c\<^sub>1 c\<^sub>2,s) \<rightarrow> (Seq c\<^sub>1' c\<^sub>2, s')"
 | SeqSkip: "\<Gamma>\<turnstile>(Seq Skip c\<^sub>2,s) \<rightarrow> (c\<^sub>2, s)"
 | SeqThrow: "\<Gamma>\<turnstile>(Seq Throw c\<^sub>2,Normal s) \<rightarrow> (Throw, Normal s)"
 
 | CondTrue:  "s\<in>b \<Longrightarrow> \<Gamma>\<turnstile>(Cond b c\<^sub>1 c\<^sub>2,Normal s) \<rightarrow> (c\<^sub>1,Normal s)"
 | CondFalse: "s\<notin>b \<Longrightarrow> \<Gamma>\<turnstile>(Cond b c\<^sub>1 c\<^sub>2,Normal s) \<rightarrow> (c\<^sub>2,Normal s)"
 
 | WhileTrue: "\<lbrakk>s\<in>b\<rbrakk>
               \<Longrightarrow>
               \<Gamma>\<turnstile>(While b c,Normal s) \<rightarrow> (Seq c (While b c),Normal s)"
 
 | WhileFalse: "\<lbrakk>s\<notin>b\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>(While b c,Normal s) \<rightarrow> (Skip,Normal s)"
 
 | Call: "\<Gamma> p=Some bdy \<Longrightarrow>
          \<Gamma>\<turnstile>(Call p,Normal s) \<rightarrow> (bdy,Normal s)"
 
 | CallUndefined: "\<Gamma> p=None \<Longrightarrow>
          \<Gamma>\<turnstile>(Call p,Normal s) \<rightarrow> (Skip,Stuck)"
 
 | DynCom: "\<Gamma>\<turnstile>(DynCom c,Normal s) \<rightarrow> (c s,Normal s)"
 
 | Catch: "\<lbrakk>\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s')\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2,s) \<rightarrow> (Catch c\<^sub>1' c\<^sub>2,s')"
 
 | CatchThrow: "\<Gamma>\<turnstile>(Catch Throw c\<^sub>2,Normal s) \<rightarrow> (c\<^sub>2,Normal s)"
 | CatchSkip: "\<Gamma>\<turnstile>(Catch Skip c\<^sub>2,s) \<rightarrow> (Skip,s)"
 
 | FaultProp:  "\<lbrakk>c\<noteq>Skip; redex c = c\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>(c,Fault f) \<rightarrow> (Skip,Fault f)"
 | StuckProp:  "\<lbrakk>c\<noteq>Skip; redex c = c\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>(c,Stuck) \<rightarrow> (Skip,Stuck)"
 | AbruptProp: "\<lbrakk>c\<noteq>Skip; redex c = c\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>(c,Abrupt f) \<rightarrow> (Skip,Abrupt f)"
 
 
 lemmas step_induct = step.induct [of _ "(c,s)" "(c',s')", split_format (complete), case_names
 Basic Spec SpecStuck Guard GuardFault Seq SeqSkip SeqThrow CondTrue CondFalse
 WhileTrue WhileFalse Call CallUndefined DynCom Catch CatchThrow CatchSkip
 FaultProp StuckProp AbruptProp, induct set]
 
 
 inductive_cases step_elim_cases [cases set]:
  "\<Gamma>\<turnstile>(Skip,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Guard f g c,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Basic f,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Spec r,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Seq c1 c2,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Cond b c1 c2,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(While b c,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Call p,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(DynCom c,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Throw,s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Catch c1 c2,s) \<rightarrow> u"
 
 inductive_cases step_Normal_elim_cases [cases set]:
  "\<Gamma>\<turnstile>(Skip,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Guard f g c,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Basic f,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Spec r,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Seq c1 c2,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Cond b c1 c2,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(While b c,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Call p,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(DynCom c,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Throw,Normal s) \<rightarrow> u"
  "\<Gamma>\<turnstile>(Catch c1 c2,Normal s) \<rightarrow> u"
 
 
 text \<open>The final configuration is either of the form \<open>(Skip,_)\<close> for normal
 termination, or @{term "(Throw,Normal s)"} in case the program was started in
 a @{term "Normal"} state and terminated abruptly. The @{const "Abrupt"} state is not used to
 model abrupt termination, in contrast to the big-step semantics. Only if the
 program starts in an @{const "Abrupt"} states it ends in the same @{term "Abrupt"}
 state.\<close>
 
 definition final:: "('s,'p,'f) config \<Rightarrow> bool" where
 "final cfg = (fst cfg=Skip \<or> (fst cfg=Throw \<and> (\<exists>s. snd cfg=Normal s)))"
 
 
 abbreviation
  "step_rtrancl" :: "[('s,'p,'f) body,('s,'p,'f) config,('s,'p,'f) config] \<Rightarrow> bool"
                                 ("_\<turnstile> (_ \<rightarrow>\<^sup>*/ _)" [81,81,81] 100)
  where
   "\<Gamma>\<turnstile>cf0 \<rightarrow>\<^sup>* cf1 \<equiv> (CONST step \<Gamma>)\<^sup>*\<^sup>* cf0 cf1"
 abbreviation
  "step_trancl" :: "[('s,'p,'f) body,('s,'p,'f) config,('s,'p,'f) config] \<Rightarrow> bool"
                                 ("_\<turnstile> (_ \<rightarrow>\<^sup>+/ _)" [81,81,81] 100)
  where
   "\<Gamma>\<turnstile>cf0 \<rightarrow>\<^sup>+ cf1 \<equiv> (CONST step \<Gamma>)\<^sup>+\<^sup>+ cf0 cf1"
 
 
 
 
 
 
 
 
 (* ************************************************************************ *)
 subsection \<open>Structural Properties of Small Step Computations\<close>
 (* ************************************************************************ *)
 
 lemma redex_not_Seq: "redex c = Seq c1 c2 \<Longrightarrow> P"
   apply (induct c)
   apply auto
   done
 
 lemma no_step_final:
   assumes step: "\<Gamma>\<turnstile>(c,s) \<rightarrow> (c',s')"
   shows "final (c,s) \<Longrightarrow> P"
 using step
 by induct (auto simp add: final_def)
 
 lemma no_step_final':
   assumes step: "\<Gamma>\<turnstile>cfg \<rightarrow> cfg'"
   shows "final cfg \<Longrightarrow> P"
 using step
   by (cases cfg, cases cfg') (auto intro: no_step_final)
 
 lemma step_Abrupt:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')"
   shows "\<And>x. s=Abrupt x \<Longrightarrow> s'=Abrupt x"
 using step
 by (induct) auto
 
 lemma step_Fault:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')"
   shows "\<And>f. s=Fault f \<Longrightarrow> s'=Fault f"
 using step
 by (induct) auto
 
 lemma step_Stuck:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')"
   shows "\<And>f. s=Stuck \<Longrightarrow> s'=Stuck"
 using step
 by (induct) auto
 
 lemma SeqSteps:
   assumes steps: "\<Gamma>\<turnstile>cfg\<^sub>1\<rightarrow>\<^sup>* cfg\<^sub>2"
   shows "\<And> c\<^sub>1 s c\<^sub>1' s'. \<lbrakk>cfg\<^sub>1 = (c\<^sub>1,s);cfg\<^sub>2=(c\<^sub>1',s')\<rbrakk>
           \<Longrightarrow> \<Gamma>\<turnstile>(Seq c\<^sub>1 c\<^sub>2,s) \<rightarrow>\<^sup>* (Seq c\<^sub>1' c\<^sub>2, s')"
 using steps
 proof (induct rule: converse_rtranclp_induct [case_names Refl Trans])
   case Refl
   thus ?case
     by simp
 next
   case (Trans cfg\<^sub>1 cfg'')
   have step: "\<Gamma>\<turnstile> cfg\<^sub>1 \<rightarrow> cfg''" by fact
   have steps: "\<Gamma>\<turnstile> cfg'' \<rightarrow>\<^sup>* cfg\<^sub>2" by fact
   have cfg\<^sub>1: "cfg\<^sub>1 = (c\<^sub>1, s)" and cfg\<^sub>2: "cfg\<^sub>2 = (c\<^sub>1', s')"  by fact+
   obtain c\<^sub>1'' s'' where cfg'': "cfg''=(c\<^sub>1'',s'')"
     by (cases cfg'') auto
   from step cfg\<^sub>1 cfg''
   have "\<Gamma>\<turnstile> (c\<^sub>1,s) \<rightarrow> (c\<^sub>1'',s'')"
     by simp
   hence "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2,s) \<rightarrow> (Seq c\<^sub>1'' c\<^sub>2,s'')"
     by (rule step.Seq)
   also from Trans.hyps (3) [OF cfg'' cfg\<^sub>2]
   have "\<Gamma>\<turnstile> (Seq c\<^sub>1'' c\<^sub>2, s'') \<rightarrow>\<^sup>* (Seq c\<^sub>1' c\<^sub>2, s')" .
   finally show ?case .
 qed
 
 
 lemma CatchSteps:
   assumes steps: "\<Gamma>\<turnstile>cfg\<^sub>1\<rightarrow>\<^sup>* cfg\<^sub>2"
   shows "\<And> c\<^sub>1 s c\<^sub>1' s'. \<lbrakk>cfg\<^sub>1 = (c\<^sub>1,s); cfg\<^sub>2=(c\<^sub>1',s')\<rbrakk>
           \<Longrightarrow> \<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2,s) \<rightarrow>\<^sup>* (Catch c\<^sub>1' c\<^sub>2, s')"
 using steps
 proof (induct rule: converse_rtranclp_induct [case_names Refl Trans])
   case Refl
   thus ?case
     by simp
 next
   case (Trans cfg\<^sub>1 cfg'')
   have step: "\<Gamma>\<turnstile> cfg\<^sub>1 \<rightarrow> cfg''" by fact
   have steps: "\<Gamma>\<turnstile> cfg'' \<rightarrow>\<^sup>* cfg\<^sub>2" by fact
   have cfg\<^sub>1: "cfg\<^sub>1 = (c\<^sub>1, s)" and cfg\<^sub>2: "cfg\<^sub>2 = (c\<^sub>1', s')"  by fact+
   obtain c\<^sub>1'' s'' where cfg'': "cfg''=(c\<^sub>1'',s'')"
     by (cases cfg'') auto
   from step cfg\<^sub>1 cfg''
   have s: "\<Gamma>\<turnstile> (c\<^sub>1,s) \<rightarrow> (c\<^sub>1'',s'')"
     by simp
   hence "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2,s) \<rightarrow> (Catch c\<^sub>1'' c\<^sub>2,s'')"
     by (rule step.Catch)
   also from Trans.hyps (3) [OF cfg'' cfg\<^sub>2]
   have "\<Gamma>\<turnstile> (Catch c\<^sub>1'' c\<^sub>2, s'') \<rightarrow>\<^sup>* (Catch c\<^sub>1' c\<^sub>2, s')" .
   finally show ?case .
 qed
 
 lemma steps_Fault: "\<Gamma>\<turnstile> (c, Fault f) \<rightarrow>\<^sup>* (Skip, Fault f)"
 proof (induct c)
   case (Seq c\<^sub>1 c\<^sub>2)
   have steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Fault f) \<rightarrow>\<^sup>* (Skip, Fault f)" by fact
   have steps_c\<^sub>2: "\<Gamma>\<turnstile> (c\<^sub>2, Fault f) \<rightarrow>\<^sup>* (Skip, Fault f)" by fact
   from SeqSteps [OF steps_c\<^sub>1 refl refl]
   have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Fault f) \<rightarrow>\<^sup>* (Seq Skip c\<^sub>2, Fault f)".
   also
   have "\<Gamma>\<turnstile> (Seq Skip c\<^sub>2, Fault f) \<rightarrow> (c\<^sub>2, Fault f)" by (rule SeqSkip)
   also note steps_c\<^sub>2
   finally show ?case by simp
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Fault f) \<rightarrow>\<^sup>* (Skip, Fault f)" by fact
   from CatchSteps [OF steps_c\<^sub>1 refl refl]
   have "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Fault f) \<rightarrow>\<^sup>* (Catch Skip c\<^sub>2, Fault f)".
   also
   have "\<Gamma>\<turnstile> (Catch Skip c\<^sub>2, Fault f) \<rightarrow> (Skip, Fault f)" by (rule CatchSkip)
   finally show ?case by simp
 qed (fastforce intro: step.intros)+
 
 lemma steps_Stuck: "\<Gamma>\<turnstile> (c, Stuck) \<rightarrow>\<^sup>* (Skip, Stuck)"
 proof (induct c)
   case (Seq c\<^sub>1 c\<^sub>2)
   have steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Stuck) \<rightarrow>\<^sup>* (Skip, Stuck)" by fact
   have steps_c\<^sub>2: "\<Gamma>\<turnstile> (c\<^sub>2, Stuck) \<rightarrow>\<^sup>* (Skip, Stuck)" by fact
   from SeqSteps [OF steps_c\<^sub>1 refl refl]
   have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Stuck) \<rightarrow>\<^sup>* (Seq Skip c\<^sub>2, Stuck)".
   also
   have "\<Gamma>\<turnstile> (Seq Skip c\<^sub>2, Stuck) \<rightarrow> (c\<^sub>2, Stuck)" by (rule SeqSkip)
   also note steps_c\<^sub>2
   finally show ?case by simp
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Stuck) \<rightarrow>\<^sup>* (Skip, Stuck)" by fact
   from CatchSteps [OF steps_c\<^sub>1 refl refl]
   have "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Stuck) \<rightarrow>\<^sup>* (Catch Skip c\<^sub>2, Stuck)" .
   also
   have "\<Gamma>\<turnstile> (Catch Skip c\<^sub>2, Stuck) \<rightarrow> (Skip, Stuck)" by (rule CatchSkip)
   finally show ?case by simp
 qed (fastforce intro: step.intros)+
 
 lemma steps_Abrupt: "\<Gamma>\<turnstile> (c, Abrupt s) \<rightarrow>\<^sup>* (Skip, Abrupt s)"
 proof (induct c)
   case (Seq c\<^sub>1 c\<^sub>2)
   have steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Abrupt s) \<rightarrow>\<^sup>* (Skip, Abrupt s)" by fact
   have steps_c\<^sub>2: "\<Gamma>\<turnstile> (c\<^sub>2, Abrupt s) \<rightarrow>\<^sup>* (Skip, Abrupt s)" by fact
   from SeqSteps [OF steps_c\<^sub>1 refl refl]
   have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Abrupt s) \<rightarrow>\<^sup>* (Seq Skip c\<^sub>2, Abrupt s)".
   also
   have "\<Gamma>\<turnstile> (Seq Skip c\<^sub>2, Abrupt s) \<rightarrow> (c\<^sub>2, Abrupt s)" by (rule SeqSkip)
   also note steps_c\<^sub>2
   finally show ?case by simp
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Abrupt s) \<rightarrow>\<^sup>* (Skip, Abrupt s)" by fact
   from CatchSteps [OF steps_c\<^sub>1 refl refl]
   have "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Abrupt s) \<rightarrow>\<^sup>* (Catch Skip c\<^sub>2, Abrupt s)".
   also
   have "\<Gamma>\<turnstile> (Catch Skip c\<^sub>2, Abrupt s) \<rightarrow> (Skip, Abrupt s)" by (rule CatchSkip)
   finally show ?case by simp
 qed (fastforce intro: step.intros)+
 
 lemma step_Fault_prop:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')"
   shows "\<And>f. s=Fault f \<Longrightarrow> s'=Fault f"
 using step
 by (induct) auto
 
 lemma step_Abrupt_prop:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')"
   shows "\<And>x. s=Abrupt x \<Longrightarrow> s'=Abrupt x"
 using step
 by (induct) auto
 
 lemma step_Stuck_prop:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')"
   shows "s=Stuck \<Longrightarrow> s'=Stuck"
 using step
 by (induct) auto
 
 lemma steps_Fault_prop:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>* (c', s')"
   shows "s=Fault f \<Longrightarrow> s'=Fault f"
 using step
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl thus ?case by simp
 next
   case (Trans c s c'' s'')
   thus ?case
     by (auto intro: step_Fault_prop)
 qed
 
 lemma steps_Abrupt_prop:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>* (c', s')"
   shows "s=Abrupt t \<Longrightarrow> s'=Abrupt t"
 using step
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl thus ?case by simp
 next
   case (Trans c s c'' s'')
   thus ?case
     by (auto intro: step_Abrupt_prop)
 qed
 
 lemma steps_Stuck_prop:
   assumes step: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>* (c', s')"
   shows "s=Stuck \<Longrightarrow> s'=Stuck"
 using step
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl thus ?case by simp
 next
   case (Trans c s c'' s'')
   thus ?case
     by (auto intro: step_Stuck_prop)
 qed
 
 (* ************************************************************************ *)
 subsection \<open>Equivalence between Small-Step and Big-Step Semantics\<close>
 (* ************************************************************************ *)
 
 theorem exec_impl_steps:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>c' t'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (c',t') \<and>
                (case t of
                  Abrupt x \<Rightarrow> if s=t then c'=Skip \<and> t'=t else c'=Throw \<and> t'=Normal x
                 | _ \<Rightarrow> c'=Skip \<and> t'=t)"
 using exec
 proof (induct)
   case Skip thus ?case
     by simp
 next
   case Guard thus ?case by (blast intro: step.Guard rtranclp_trans)
 next
   case GuardFault thus ?case by (fastforce intro: step.GuardFault rtranclp_trans)
 next
   case FaultProp show ?case by (fastforce intro: steps_Fault)
 next
   case Basic thus ?case by (fastforce intro: step.Basic rtranclp_trans)
 next
   case Spec thus ?case by (fastforce intro: step.Spec rtranclp_trans)
 next
   case SpecStuck thus ?case by (fastforce intro: step.SpecStuck rtranclp_trans)
 next
   case (Seq c\<^sub>1 s s' c\<^sub>2 t)
   have exec_c\<^sub>1: "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> s'" by fact
   have exec_c\<^sub>2: "\<Gamma>\<turnstile> \<langle>c\<^sub>2,s'\<rangle> \<Rightarrow> t" by fact
   show ?case
   proof (cases "\<exists>x. s'=Abrupt x")
     case False
     from False Seq.hyps (2)
     have "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow>\<^sup>* (Skip, s')"
       by (cases s') auto
     hence seq_c\<^sub>1: "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow>\<^sup>* (Seq Skip c\<^sub>2, s')"
       by (rule SeqSteps) auto
     from Seq.hyps (4) obtain c' t' where
       steps_c\<^sub>2: "\<Gamma>\<turnstile> (c\<^sub>2, s') \<rightarrow>\<^sup>* (c', t')" and
       t: "(case t of
            Abrupt x \<Rightarrow> if s' = t then c' = Skip \<and> t' = t
                        else c' = Throw \<and> t' = Normal x
            | _ \<Rightarrow> c' = Skip \<and> t' = t)"
       by auto
     note seq_c\<^sub>1
     also have "\<Gamma>\<turnstile> (Seq Skip c\<^sub>2, s') \<rightarrow> (c\<^sub>2, s')" by (rule step.SeqSkip)
     also note steps_c\<^sub>2
     finally have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow>\<^sup>* (c', t')".
     with t False show ?thesis
       by (cases t) auto
   next
     case True
     then obtain x where s': "s'=Abrupt x"
       by blast
     from s' Seq.hyps (2)
     have "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow>\<^sup>* (Throw, Normal x)"
       by auto
     hence seq_c\<^sub>1: "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow>\<^sup>* (Seq Throw c\<^sub>2, Normal x)"
       by (rule SeqSteps) auto
     also have "\<Gamma>\<turnstile> (Seq Throw c\<^sub>2, Normal x) \<rightarrow> (Throw, Normal x)"
       by (rule SeqThrow)
     finally have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow>\<^sup>* (Throw, Normal x)".
     moreover
     from exec_c\<^sub>2 s' have "t=Abrupt x"
       by (auto intro: Abrupt_end)
     ultimately show ?thesis
       by auto
   qed
 next
   case CondTrue thus ?case by (blast intro: step.CondTrue rtranclp_trans)
 next
   case CondFalse thus ?case by (blast intro: step.CondFalse rtranclp_trans)
 next
   case (WhileTrue s b c s' t)
   have exec_c: "\<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow> s'" by fact
   have exec_w: "\<Gamma>\<turnstile> \<langle>While b c,s'\<rangle> \<Rightarrow> t" by fact
   have b: "s \<in> b" by fact
   hence step: "\<Gamma>\<turnstile> (While b c,Normal s) \<rightarrow> (Seq c (While b c),Normal s)"
     by (rule step.WhileTrue)
   show ?case
   proof (cases "\<exists>x. s'=Abrupt x")
     case False
     from False WhileTrue.hyps (3)
     have "\<Gamma>\<turnstile> (c, Normal s) \<rightarrow>\<^sup>* (Skip, s')"
       by (cases s') auto
     hence seq_c: "\<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow>\<^sup>* (Seq Skip (While b c), s')"
       by (rule SeqSteps) auto
     from WhileTrue.hyps (5) obtain c' t' where
       steps_c\<^sub>2: "\<Gamma>\<turnstile> (While b c, s') \<rightarrow>\<^sup>* (c', t')" and
       t: "(case t of
            Abrupt x \<Rightarrow> if s' = t then c' = Skip \<and> t' = t
                        else c' = Throw \<and> t' = Normal x
            | _ \<Rightarrow> c' = Skip \<and> t' = t)"
       by auto
     note step also note seq_c
     also have "\<Gamma>\<turnstile> (Seq Skip (While b c), s') \<rightarrow> (While b c, s')"
       by (rule step.SeqSkip)
     also note steps_c\<^sub>2
     finally have "\<Gamma>\<turnstile> (While b c, Normal s) \<rightarrow>\<^sup>* (c', t')".
     with t False show ?thesis
       by (cases t) auto
   next
     case True
     then obtain x where s': "s'=Abrupt x"
       by blast
     note step
     also
     from s' WhileTrue.hyps (3)
     have "\<Gamma>\<turnstile> (c, Normal s) \<rightarrow>\<^sup>* (Throw, Normal x)"
       by auto
     hence
       seq_c: "\<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow>\<^sup>* (Seq Throw (While b c), Normal x)"
       by (rule SeqSteps) auto
     also have "\<Gamma>\<turnstile> (Seq Throw (While b c), Normal x) \<rightarrow> (Throw, Normal x)"
       by (rule SeqThrow)
     finally have "\<Gamma>\<turnstile> (While b c, Normal s) \<rightarrow>\<^sup>* (Throw, Normal x)".
     moreover
     from exec_w s' have "t=Abrupt x"
       by (auto intro: Abrupt_end)
     ultimately show ?thesis
       by auto
   qed
 next
   case WhileFalse thus ?case by (fastforce intro: step.WhileFalse rtrancl_trans)
 next
   case Call thus ?case by (blast intro: step.Call rtranclp_trans)
 next
   case CallUndefined thus ?case by (fastforce intro: step.CallUndefined rtranclp_trans)
 next
   case StuckProp thus ?case by (fastforce intro: steps_Stuck)
 next
   case DynCom thus ?case by (blast intro: step.DynCom rtranclp_trans)
 next
    case Throw thus ?case by simp
 next
   case AbruptProp thus ?case by (fastforce intro: steps_Abrupt)
 next
   case (CatchMatch c\<^sub>1 s s' c\<^sub>2 t)
   from CatchMatch.hyps (2)
   have "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow>\<^sup>* (Throw, Normal s')"
     by simp
   hence "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow>\<^sup>* (Catch Throw c\<^sub>2, Normal s')"
     by (rule CatchSteps) auto
   also have "\<Gamma>\<turnstile> (Catch Throw c\<^sub>2, Normal s') \<rightarrow> (c\<^sub>2, Normal s')"
     by (rule step.CatchThrow)
   also
   from CatchMatch.hyps (4) obtain c' t' where
       steps_c\<^sub>2: "\<Gamma>\<turnstile> (c\<^sub>2, Normal s') \<rightarrow>\<^sup>* (c', t')" and
       t: "(case t of
            Abrupt x \<Rightarrow> if Normal s' = t then c' = Skip \<and> t' = t
                        else c' = Throw \<and> t' = Normal x
            | _ \<Rightarrow> c' = Skip \<and> t' = t)"
       by auto
   note steps_c\<^sub>2
   finally show ?case
     using t
     by (auto split: xstate.splits)
 next
   case (CatchMiss c\<^sub>1 s t c\<^sub>2)
   have t: "\<not> isAbr t" by fact
   with CatchMiss.hyps (2)
   have "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow>\<^sup>* (Skip, t)"
     by (cases t) auto
   hence "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow>\<^sup>* (Catch Skip c\<^sub>2, t)"
     by (rule CatchSteps) auto
   also
   have "\<Gamma>\<turnstile> (Catch Skip c\<^sub>2, t) \<rightarrow> (Skip, t)"
     by (rule step.CatchSkip)
   finally show ?case
     using t
     by (fastforce split: xstate.splits)
 qed
 
 corollary exec_impl_steps_Normal:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Normal t"
   shows "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (Skip, Normal t)"
 using exec_impl_steps [OF exec]
 by auto
 
 corollary exec_impl_steps_Normal_Abrupt:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Abrupt t"
   shows "\<Gamma>\<turnstile>(c,Normal s) \<rightarrow>\<^sup>* (Throw, Normal t)"
 using exec_impl_steps [OF exec]
 by auto
 
 corollary exec_impl_steps_Abrupt_Abrupt:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,Abrupt t\<rangle> \<Rightarrow> Abrupt t"
   shows "\<Gamma>\<turnstile>(c,Abrupt t) \<rightarrow>\<^sup>* (Skip, Abrupt t)"
 using exec_impl_steps [OF exec]
 by auto
 
 corollary exec_impl_steps_Fault:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f"
   shows "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (Skip, Fault f)"
 using exec_impl_steps [OF exec]
 by auto
 
 corollary exec_impl_steps_Stuck:
   assumes exec: "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Stuck"
   shows "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (Skip, Stuck)"
 using exec_impl_steps [OF exec]
 by auto
 
 
 lemma step_Abrupt_end:
   assumes step: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c\<^sub>1', s')"
   shows "s'=Abrupt x \<Longrightarrow> s=Abrupt x"
 using step
 by induct auto
 
 lemma step_Stuck_end:
   assumes step: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c\<^sub>1', s')"
   shows "s'=Stuck \<Longrightarrow>
           s=Stuck \<or>
           (\<exists>r x. redex c\<^sub>1 = Spec r \<and> s=Normal x \<and> (\<forall>t. (x,t)\<notin>r)) \<or>
           (\<exists>p x. redex c\<^sub>1=Call p \<and> s=Normal x \<and> \<Gamma> p = None)"
 using step
 by induct auto
 
 lemma step_Fault_end:
   assumes step: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c\<^sub>1', s')"
   shows "s'=Fault f \<Longrightarrow>
           s=Fault f \<or>
           (\<exists>g c x. redex c\<^sub>1 = Guard f g c \<and> s=Normal x \<and> x \<notin> g)"
 using step
 by induct auto
 
 lemma exec_redex_Stuck:
 "\<Gamma>\<turnstile>\<langle>redex c,s\<rangle> \<Rightarrow> Stuck \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Stuck"
 proof (induct c)
   case Seq
   thus ?case
     by (cases s) (auto intro: exec.intros elim:exec_elim_cases)
 next
   case Catch
   thus ?case
     by (cases s) (auto intro: exec.intros elim:exec_elim_cases)
 qed simp_all
 
 lemma exec_redex_Fault:
 "\<Gamma>\<turnstile>\<langle>redex c,s\<rangle> \<Rightarrow> Fault f \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Fault f"
 proof (induct c)
   case Seq
   thus ?case
     by (cases s) (auto intro: exec.intros elim:exec_elim_cases)
 next
   case Catch
   thus ?case
     by (cases s) (auto intro: exec.intros elim:exec_elim_cases)
 qed simp_all
 
 lemma step_extend:
   assumes step: "\<Gamma>\<turnstile>(c,s) \<rightarrow> (c', s')"
   shows "\<And>t. \<Gamma>\<turnstile>\<langle>c',s'\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 using step
 proof (induct)
   case Basic thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case Spec thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case SpecStuck thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case Guard thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case GuardFault thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case (Seq c\<^sub>1 s c\<^sub>1' s' c\<^sub>2)
   have step: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c\<^sub>1', s')" by fact
   have exec': "\<Gamma>\<turnstile> \<langle>Seq c\<^sub>1' c\<^sub>2,s'\<rangle> \<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Normal x)
     note s_Normal = this
     show ?thesis
     proof (cases s')
       case (Normal x')
       from exec' [simplified Normal] obtain s'' where
         exec_c\<^sub>1': "\<Gamma>\<turnstile> \<langle>c\<^sub>1',Normal x'\<rangle> \<Rightarrow> s''" and
         exec_c\<^sub>2: "\<Gamma>\<turnstile> \<langle>c\<^sub>2,s''\<rangle> \<Rightarrow> t"
         by cases
       from Seq.hyps (2) Normal exec_c\<^sub>1' s_Normal
       have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> s''"
         by simp
       from exec.Seq [OF this exec_c\<^sub>2] s_Normal
       show ?thesis by simp
     next
       case (Abrupt x')
       with exec' have "t=Abrupt x'"
         by (auto intro:Abrupt_end)
       moreover
       from step Abrupt
       have "s=Abrupt x'"
         by (auto intro: step_Abrupt_end)
       ultimately
       show ?thesis
         by (auto intro: exec.intros)
     next
       case (Fault f)
       from step_Fault_end [OF step this] s_Normal
       obtain g c where
         redex_c\<^sub>1: "redex c\<^sub>1 = Guard f g c" and
         fail: "x \<notin> g"
         by auto
       hence "\<Gamma>\<turnstile> \<langle>redex c\<^sub>1,Normal x\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec.intros)
       from exec_redex_Fault [OF this]
       have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Fault f".
       moreover from Fault exec' have "t=Fault f"
         by (auto intro: Fault_end)
       ultimately
       show ?thesis
         using s_Normal
         by (auto intro: exec.intros)
     next
       case Stuck
       from step_Stuck_end [OF step this] s_Normal
       have "(\<exists>r. redex c\<^sub>1 = Spec r \<and> (\<forall>t. (x, t) \<notin> r)) \<or>
             (\<exists>p. redex c\<^sub>1 = Call p \<and> \<Gamma> p = None)"
         by auto
       moreover
       {
         fix r
         assume "redex c\<^sub>1 = Spec r" and "(\<forall>t. (x, t) \<notin> r)"
         hence "\<Gamma>\<turnstile> \<langle>redex c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck"
           by (auto intro: exec.intros)
         from exec_redex_Stuck [OF this]
         have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck".
         moreover from Stuck exec' have "t=Stuck"
           by (auto intro: Stuck_end)
         ultimately
         have ?thesis
           using s_Normal
           by (auto intro: exec.intros)
       }
       moreover
       {
         fix p
         assume "redex c\<^sub>1 = Call p" and "\<Gamma> p = None"
         hence "\<Gamma>\<turnstile> \<langle>redex c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck"
           by (auto intro: exec.intros)
         from exec_redex_Stuck [OF this]
         have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck".
         moreover from Stuck exec' have "t=Stuck"
           by (auto intro: Stuck_end)
         ultimately
         have ?thesis
           using s_Normal
           by (auto intro: exec.intros)
       }
       ultimately show ?thesis
         by auto
     qed
   next
     case (Abrupt x)
     from step_Abrupt [OF step this]
     have "s'=Abrupt x".
     with exec'
     have "t=Abrupt x"
       by (auto intro: Abrupt_end)
     with Abrupt
     show ?thesis
       by (auto intro: exec.intros)
   next
     case (Fault f)
     from step_Fault [OF step this]
     have "s'=Fault f".
     with exec'
     have "t=Fault f"
       by (auto intro: Fault_end)
     with Fault
     show ?thesis
       by (auto intro: exec.intros)
   next
     case Stuck
     from step_Stuck [OF step this]
     have "s'=Stuck".
     with exec'
     have "t=Stuck"
       by (auto intro: Stuck_end)
     with Stuck
     show ?thesis
       by (auto intro: exec.intros)
   qed
 next
   case (SeqSkip c\<^sub>2 s t) thus ?case
     by (cases s) (fastforce intro: exec.intros elim: exec_elim_cases)+
 next
   case (SeqThrow c\<^sub>2 s t) thus ?case
     by (fastforce intro: exec.intros elim: exec_elim_cases)+
 next
   case CondTrue thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case CondFalse thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case WhileTrue thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case WhileFalse thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case Call thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case CallUndefined thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case DynCom thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case (Catch c\<^sub>1 s c\<^sub>1' s' c\<^sub>2 t)
   have step: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c\<^sub>1', s')" by fact
   have exec': "\<Gamma>\<turnstile> \<langle>Catch c\<^sub>1' c\<^sub>2,s'\<rangle> \<Rightarrow> t" by fact
   show ?case
   proof (cases s)
     case (Normal x)
     note s_Normal = this
     show ?thesis
     proof (cases s')
       case (Normal x')
       from exec' [simplified Normal]
       show ?thesis
       proof (cases)
         fix s''
         assume exec_c\<^sub>1': "\<Gamma>\<turnstile> \<langle>c\<^sub>1',Normal x'\<rangle> \<Rightarrow> Abrupt s''"
         assume exec_c\<^sub>2: "\<Gamma>\<turnstile> \<langle>c\<^sub>2,Normal s''\<rangle> \<Rightarrow> t"
         from Catch.hyps (2) Normal exec_c\<^sub>1' s_Normal
         have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Abrupt s''"
           by simp
         from exec.CatchMatch [OF this exec_c\<^sub>2] s_Normal
         show ?thesis by simp
       next
         assume exec_c\<^sub>1': "\<Gamma>\<turnstile> \<langle>c\<^sub>1',Normal x'\<rangle> \<Rightarrow> t"
         assume t: "\<not> isAbr t"
         from Catch.hyps (2) Normal exec_c\<^sub>1' s_Normal
         have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> t"
           by simp
         from exec.CatchMiss [OF this t] s_Normal
         show ?thesis by simp
       qed
     next
       case (Abrupt x')
       with exec' have "t=Abrupt x'"
         by (auto intro:Abrupt_end)
       moreover
       from step Abrupt
       have "s=Abrupt x'"
         by (auto intro: step_Abrupt_end)
       ultimately
       show ?thesis
         by (auto intro: exec.intros)
     next
       case (Fault f)
       from step_Fault_end [OF step this] s_Normal
       obtain g c where
         redex_c\<^sub>1: "redex c\<^sub>1 = Guard f g c" and
         fail: "x \<notin> g"
         by auto
       hence "\<Gamma>\<turnstile> \<langle>redex c\<^sub>1,Normal x\<rangle> \<Rightarrow> Fault f"
         by (auto intro: exec.intros)
       from exec_redex_Fault [OF this]
       have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Fault f".
       moreover from Fault exec' have "t=Fault f"
         by (auto intro: Fault_end)
       ultimately
       show ?thesis
         using s_Normal
         by (auto intro: exec.intros)
     next
       case Stuck
       from step_Stuck_end [OF step this] s_Normal
       have "(\<exists>r. redex c\<^sub>1 = Spec r \<and> (\<forall>t. (x, t) \<notin> r)) \<or>
             (\<exists>p. redex c\<^sub>1 = Call p \<and> \<Gamma> p = None)"
         by auto
       moreover
       {
         fix r
         assume "redex c\<^sub>1 = Spec r" and "(\<forall>t. (x, t) \<notin> r)"
         hence "\<Gamma>\<turnstile> \<langle>redex c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck"
           by (auto intro: exec.intros)
         from exec_redex_Stuck [OF this]
         have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck".
         moreover from Stuck exec' have "t=Stuck"
           by (auto intro: Stuck_end)
         ultimately
         have ?thesis
           using s_Normal
           by (auto intro: exec.intros)
       }
       moreover
       {
         fix p
         assume "redex c\<^sub>1 = Call p" and "\<Gamma> p = None"
         hence "\<Gamma>\<turnstile> \<langle>redex c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck"
           by (auto intro: exec.intros)
         from exec_redex_Stuck [OF this]
         have "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal x\<rangle> \<Rightarrow> Stuck".
         moreover from Stuck exec' have "t=Stuck"
           by (auto intro: Stuck_end)
         ultimately
         have ?thesis
           using s_Normal
           by (auto intro: exec.intros)
       }
       ultimately show ?thesis
         by auto
     qed
   next
     case (Abrupt x)
     from step_Abrupt [OF step this]
     have "s'=Abrupt x".
     with exec'
     have "t=Abrupt x"
       by (auto intro: Abrupt_end)
     with Abrupt
     show ?thesis
       by (auto intro: exec.intros)
   next
     case (Fault f)
     from step_Fault [OF step this]
     have "s'=Fault f".
     with exec'
     have "t=Fault f"
       by (auto intro: Fault_end)
     with Fault
     show ?thesis
       by (auto intro: exec.intros)
   next
     case Stuck
     from step_Stuck [OF step this]
     have "s'=Stuck".
     with exec'
     have "t=Stuck"
       by (auto intro: Stuck_end)
     with Stuck
     show ?thesis
       by (auto intro: exec.intros)
   qed
 next
   case CatchThrow thus ?case
     by (fastforce intro: exec.intros elim: exec_Normal_elim_cases)
 next
   case CatchSkip thus ?case
     by (fastforce intro: exec.intros elim: exec_elim_cases)
 next
   case FaultProp thus ?case
     by (fastforce intro: exec.intros elim: exec_elim_cases)
 next
   case StuckProp thus ?case
     by (fastforce intro: exec.intros elim: exec_elim_cases)
 next
   case AbruptProp thus ?case
     by (fastforce intro: exec.intros elim: exec_elim_cases)
 qed
 
 theorem steps_Skip_impl_exec:
   assumes steps: "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (Skip,t)"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 using steps
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl thus ?case
     by (cases t) (auto intro: exec.intros)
 next
   case (Trans c s c' s')
   have "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')" and "\<Gamma>\<turnstile> \<langle>c',s'\<rangle> \<Rightarrow> t" by fact+
   thus ?case
     by (rule step_extend)
 qed
 
 theorem steps_Throw_impl_exec:
   assumes steps: "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (Throw,Normal t)"
   shows "\<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> Abrupt t"
 using steps
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl thus ?case
     by (auto intro: exec.intros)
 next
   case (Trans c s c' s')
   have "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s')" and "\<Gamma>\<turnstile> \<langle>c',s'\<rangle> \<Rightarrow> Abrupt t" by fact+
   thus ?case
     by (rule step_extend)
 qed
 
 (* ************************************************************************ *)
 subsection \<open>Infinite Computations: \<open>\<Gamma>\<turnstile>(c, s) \<rightarrow> \<dots>(\<infinity>)\<close>\<close>
 (* ************************************************************************ *)
 
 definition inf:: "('s,'p,'f) body \<Rightarrow> ('s,'p,'f) config \<Rightarrow> bool"
  ("_\<turnstile> _ \<rightarrow> \<dots>'(\<infinity>')" [60,80] 100) where
 "\<Gamma>\<turnstile> cfg \<rightarrow> \<dots>(\<infinity>) \<equiv> (\<exists>f. f (0::nat) = cfg \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (i+1)))"
 
 lemma not_infI: "\<lbrakk>\<And>f. \<lbrakk>f 0 = cfg; \<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)\<rbrakk> \<Longrightarrow> False\<rbrakk>
                 \<Longrightarrow> \<not>\<Gamma>\<turnstile> cfg \<rightarrow> \<dots>(\<infinity>)"
   by (auto simp add: inf_def)
 
 (* ************************************************************************ *)
 subsection \<open>Equivalence between Termination and the Absence of Infinite Computations\<close>
 (* ************************************************************************ *)
 
 
 lemma step_preserves_termination:
   assumes step: "\<Gamma>\<turnstile>(c,s) \<rightarrow> (c',s')"
   shows "\<Gamma>\<turnstile>c\<down>s \<Longrightarrow> \<Gamma>\<turnstile>c'\<down>s'"
 using step
 proof (induct)
   case Basic thus ?case by (fastforce intro: terminates.intros)
 next
   case Spec thus ?case by (fastforce intro: terminates.intros)
 next
   case SpecStuck thus ?case by (fastforce intro: terminates.intros)
 next
   case Guard thus ?case
     by (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case GuardFault thus ?case by (fastforce intro: terminates.intros)
 next
   case (Seq c\<^sub>1 s c\<^sub>1' s' c\<^sub>2) thus ?case
     apply (cases s)
     apply     (cases s')
     apply         (fastforce intro: terminates.intros step_extend
                     elim: terminates_Normal_elim_cases)
     apply (fastforce intro: terminates.intros dest: step_Abrupt_prop
       step_Fault_prop step_Stuck_prop)+
     done
 next
   case (SeqSkip c\<^sub>2 s)
   thus ?case
     apply (cases s)
     apply (fastforce intro: terminates.intros exec.intros
             elim: terminates_Normal_elim_cases )+
     done
 next
   case (SeqThrow c\<^sub>2 s)
   thus ?case
     by (fastforce intro: terminates.intros exec.intros
             elim: terminates_Normal_elim_cases )
 next
   case CondTrue
   thus ?case
     by (fastforce intro: terminates.intros exec.intros
             elim: terminates_Normal_elim_cases )
 next
   case CondFalse
   thus ?case
     by (fastforce intro: terminates.intros
             elim: terminates_Normal_elim_cases )
 next
   case WhileTrue
   thus ?case
     by (fastforce intro: terminates.intros
             elim: terminates_Normal_elim_cases )
 next
   case WhileFalse
   thus ?case
     by (fastforce intro: terminates.intros
             elim: terminates_Normal_elim_cases )
 next
   case Call
   thus ?case
     by (fastforce intro: terminates.intros
             elim: terminates_Normal_elim_cases )
 next
   case CallUndefined
   thus ?case
     by (fastforce intro: terminates.intros
             elim: terminates_Normal_elim_cases )
 next
   case DynCom
   thus ?case
     by (fastforce intro: terminates.intros
             elim: terminates_Normal_elim_cases )
 next
   case (Catch c\<^sub>1 s c\<^sub>1' s' c\<^sub>2) thus ?case
     apply (cases s)
     apply     (cases s')
     apply         (fastforce intro: terminates.intros step_extend
                     elim: terminates_Normal_elim_cases)
     apply (fastforce intro: terminates.intros dest: step_Abrupt_prop
       step_Fault_prop step_Stuck_prop)+
     done
 next
   case CatchThrow
   thus ?case
    by (fastforce intro: terminates.intros exec.intros
             elim: terminates_Normal_elim_cases )
 next
   case (CatchSkip c\<^sub>2 s)
   thus ?case
     by (cases s) (fastforce intro: terminates.intros)+
 next
   case FaultProp thus ?case by (fastforce intro: terminates.intros)
 next
   case StuckProp thus ?case by (fastforce intro: terminates.intros)
 next
   case AbruptProp thus ?case by (fastforce intro: terminates.intros)
 qed
 
 lemma steps_preserves_termination:
   assumes steps: "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (c',s')"
   shows "\<Gamma>\<turnstile>c\<down>s \<Longrightarrow> \<Gamma>\<turnstile>c'\<down>s'"
 using steps
 proof (induct rule: rtranclp_induct2 [consumes 1, case_names Refl Trans])
   case Refl thus ?case  .
 next
   case Trans
   thus ?case
     by (blast dest: step_preserves_termination)
 qed
 
 ML \<open>
   ML_Thms.bind_thm ("tranclp_induct2", Split_Rule.split_rule @{context}
     (Rule_Insts.read_instantiate @{context}
       [((("a", 0), Position.none), "(aa,ab)"), ((("b", 0), Position.none), "(ba,bb)")] []
       @{thm tranclp_induct}));
 \<close>
 
 lemma steps_preserves_termination':
   assumes steps: "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>+ (c',s')"
   shows "\<Gamma>\<turnstile>c\<down>s \<Longrightarrow> \<Gamma>\<turnstile>c'\<down>s'"
 using steps
 proof (induct rule: tranclp_induct2 [consumes 1, case_names Step Trans])
   case Step thus ?case by (blast intro: step_preserves_termination)
 next
   case Trans
   thus ?case
     by (blast dest: step_preserves_termination)
 qed
 
 
 
 definition head_com:: "('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
 where
 "head_com c =
   (case c of
      Seq c\<^sub>1 c\<^sub>2 \<Rightarrow> c\<^sub>1
    | Catch c\<^sub>1 c\<^sub>2 \<Rightarrow> c\<^sub>1
    | _ \<Rightarrow> c)"
 
 
 definition head:: "('s,'p,'f) config \<Rightarrow> ('s,'p,'f) config"
   where "head cfg = (head_com (fst cfg), snd cfg)"
 
 lemma le_Suc_cases: "\<lbrakk>\<And>i. \<lbrakk>i < k\<rbrakk> \<Longrightarrow> P i; P k\<rbrakk> \<Longrightarrow> \<forall>i<(Suc k). P i"
   apply clarify
   apply (case_tac "i=k")
   apply auto
   done
 
 lemma redex_Seq_False: "\<And>c' c''. (redex c = Seq c'' c') = False"
   by (induct c) auto
 
 lemma redex_Catch_False: "\<And>c' c''. (redex c = Catch c'' c') = False"
   by (induct c) auto
 
 
 lemma infinite_computation_extract_head_Seq:
   assumes inf_comp: "\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow> f (i+1)"
   assumes f_0: "f 0 = (Seq c\<^sub>1 c\<^sub>2,s)"
   assumes not_fin: "\<forall>i<k. \<not> final (head (f i))"
   shows "\<forall>i<k. (\<exists>c' s'. f (i + 1) = (Seq c' c\<^sub>2, s')) \<and>
                \<Gamma>\<turnstile>head (f i) \<rightarrow> head (f (i+1))"
         (is "\<forall>i<k. ?P i")
 using not_fin
 proof (induct k)
   case 0
   show ?case by simp
 next
   case (Suc k)
   have not_fin_Suc:
     "\<forall>i<Suc k. \<not> final (head (f i))" by fact
   from this[rule_format] have not_fin_k:
     "\<forall>i<k. \<not> final (head (f i))"
     apply clarify
     apply (subgoal_tac "i < Suc k")
     apply blast
     apply simp
     done
 
   from Suc.hyps [OF this]
   have hyp: "\<forall>i<k. (\<exists>c' s'. f (i + 1) = (Seq c' c\<^sub>2, s')) \<and>
                    \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))".
   show ?case
   proof (rule le_Suc_cases)
     fix i
     assume "i < k"
     then show "?P i"
       by (rule hyp [rule_format])
   next
     show "?P k"
     proof -
       from hyp [rule_format, of "k - 1"] f_0
       obtain c' fs' L' s' where  f_k: "f k = (Seq c' c\<^sub>2, s')"
         by (cases k) auto
       from inf_comp [rule_format, of k] f_k
       have "\<Gamma>\<turnstile>(Seq c' c\<^sub>2, s') \<rightarrow> f (k + 1)"
         by simp
       moreover
       from not_fin_Suc [rule_format, of k] f_k
       have "\<not> final (c',s')"
         by (simp add: final_def head_def head_com_def)
       ultimately
       obtain c'' s'' where
          "\<Gamma>\<turnstile>(c', s') \<rightarrow> (c'', s'')" and
          "f (k + 1) = (Seq c'' c\<^sub>2, s'')"
         by cases (auto simp add: redex_Seq_False final_def)
       with f_k
       show ?thesis
         by (simp add: head_def head_com_def)
     qed
   qed
 qed
 
 lemma infinite_computation_extract_head_Catch:
   assumes inf_comp: "\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow> f (i+1)"
   assumes f_0: "f 0 = (Catch c\<^sub>1 c\<^sub>2,s)"
   assumes not_fin: "\<forall>i<k. \<not> final (head (f i))"
   shows "\<forall>i<k. (\<exists>c' s'. f (i + 1) = (Catch c' c\<^sub>2, s')) \<and>
                \<Gamma>\<turnstile>head (f i) \<rightarrow> head (f (i+1))"
         (is "\<forall>i<k. ?P i")
 using not_fin
 proof (induct k)
   case 0
   show ?case by simp
 next
   case (Suc k)
   have not_fin_Suc:
     "\<forall>i<Suc k. \<not> final (head (f i))" by fact
   from this[rule_format] have not_fin_k:
     "\<forall>i<k. \<not> final (head (f i))"
     apply clarify
     apply (subgoal_tac "i < Suc k")
     apply blast
     apply simp
     done
 
   from Suc.hyps [OF this]
   have hyp: "\<forall>i<k. (\<exists>c' s'. f (i + 1) = (Catch c' c\<^sub>2, s')) \<and>
                    \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))".
   show ?case
   proof (rule le_Suc_cases)
     fix i
     assume "i < k"
     then show "?P i"
       by (rule hyp [rule_format])
   next
     show "?P k"
     proof -
       from hyp [rule_format, of "k - 1"] f_0
       obtain c' fs' L' s' where  f_k: "f k = (Catch c' c\<^sub>2, s')"
         by (cases k) auto
       from inf_comp [rule_format, of k] f_k
       have "\<Gamma>\<turnstile>(Catch c' c\<^sub>2, s') \<rightarrow> f (k + 1)"
         by simp
       moreover
       from not_fin_Suc [rule_format, of k] f_k
       have "\<not> final (c',s')"
         by (simp add: final_def head_def head_com_def)
       ultimately
       obtain c'' s'' where
          "\<Gamma>\<turnstile>(c', s') \<rightarrow> (c'', s'')" and
          "f (k + 1) = (Catch c'' c\<^sub>2, s'')"
         by cases (auto simp add: redex_Catch_False final_def)+
       with f_k
       show ?thesis
         by (simp add: head_def head_com_def)
     qed
   qed
 qed
 
 lemma no_inf_Throw: "\<not> \<Gamma>\<turnstile>(Throw,s) \<rightarrow> \<dots>(\<infinity>)"
 proof
   assume "\<Gamma>\<turnstile> (Throw, s) \<rightarrow> \<dots>(\<infinity>)"
   then obtain f where
     step [rule_format]: "\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow> f (i+1)" and
     f_0: "f 0 = (Throw, s)"
     by (auto simp add: inf_def)
   from step [of 0, simplified f_0] step [of 1]
   show False
     by cases (auto elim: step_elim_cases)
 qed
 
 lemma split_inf_Seq:
   assumes inf_comp: "\<Gamma>\<turnstile>(Seq c\<^sub>1 c\<^sub>2,s) \<rightarrow> \<dots>(\<infinity>)"
   shows "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow> \<dots>(\<infinity>) \<or>
          (\<exists>s'. \<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow>\<^sup>* (Skip,s') \<and> \<Gamma>\<turnstile>(c\<^sub>2,s') \<rightarrow> \<dots>(\<infinity>))"
 proof -
   from inf_comp obtain f where
     step: "\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow> f (i+1)" and
     f_0: "f 0 = (Seq c\<^sub>1 c\<^sub>2, s)"
     by (auto simp add: inf_def)
   from f_0 have head_f_0: "head (f 0) = (c\<^sub>1,s)"
     by (simp add: head_def head_com_def)
   show ?thesis
   proof (cases "\<exists>i. final (head (f i))")
     case True
     define k where "k = (LEAST i. final (head (f i)))"
     have less_k: "\<forall>i<k. \<not> final (head (f i))"
       apply (intro allI impI)
       apply (unfold k_def)
       apply (drule not_less_Least)
       apply auto
       done
     from infinite_computation_extract_head_Seq [OF step f_0 this]
     obtain step_head: "\<forall>i<k. \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))" and
            conf: "\<forall>i<k. (\<exists>c' s'. f (i + 1) = (Seq c' c\<^sub>2, s'))"
       by blast
     from True
     have final_f_k: "final (head (f k))"
       apply -
       apply (erule exE)
       apply (drule LeastI)
       apply (simp add: k_def)
       done
     moreover
     from f_0 conf [rule_format, of "k - 1"]
     obtain c' s' where f_k: "f k = (Seq c' c\<^sub>2,s')"
       by (cases k) auto
     moreover
     from step_head have steps_head: "\<Gamma>\<turnstile>head (f 0) \<rightarrow>\<^sup>* head (f k)"
     proof (induct k)
       case 0 thus ?case by simp
     next
       case (Suc m)
       have step: "\<forall>i<Suc m. \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))" by fact
       hence "\<forall>i<m. \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))"
         by auto
       hence "\<Gamma>\<turnstile> head (f 0) \<rightarrow>\<^sup>*  head (f m)"
         by (rule Suc.hyps)
       also from step [rule_format, of m]
       have "\<Gamma>\<turnstile> head (f m) \<rightarrow> head (f (m + 1))" by simp
       finally show ?case by simp
     qed
     {
       assume f_k: "f k = (Seq Skip c\<^sub>2, s')"
       with steps_head
       have "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow>\<^sup>* (Skip,s')"
         using head_f_0
         by (simp add: head_def head_com_def)
       moreover
       from step [rule_format, of k] f_k
       obtain "\<Gamma>\<turnstile>(Seq Skip c\<^sub>2,s') \<rightarrow> (c\<^sub>2,s')" and
         f_Suc_k: "f (k + 1) = (c\<^sub>2,s')"
         by (fastforce elim: step.cases intro: step.intros)
       define g where "g i = f (i + (k + 1))" for i
       from f_Suc_k
       have g_0: "g 0 = (c\<^sub>2,s')"
         by (simp add: g_def)
       from step
       have "\<forall>i. \<Gamma>\<turnstile>g i \<rightarrow> g (i + 1)"
         by (simp add: g_def)
       with g_0 have "\<Gamma>\<turnstile>(c\<^sub>2,s') \<rightarrow> \<dots>(\<infinity>)"
         by (auto simp add: inf_def)
       ultimately
       have ?thesis
         by auto
     }
     moreover
     {
       fix x
       assume s': "s'=Normal x" and f_k: "f k = (Seq Throw c\<^sub>2, s')"
       from step [rule_format, of k] f_k s'
       obtain "\<Gamma>\<turnstile>(Seq Throw c\<^sub>2,s') \<rightarrow> (Throw,s')" and
         f_Suc_k: "f (k + 1) = (Throw,s')"
         by (fastforce elim: step_elim_cases intro: step.intros)
       define g where "g i = f (i + (k + 1))" for i
       from f_Suc_k
       have g_0: "g 0 = (Throw,s')"
         by (simp add: g_def)
       from step
       have "\<forall>i. \<Gamma>\<turnstile>g i \<rightarrow> g (i + 1)"
         by (simp add: g_def)
       with g_0 have "\<Gamma>\<turnstile>(Throw,s') \<rightarrow> \<dots>(\<infinity>)"
         by (auto simp add: inf_def)
       with no_inf_Throw
       have ?thesis
         by auto
     }
     ultimately
     show ?thesis
       by (auto simp add: final_def head_def head_com_def)
   next
     case False
     then have not_fin: "\<forall>i. \<not> final (head (f i))"
       by blast
     have "\<forall>i. \<Gamma>\<turnstile>head (f i) \<rightarrow> head (f (i + 1))"
     proof
       fix k
       from not_fin
       have "\<forall>i<(Suc k). \<not> final (head (f i))"
         by simp
 
       from infinite_computation_extract_head_Seq [OF step f_0 this ]
       show "\<Gamma>\<turnstile> head (f k) \<rightarrow> head (f (k + 1))" by simp
     qed
     with head_f_0 have "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow> \<dots>(\<infinity>)"
       by (auto simp add: inf_def)
     thus ?thesis
       by simp
   qed
 qed
 
 lemma split_inf_Catch:
   assumes inf_comp: "\<Gamma>\<turnstile>(Catch c\<^sub>1 c\<^sub>2,s) \<rightarrow> \<dots>(\<infinity>)"
   shows "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow> \<dots>(\<infinity>) \<or>
          (\<exists>s'. \<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow>\<^sup>* (Throw,Normal s') \<and> \<Gamma>\<turnstile>(c\<^sub>2,Normal s') \<rightarrow> \<dots>(\<infinity>))"
 proof -
   from inf_comp obtain f where
     step: "\<forall>i::nat. \<Gamma>\<turnstile>f i \<rightarrow> f (i+1)" and
     f_0: "f 0 = (Catch c\<^sub>1 c\<^sub>2, s)"
     by (auto simp add: inf_def)
   from f_0 have head_f_0: "head (f 0) = (c\<^sub>1,s)"
     by (simp add: head_def head_com_def)
   show ?thesis
   proof (cases "\<exists>i. final (head (f i))")
     case True
     define k where "k = (LEAST i. final (head (f i)))"
     have less_k: "\<forall>i<k. \<not> final (head (f i))"
       apply (intro allI impI)
       apply (unfold k_def)
       apply (drule not_less_Least)
       apply auto
       done
     from infinite_computation_extract_head_Catch [OF step f_0 this]
     obtain step_head: "\<forall>i<k. \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))" and
            conf: "\<forall>i<k. (\<exists>c' s'. f (i + 1) = (Catch c' c\<^sub>2, s'))"
       by blast
     from True
     have final_f_k: "final (head (f k))"
       apply -
       apply (erule exE)
       apply (drule LeastI)
       apply (simp add: k_def)
       done
     moreover
     from f_0 conf [rule_format, of "k - 1"]
     obtain c' s' where f_k: "f k = (Catch c' c\<^sub>2,s')"
       by (cases k) auto
     moreover
     from step_head have steps_head: "\<Gamma>\<turnstile>head (f 0) \<rightarrow>\<^sup>* head (f k)"
     proof (induct k)
       case 0 thus ?case by simp
     next
       case (Suc m)
       have step: "\<forall>i<Suc m. \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))" by fact
       hence "\<forall>i<m. \<Gamma>\<turnstile> head (f i) \<rightarrow> head (f (i + 1))"
         by auto
       hence "\<Gamma>\<turnstile> head (f 0) \<rightarrow>\<^sup>*  head (f m)"
         by (rule Suc.hyps)
       also from step [rule_format, of m]
       have "\<Gamma>\<turnstile> head (f m) \<rightarrow> head (f (m + 1))" by simp
       finally show ?case by simp
     qed
     {
       assume f_k: "f k = (Catch Skip c\<^sub>2, s')"
       with steps_head
       have "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow>\<^sup>* (Skip,s')"
         using head_f_0
         by (simp add: head_def head_com_def)
       moreover
       from step [rule_format, of k] f_k
       obtain "\<Gamma>\<turnstile>(Catch Skip c\<^sub>2,s') \<rightarrow> (Skip,s')" and
         f_Suc_k: "f (k + 1) = (Skip,s')"
         by (fastforce elim: step.cases intro: step.intros)
       from step [rule_format, of "k+1", simplified f_Suc_k]
       have ?thesis
         by (rule no_step_final') (auto simp add: final_def)
     }
     moreover
     {
       fix x
       assume s': "s'=Normal x" and f_k: "f k = (Catch Throw c\<^sub>2, s')"
       with steps_head
       have "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow>\<^sup>* (Throw,s')"
         using head_f_0
         by (simp add: head_def head_com_def)
       moreover
       from step [rule_format, of k] f_k s'
       obtain "\<Gamma>\<turnstile>(Catch Throw c\<^sub>2,s') \<rightarrow> (c\<^sub>2,s')" and
         f_Suc_k: "f (k + 1) = (c\<^sub>2,s')"
         by (fastforce elim: step_elim_cases intro: step.intros)
       define g where "g i = f (i + (k + 1))" for i
       from f_Suc_k
       have g_0: "g 0 = (c\<^sub>2,s')"
         by (simp add: g_def)
       from step
       have "\<forall>i. \<Gamma>\<turnstile>g i \<rightarrow> g (i + 1)"
         by (simp add: g_def)
       with g_0 have "\<Gamma>\<turnstile>(c\<^sub>2,s') \<rightarrow> \<dots>(\<infinity>)"
         by (auto simp add: inf_def)
       ultimately
       have ?thesis
         using s'
         by auto
     }
     ultimately
     show ?thesis
       by (auto simp add: final_def head_def head_com_def)
   next
     case False
     then have not_fin: "\<forall>i. \<not> final (head (f i))"
       by blast
     have "\<forall>i. \<Gamma>\<turnstile>head (f i) \<rightarrow> head (f (i + 1))"
     proof
       fix k
       from not_fin
       have "\<forall>i<(Suc k). \<not> final (head (f i))"
         by simp
 
       from infinite_computation_extract_head_Catch [OF step f_0 this ]
       show "\<Gamma>\<turnstile> head (f k) \<rightarrow> head (f (k + 1))" by simp
     qed
     with head_f_0 have "\<Gamma>\<turnstile>(c\<^sub>1,s) \<rightarrow> \<dots>(\<infinity>)"
       by (auto simp add: inf_def)
     thus ?thesis
       by simp
   qed
 qed
 
 lemma Skip_no_step: "\<Gamma>\<turnstile>(Skip,s) \<rightarrow> cfg \<Longrightarrow> P"
   apply (erule no_step_final')
   apply (simp add: final_def)
   done
 
 lemma not_inf_Stuck: "\<not> \<Gamma>\<turnstile>(c,Stuck) \<rightarrow> \<dots>(\<infinity>)"
 proof (induct c)
   case Skip
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Skip, Stuck)"
     from f_step [of 0] f_0
     show False
       by (auto elim: Skip_no_step)
   qed
 next
   case (Basic g)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Basic g, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Spec r)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Spec r, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Seq c\<^sub>1 c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Stuck) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Seq [OF this] Seq.hyps
     show False
       by (auto dest: steps_Stuck_prop)
   qed
 next
   case (Cond b c\<^sub>1 c\<^sub>2)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Cond b c\<^sub>1 c\<^sub>2, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (While b c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (While b c, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Call p)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Call p, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (DynCom d)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (DynCom d, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Guard m g c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Guard m g c, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case Throw
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Throw, Stuck)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Stuck) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Catch [OF this] Catch.hyps
     show False
       by (auto dest: steps_Stuck_prop)
   qed
 qed
 
 lemma not_inf_Fault: "\<not> \<Gamma>\<turnstile>(c,Fault x) \<rightarrow> \<dots>(\<infinity>)"
 proof (induct c)
   case Skip
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Skip, Fault x)"
     from f_step [of 0] f_0
     show False
       by (auto elim: Skip_no_step)
   qed
 next
   case (Basic g)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Basic g, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Spec r)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Spec r, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Seq c\<^sub>1 c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Fault x) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Seq [OF this] Seq.hyps
     show False
       by (auto dest: steps_Fault_prop)
   qed
 next
   case (Cond b c\<^sub>1 c\<^sub>2)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Cond b c\<^sub>1 c\<^sub>2, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (While b c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (While b c, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Call p)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Call p, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (DynCom d)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (DynCom d, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Guard m g c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Guard m g c, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case Throw
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Throw, Fault x)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Fault x) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Catch [OF this] Catch.hyps
     show False
       by (auto dest: steps_Fault_prop)
   qed
 qed
 
 lemma not_inf_Abrupt: "\<not> \<Gamma>\<turnstile>(c,Abrupt s) \<rightarrow> \<dots>(\<infinity>)"
 proof (induct c)
   case Skip
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Skip, Abrupt s)"
     from f_step [of 0] f_0
     show False
       by (auto elim: Skip_no_step)
   qed
 next
   case (Basic g)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Basic g, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Spec r)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Spec r, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Seq c\<^sub>1 c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Abrupt s) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Seq [OF this] Seq.hyps
     show False
       by (auto dest: steps_Abrupt_prop)
   qed
 next
   case (Cond b c\<^sub>1 c\<^sub>2)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Cond b c\<^sub>1 c\<^sub>2, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (While b c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (While b c, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Call p)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Call p, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (DynCom d)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (DynCom d, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Guard m g c)
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Guard m g c, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case Throw
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Throw, Abrupt s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Abrupt s) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Catch [OF this] Catch.hyps
     show False
       by (auto dest: steps_Abrupt_prop)
   qed
 qed
 
 
 theorem terminates_impl_no_infinite_computation:
   assumes termi: "\<Gamma>\<turnstile>c \<down> s"
   shows "\<not> \<Gamma>\<turnstile>(c,s) \<rightarrow> \<dots>(\<infinity>)"
 using termi
 proof (induct)
   case (Skip s) thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Skip, Normal s)"
     from f_step [of 0] f_0
     show False
       by (auto elim: Skip_no_step)
   qed
 next
   case (Basic g s)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Basic g, Normal s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Spec r s)
   thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Spec r, Normal s)"
     from f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Guard s g c m)
   have g: "s \<in> g" by fact
   have hyp: "\<not> \<Gamma>\<turnstile> (c, Normal s) \<rightarrow> \<dots>(\<infinity>)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Guard m g c, Normal s)"
     from f_step [of 0] f_0  g
     have "f 1 = (c,Normal s)"
       by (fastforce elim: step_elim_cases)
     with f_step
     have "\<Gamma>\<turnstile> (c, Normal s) \<rightarrow> \<dots>(\<infinity>)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp show False ..
   qed
 next
   case (GuardFault s g m c)
   have g: "s \<notin> g" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Guard m g c, Normal s)"
     from g f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Fault c m)
   thus ?case
     by (rule not_inf_Fault)
 next
   case (Seq c\<^sub>1 s c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Seq [OF this] Seq.hyps
     show False
       by (auto intro: steps_Skip_impl_exec)
   qed
 next
   case (CondTrue s b c1 c2)
   have b: "s \<in> b" by fact
   have hyp_c1: "\<not> \<Gamma>\<turnstile> (c1, Normal s) \<rightarrow> \<dots>(\<infinity>)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Cond b c1 c2, Normal s)"
     from b f_step [of 0] f_0
     have "f 1 = (c1,Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "\<Gamma>\<turnstile> (c1, Normal s) \<rightarrow> \<dots>(\<infinity>)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp_c1 show False by simp
   qed
 next
   case (CondFalse s b c2 c1)
   have b: "s \<notin> b" by fact
   have hyp_c2: "\<not> \<Gamma>\<turnstile> (c2, Normal s) \<rightarrow> \<dots>(\<infinity>)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Cond b c1 c2, Normal s)"
     from b f_step [of 0] f_0
     have "f 1 = (c2,Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "\<Gamma>\<turnstile> (c2, Normal s) \<rightarrow> \<dots>(\<infinity>)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp_c2 show False by simp
   qed
 next
   case (WhileTrue s b c)
   have b: "s \<in> b" by fact
   have hyp_c: "\<not> \<Gamma>\<turnstile> (c, Normal s) \<rightarrow> \<dots>(\<infinity>)" by fact
   have hyp_w: "\<forall>s'. \<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow> s' \<longrightarrow>
                      \<Gamma>\<turnstile>While b c \<down> s' \<and> \<not> \<Gamma>\<turnstile> (While b c, s') \<rightarrow> \<dots>(\<infinity>)" by fact
   have not_inf_Seq: "\<not> \<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow> \<dots>(\<infinity>)"
   proof
     assume "\<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Seq [OF this] hyp_c hyp_w show False
       by (auto intro: steps_Skip_impl_exec)
   qed
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (While b c, Normal s) \<rightarrow> \<dots>(\<infinity>)"
     then obtain f where
       f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)" and
       f_0: "f 0 = (While b c, Normal s)"
       by (auto simp add: inf_def)
     from f_step [of 0] f_0 b
     have "f 1 = (Seq c (While b c),Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "\<Gamma>\<turnstile> (Seq c (While b c), Normal s) \<rightarrow> \<dots>(\<infinity>)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with not_inf_Seq show False by simp
   qed
 next
   case (WhileFalse s b c)
   have b: "s \<notin> b" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (While b c, Normal s)"
     from b f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Call p bdy s)
   have bdy: "\<Gamma> p = Some bdy" by fact
   have hyp: "\<not> \<Gamma>\<turnstile> (bdy, Normal s) \<rightarrow> \<dots>(\<infinity>)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Call p, Normal s)"
     from bdy f_step [of 0] f_0
     have "f 1 = (bdy,Normal s)"
       by (auto elim: step_Normal_elim_cases)
     with f_step
     have "\<Gamma>\<turnstile> (bdy, Normal s) \<rightarrow> \<dots>(\<infinity>)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp show False by simp
   qed
 next
   case (CallUndefined p s)
   have no_bdy: "\<Gamma> p = None" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Call p, Normal s)"
     from no_bdy f_step [of 0] f_0 f_step [of 1]
     show False
       by (fastforce elim: Skip_no_step step_elim_cases)
   qed
 next
   case (Stuck c)
   show ?case
     by (rule not_inf_Stuck)
 next
   case (DynCom c s)
   have hyp: "\<not> \<Gamma>\<turnstile> (c s, Normal s) \<rightarrow> \<dots>(\<infinity>)" by fact
   show ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (DynCom c, Normal s)"
     from f_step [of 0] f_0
     have "f (Suc 0) = (c s, Normal s)"
       by (auto elim: step_elim_cases)
     with f_step have "\<Gamma>\<turnstile> (c s, Normal s) \<rightarrow> \<dots>(\<infinity>)"
       apply (simp add: inf_def)
       apply (rule_tac x="\<lambda>i. f (Suc i)" in exI)
       by simp
     with hyp
     show False by simp
   qed
 next
   case (Throw s) thus ?case
   proof (rule not_infI)
     fix f
     assume f_step: "\<And>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
     assume f_0: "f 0 = (Throw, Normal s)"
     from f_step [of 0] f_0
     show False
       by (auto elim: step_elim_cases)
   qed
 next
   case (Abrupt c)
   show ?case
     by (rule not_inf_Abrupt)
 next
   case (Catch c\<^sub>1 s c\<^sub>2)
   show ?case
   proof
     assume "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> \<dots>(\<infinity>)"
     from split_inf_Catch [OF this] Catch.hyps
     show False
       by (auto intro: steps_Throw_impl_exec)
   qed
 qed
 
 
 definition
  termi_call_steps :: "('s,'p,'f) body \<Rightarrow> (('s \<times> 'p) \<times> ('s \<times> 'p))set"
 where
 "termi_call_steps \<Gamma> =
  {((t,q),(s,p)). \<Gamma>\<turnstile>Call p\<down>Normal s \<and>
        (\<exists>c. \<Gamma>\<turnstile>(Call p,Normal s) \<rightarrow>\<^sup>+ (c,Normal t) \<and> redex c = Call q)}"
 
 
 primrec subst_redex:: "('s,'p,'f)com \<Rightarrow> ('s,'p,'f)com \<Rightarrow> ('s,'p,'f)com"
 where
 "subst_redex Skip c = c" |
 "subst_redex (Basic f) c = c" |
 "subst_redex (Spec r) c = c" |
 "subst_redex (Seq c\<^sub>1 c\<^sub>2) c  = Seq (subst_redex c\<^sub>1 c) c\<^sub>2" |
 "subst_redex (Cond b c\<^sub>1 c\<^sub>2) c = c" |
 "subst_redex (While b c') c = c" |
 "subst_redex (Call p) c = c" |
 "subst_redex (DynCom d) c = c" |
 "subst_redex (Guard f b c') c = c" |
 "subst_redex (Throw) c = c" |
 "subst_redex (Catch c\<^sub>1 c\<^sub>2) c = Catch (subst_redex c\<^sub>1 c) c\<^sub>2"
 
 lemma subst_redex_redex:
   "subst_redex c (redex c) = c"
   by (induct c) auto
 
 lemma redex_subst_redex: "redex (subst_redex c r) = redex r"
   by (induct c) auto
 
 lemma step_redex':
   shows "\<Gamma>\<turnstile>(redex c,s) \<rightarrow> (r',s') \<Longrightarrow> \<Gamma>\<turnstile>(c,s) \<rightarrow> (subst_redex c r',s')"
 by (induct c) (auto intro: step.Seq step.Catch)
 
 
 lemma step_redex:
   shows "\<Gamma>\<turnstile>(r,s) \<rightarrow> (r',s') \<Longrightarrow> \<Gamma>\<turnstile>(subst_redex c r,s) \<rightarrow> (subst_redex c r',s')"
 by (induct c) (auto intro: step.Seq step.Catch)
 
 lemma steps_redex:
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>* (r', s')"
   shows "\<And>c. \<Gamma>\<turnstile>(subst_redex c r,s) \<rightarrow>\<^sup>* (subst_redex c r',s')"
 using steps
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl
   show "\<Gamma>\<turnstile> (subst_redex c r', s') \<rightarrow>\<^sup>* (subst_redex c r', s')"
     by simp
 next
   case (Trans r s r'' s'')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r'', s'')" by fact
   from step_redex [OF this]
   have "\<Gamma>\<turnstile> (subst_redex c r, s) \<rightarrow> (subst_redex c r'', s'')".
   also
   have "\<Gamma>\<turnstile> (subst_redex c r'', s'') \<rightarrow>\<^sup>* (subst_redex c r', s')" by fact
   finally show ?case .
 qed
 
 ML \<open>
   ML_Thms.bind_thm ("trancl_induct2", Split_Rule.split_rule @{context}
     (Rule_Insts.read_instantiate @{context}
       [((("a", 0), Position.none), "(aa, ab)"), ((("b", 0), Position.none), "(ba, bb)")] []
       @{thm trancl_induct}));
 \<close>
 
 lemma steps_redex':
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>+ (r', s')"
   shows "\<And>c. \<Gamma>\<turnstile>(subst_redex c r,s) \<rightarrow>\<^sup>+ (subst_redex c r',s')"
 using steps
 proof (induct rule: tranclp_induct2 [consumes 1,case_names Step Trans])
   case (Step r' s')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r', s')" by fact
   then have "\<Gamma>\<turnstile> (subst_redex c r, s) \<rightarrow> (subst_redex c r', s')"
     by (rule step_redex)
   then show "\<Gamma>\<turnstile> (subst_redex c r, s) \<rightarrow>\<^sup>+ (subst_redex c r', s')"..
 next
   case (Trans r' s' r'' s'')
   have "\<Gamma>\<turnstile> (subst_redex c r, s) \<rightarrow>\<^sup>+ (subst_redex c r', s')" by fact
   also
   have "\<Gamma>\<turnstile> (r', s') \<rightarrow> (r'', s'')" by fact
   hence "\<Gamma>\<turnstile> (subst_redex c r', s') \<rightarrow> (subst_redex c r'', s'')"
     by (rule step_redex)
   finally show "\<Gamma>\<turnstile> (subst_redex c r, s) \<rightarrow>\<^sup>+ (subst_redex c r'', s'')" .
 qed
 
 primrec seq:: "(nat \<Rightarrow> ('s,'p,'f)com) \<Rightarrow> 'p \<Rightarrow> nat \<Rightarrow> ('s,'p,'f)com"
 where
 "seq c p 0 = Call p" |
 "seq c p (Suc i) = subst_redex (seq c p i) (c i)"
 
 
 lemma renumber':
   assumes f: "\<forall>i. (a,f i) \<in> r\<^sup>* \<and> (f i,f(Suc i)) \<in> r"
   assumes a_b: "(a,b) \<in> r\<^sup>*"
   shows "b = f 0 \<Longrightarrow> (\<exists>f. f 0 = a \<and> (\<forall>i. (f i, f(Suc i)) \<in> r))"
 using a_b
 proof (induct rule: converse_rtrancl_induct [consumes 1])
   assume "b = f 0"
   with f show "\<exists>f. f 0 = b \<and> (\<forall>i. (f i, f (Suc i)) \<in> r)"
     by blast
 next
   fix a z
   assume a_z: "(a, z) \<in> r" and "(z, b) \<in> r\<^sup>*"
   assume "b = f 0 \<Longrightarrow> \<exists>f. f 0 = z \<and> (\<forall>i. (f i, f (Suc i)) \<in> r)"
          "b = f 0"
   then obtain f where f0: "f 0 = z" and seq: "\<forall>i. (f i, f (Suc i)) \<in> r"
     by iprover
   {
     fix i have "((\<lambda>i. case i of 0 \<Rightarrow> a | Suc i \<Rightarrow> f i) i, f i) \<in> r"
       using seq a_z f0
       by (cases i) auto
   }
   then
   show "\<exists>f. f 0 = a \<and> (\<forall>i. (f i, f (Suc i)) \<in> r)"
     by - (rule exI [where x="\<lambda>i. case i of 0 \<Rightarrow> a | Suc i \<Rightarrow> f i"],simp)
 qed
 
 lemma renumber:
  "\<forall>i. (a,f i) \<in> r\<^sup>* \<and> (f i,f(Suc i)) \<in> r
  \<Longrightarrow> \<exists>f. f 0 = a \<and> (\<forall>i. (f i, f(Suc i)) \<in> r)"
   by (blast dest:renumber')
 
 lemma lem:
   "\<forall>y. r\<^sup>+\<^sup>+ a y \<longrightarrow> P a \<longrightarrow> P y
    \<Longrightarrow> ((b,a) \<in> {(y,x). P x \<and> r x y}\<^sup>+) = ((b,a) \<in> {(y,x). P x \<and> r\<^sup>+\<^sup>+ x y})"
 apply(rule iffI)
  apply clarify
  apply(erule trancl_induct)
   apply blast
  apply(blast intro:tranclp_trans)
 apply clarify
 apply(erule tranclp_induct)
  apply blast
 apply(blast intro:trancl_trans)
 done
 
 corollary terminates_impl_no_infinite_trans_computation:
  assumes terminates: "\<Gamma>\<turnstile>c\<down>s"
  shows "\<not>(\<exists>f. f 0 = (c,s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f(Suc i)))"
 proof -
   have "wf({(y,x). \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+)"
   proof (rule wf_trancl)
     show "wf {(y, x). \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}"
     proof (simp only: wf_iff_no_infinite_down_chain,clarify,simp)
       fix f
       assume "\<forall>i. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* f i \<and> \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
       hence "\<exists>f. f (0::nat) = (c,s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i))"
         by (rule renumber [to_pred])
       moreover from terminates_impl_no_infinite_computation [OF terminates]
       have "\<not> (\<exists>f. f (0::nat) = (c, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)))"
         by (simp add: inf_def)
       ultimately show False
         by simp
     qed
   qed
   hence "\<not> (\<exists>f. \<forall>i. (f (Suc i), f i)
                  \<in> {(y, x). \<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+)"
     by (simp add: wf_iff_no_infinite_down_chain)
   thus ?thesis
   proof (rule contrapos_nn)
     assume "\<exists>f. f (0::nat) = (c, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f (Suc i))"
     then obtain f where
       f0: "f 0 = (c, s)" and
       seq: "\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ f (Suc i)"
       by iprover
     show
       "\<exists>f. \<forall>i. (f (Suc i), f i) \<in> {(y, x). \<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+"
     proof (rule exI [where x=f],rule allI)
       fix i
       show "(f (Suc i), f i) \<in> {(y, x). \<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow> y}\<^sup>+"
       proof -
         {
           fix i have "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* f i"
           proof (induct i)
             case 0 show "\<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* f 0"
               by (simp add: f0)
           next
             case (Suc n)
             have "\<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* f n"  by fact
             with seq show "\<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* f (Suc n)"
               by (blast intro: tranclp_into_rtranclp rtranclp_trans)
           qed
         }
         hence "\<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* f i"
           by iprover
         with seq have
           "(f (Suc i), f i) \<in> {(y, x). \<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* x \<and> \<Gamma>\<turnstile>x \<rightarrow>\<^sup>+ y}"
           by clarsimp
         moreover
         have "\<forall>y. \<Gamma>\<turnstile>f i \<rightarrow>\<^sup>+ y\<longrightarrow>\<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* f i\<longrightarrow>\<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* y"
           by (blast intro: tranclp_into_rtranclp rtranclp_trans)
         ultimately
         show ?thesis
           by (subst lem )
       qed
     qed
   qed
 qed
 
 theorem wf_termi_call_steps: "wf (termi_call_steps \<Gamma>)"
 proof (simp only: termi_call_steps_def wf_iff_no_infinite_down_chain,
        clarify,simp)
   fix f
   assume inf: "\<forall>i. (\<lambda>(t, q) (s, p).
                 \<Gamma>\<turnstile>Call p \<down> Normal s \<and>
                 (\<exists>c. \<Gamma>\<turnstile> (Call p, Normal s) \<rightarrow>\<^sup>+ (c, Normal t) \<and> redex c = Call q))
              (f (Suc i)) (f i)"
   define s where "s i = fst (f i)" for i :: nat
   define p where "p i = (snd (f i)::'b)" for i :: nat
   from inf
   have inf': "\<forall>i. \<Gamma>\<turnstile>Call (p i) \<down> Normal (s i) \<and>
                (\<exists>c. \<Gamma>\<turnstile> (Call (p i), Normal (s i)) \<rightarrow>\<^sup>+ (c, Normal (s (i+1))) \<and>
                     redex c = Call (p (i+1)))"
     apply -
     apply (rule allI)
     apply (erule_tac x=i in allE)
     apply (auto simp add: s_def p_def)
     done
   show False
   proof -
     from inf'
     have "\<exists>c. \<forall>i. \<Gamma>\<turnstile>Call (p i) \<down> Normal (s i) \<and>
                \<Gamma>\<turnstile> (Call (p i), Normal (s i)) \<rightarrow>\<^sup>+ (c i, Normal (s (i+1))) \<and>
                     redex (c i) = Call (p (i+1))"
       apply -
       apply (rule choice)
       by blast
     then obtain c where
       termi_c: "\<forall>i. \<Gamma>\<turnstile>Call (p i) \<down> Normal (s i)" and
       steps_c: "\<forall>i. \<Gamma>\<turnstile> (Call (p i), Normal (s i)) \<rightarrow>\<^sup>+ (c i, Normal (s (i+1)))" and
       red_c:   "\<forall>i. redex (c i) = Call (p (i+1))"
       by auto
     define g where "g i = (seq c (p 0) i,Normal (s i)::('a,'c) xstate)" for i
     from red_c [rule_format, of 0]
     have "g 0 = (Call (p 0), Normal (s 0))"
       by (simp add: g_def)
     moreover
     {
       fix i
       have "redex (seq c (p 0) i) = Call (p i)"
         by (induct i) (auto simp add: redex_subst_redex red_c)
       from this [symmetric]
       have "subst_redex (seq c (p 0) i) (Call (p i)) = (seq c (p 0) i)"
         by (simp add: subst_redex_redex)
     } note subst_redex_seq = this
     have "\<forall>i. \<Gamma>\<turnstile> (g i) \<rightarrow>\<^sup>+ (g (i+1))"
     proof
       fix i
       from steps_c [rule_format, of i]
       have "\<Gamma>\<turnstile> (Call (p i), Normal (s i)) \<rightarrow>\<^sup>+ (c i, Normal (s (i + 1)))".
       from steps_redex' [OF this, of "(seq c (p 0) i)"]
       have "\<Gamma>\<turnstile> (subst_redex (seq c (p 0) i) (Call (p i)), Normal (s i)) \<rightarrow>\<^sup>+
                 (subst_redex (seq c (p 0) i) (c i), Normal (s (i + 1)))" .
       hence "\<Gamma>\<turnstile> (seq c (p 0) i, Normal (s i)) \<rightarrow>\<^sup>+
                  (seq c (p 0) (i+1), Normal (s (i + 1)))"
         by (simp add: subst_redex_seq)
       thus "\<Gamma>\<turnstile> (g i) \<rightarrow>\<^sup>+ (g (i+1))"
         by (simp add: g_def)
     qed
     moreover
     from terminates_impl_no_infinite_trans_computation [OF termi_c [rule_format, of 0]]
     have "\<not> (\<exists>f. f 0 = (Call (p 0), Normal (s 0)) \<and> (\<forall>i. \<Gamma>\<turnstile> f i \<rightarrow>\<^sup>+ f (Suc i)))" .
     ultimately show False
       by auto
   qed
 qed
 
 
 lemma no_infinite_computation_implies_wf:
   assumes not_inf: "\<not> \<Gamma>\<turnstile> (c, s) \<rightarrow> \<dots>(\<infinity>)"
   shows "wf {(c2,c1). \<Gamma> \<turnstile> (c,s) \<rightarrow>\<^sup>* c1 \<and> \<Gamma> \<turnstile> c1 \<rightarrow> c2}"
 proof (simp only: wf_iff_no_infinite_down_chain,clarify, simp)
   fix f
   assume "\<forall>i. \<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* f i \<and> \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)"
   hence "\<exists>f. f 0 = (c, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i))"
     by (rule renumber [to_pred])
   moreover from not_inf
   have "\<not> (\<exists>f. f 0 = (c, s) \<and> (\<forall>i. \<Gamma>\<turnstile>f i \<rightarrow> f (Suc i)))"
     by (simp add: inf_def)
   ultimately show False
     by simp
 qed
 
 lemma not_final_Stuck_step: "\<not> final (c,Stuck) \<Longrightarrow> \<exists>c' s'. \<Gamma>\<turnstile> (c, Stuck) \<rightarrow> (c',s')"
 by (induct c) (fastforce intro: step.intros simp add: final_def)+
 
 lemma not_final_Abrupt_step:
   "\<not> final (c,Abrupt s) \<Longrightarrow> \<exists>c' s'. \<Gamma>\<turnstile> (c, Abrupt s) \<rightarrow> (c',s')"
 by (induct c) (fastforce intro: step.intros simp add: final_def)+
 
 lemma not_final_Fault_step:
   "\<not> final (c,Fault f) \<Longrightarrow> \<exists>c' s'. \<Gamma>\<turnstile> (c, Fault f) \<rightarrow> (c',s')"
 by (induct c) (fastforce intro: step.intros simp add: final_def)+
 
 lemma not_final_Normal_step:
   "\<not> final (c,Normal s) \<Longrightarrow> \<exists>c' s'. \<Gamma>\<turnstile> (c, Normal s) \<rightarrow> (c',s')"
 proof (induct c)
   case Skip thus ?case by (fastforce intro: step.intros simp add: final_def)
 next
   case Basic thus ?case by (fastforce intro: step.intros)
 next
   case (Spec r)
   thus ?case
     by (cases "\<exists>t. (s,t) \<in> r") (fastforce intro: step.intros)+
 next
   case (Seq c\<^sub>1 c\<^sub>2)
   thus ?case
     by (cases "final (c\<^sub>1,Normal s)") (fastforce intro: step.intros simp add: final_def)+
 next
   case (Cond b c1 c2)
   show ?case
     by (cases "s \<in> b") (fastforce intro: step.intros)+
 next
   case (While b c)
   show ?case
     by (cases "s \<in> b") (fastforce intro: step.intros)+
 next
   case (Call p)
   show ?case
   by (cases "\<Gamma> p") (fastforce intro: step.intros)+
 next
   case DynCom thus ?case by (fastforce intro: step.intros)
 next
   case (Guard f g c)
   show ?case
     by (cases "s \<in> g") (fastforce intro: step.intros)+
 next
   case Throw
   thus ?case by (fastforce intro: step.intros simp add: final_def)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   thus ?case
     by (cases "final (c\<^sub>1,Normal s)") (fastforce intro: step.intros simp add: final_def)+
 qed
 
 lemma final_termi:
 "final (c,s) \<Longrightarrow> \<Gamma>\<turnstile>c\<down>s"
   by (cases s) (auto simp add: final_def terminates.intros)
 
 
 lemma split_computation:
 assumes steps: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>* (c\<^sub>f, s\<^sub>f)"
 assumes not_final: "\<not> final (c,s)"
 assumes final: "final (c\<^sub>f,s\<^sub>f)"
 shows "\<exists>c' s'. \<Gamma>\<turnstile> (c, s) \<rightarrow> (c',s') \<and> \<Gamma>\<turnstile> (c', s') \<rightarrow>\<^sup>* (c\<^sub>f, s\<^sub>f)"
 using steps not_final final
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl thus ?case by simp
 next
   case (Trans c s c' s')
   thus ?case by auto
 qed
 
 lemma wf_implies_termi_reach_step_case:
 assumes hyp: "\<And>c' s'. \<Gamma>\<turnstile> (c, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'"
 shows "\<Gamma>\<turnstile>c \<down> Normal s"
 using hyp
 proof (induct c)
   case Skip show ?case by (fastforce intro: terminates.intros)
 next
   case Basic show ?case by (fastforce intro: terminates.intros)
 next
   case (Spec r)
   show ?case
     by (cases "\<exists>t. (s,t)\<in>r") (fastforce intro: terminates.intros)+
 next
   case (Seq c\<^sub>1 c\<^sub>2)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   show ?case
   proof (rule terminates.Seq)
     {
       fix c' s'
       assume step_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow> (c', s')"
       have "\<Gamma>\<turnstile>c' \<down> s'"
       proof -
         from step_c\<^sub>1
         have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (Seq c' c\<^sub>2, s')"
           by (rule step.Seq)
         from hyp [OF this]
         have "\<Gamma>\<turnstile>Seq c' c\<^sub>2 \<down> s'".
         thus "\<Gamma>\<turnstile>c'\<down> s'"
           by cases auto
       qed
     }
     from Seq.hyps (1) [OF this]
     show "\<Gamma>\<turnstile>c\<^sub>1 \<down> Normal s".
   next
     show "\<forall>s'. \<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>c\<^sub>2 \<down> s'"
     proof (intro allI impI)
       fix s'
       assume exec_c\<^sub>1: "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> s'"
       show "\<Gamma>\<turnstile>c\<^sub>2 \<down> s'"
       proof (cases "final (c\<^sub>1,Normal s)")
         case True
         hence "c\<^sub>1=Skip \<or> c\<^sub>1=Throw"
           by (simp add: final_def)
         thus ?thesis
         proof
           assume Skip: "c\<^sub>1=Skip"
           have "\<Gamma>\<turnstile>(Seq Skip c\<^sub>2,Normal s) \<rightarrow> (c\<^sub>2,Normal s)"
             by (rule step.SeqSkip)
           from hyp [simplified Skip, OF this]
           have "\<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s" .
           moreover from exec_c\<^sub>1 Skip
           have "s'=Normal s"
             by (auto elim: exec_Normal_elim_cases)
           ultimately show ?thesis by simp
         next
           assume Throw: "c\<^sub>1=Throw"
           with exec_c\<^sub>1 have "s'=Abrupt s"
             by (auto elim: exec_Normal_elim_cases)
           thus ?thesis
             by auto
         qed
       next
         case False
         from exec_impl_steps [OF exec_c\<^sub>1]
         obtain c\<^sub>f t where
           steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow>\<^sup>* (c\<^sub>f, t)" and
           fin:"(case s' of
                  Abrupt x \<Rightarrow> c\<^sub>f = Throw \<and> t = Normal x
                 | _ \<Rightarrow> c\<^sub>f = Skip \<and> t = s')"
           by (fastforce split: xstate.splits)
         with fin have final: "final (c\<^sub>f,t)"
           by (cases s') (auto simp add: final_def)
         from split_computation [OF steps_c\<^sub>1 False this]
         obtain c'' s'' where
           first: "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow> (c'', s'')" and
           rest: "\<Gamma>\<turnstile> (c'', s'') \<rightarrow>\<^sup>* (c\<^sub>f, t)"
           by blast
         from step.Seq [OF first]
         have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (Seq c'' c\<^sub>2, s'')".
         from hyp [OF this]
         have termi_s'': "\<Gamma>\<turnstile>Seq c'' c\<^sub>2 \<down> s''".
         show ?thesis
         proof (cases s'')
           case (Normal x)
           from termi_s'' [simplified Normal]
           have termi_c\<^sub>2: "\<forall>t. \<Gamma>\<turnstile> \<langle>c'',Normal x\<rangle> \<Rightarrow> t \<longrightarrow> \<Gamma>\<turnstile>c\<^sub>2 \<down> t"
             by cases
           show ?thesis
           proof (cases "\<exists>x'. s'=Abrupt x'")
             case False
             with fin obtain "c\<^sub>f=Skip" "t=s'"
               by (cases s') auto
             from steps_Skip_impl_exec [OF rest [simplified this]] Normal
             have "\<Gamma>\<turnstile> \<langle>c'',Normal x\<rangle> \<Rightarrow> s'"
               by simp
             from termi_c\<^sub>2 [rule_format, OF this]
             show "\<Gamma>\<turnstile>c\<^sub>2 \<down> s'" .
           next
             case True
             with fin obtain x' where s': "s'=Abrupt x'" and "c\<^sub>f=Throw" "t=Normal x'"
               by auto
             from steps_Throw_impl_exec [OF rest [simplified this]] Normal
             have "\<Gamma>\<turnstile> \<langle>c'',Normal x\<rangle> \<Rightarrow> Abrupt x'"
               by simp
             from termi_c\<^sub>2 [rule_format, OF this] s'
             show "\<Gamma>\<turnstile>c\<^sub>2 \<down> s'" by simp
           qed
         next
           case (Abrupt x)
           from steps_Abrupt_prop [OF rest this]
           have "t=Abrupt x" by simp
           with fin have "s'=Abrupt x"
             by (cases s') auto
           thus "\<Gamma>\<turnstile>c\<^sub>2 \<down> s'"
             by auto
         next
           case (Fault f)
           from steps_Fault_prop [OF rest this]
           have "t=Fault f" by simp
           with fin have "s'=Fault f"
             by (cases s') auto
           thus "\<Gamma>\<turnstile>c\<^sub>2 \<down> s'"
             by auto
         next
           case Stuck
           from steps_Stuck_prop [OF rest this]
           have "t=Stuck" by simp
           with fin have "s'=Stuck"
             by (cases s') auto
           thus "\<Gamma>\<turnstile>c\<^sub>2 \<down> s'"
             by auto
         qed
       qed
     qed
   qed
 next
   case (Cond b c\<^sub>1 c\<^sub>2)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (Cond b c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   show ?case
   proof (cases "s\<in>b")
     case True
     then have "\<Gamma>\<turnstile> (Cond b c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (c\<^sub>1, Normal s)"
       by (rule step.CondTrue)
     from hyp [OF this] have "\<Gamma>\<turnstile>c\<^sub>1 \<down> Normal s".
     with True show ?thesis
       by (auto intro: terminates.intros)
   next
     case False
     then have "\<Gamma>\<turnstile> (Cond b c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (c\<^sub>2, Normal s)"
       by (rule step.CondFalse)
     from hyp [OF this] have "\<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s".
     with False show ?thesis
       by (auto intro: terminates.intros)
   qed
 next
   case (While b c)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (While b c, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   show ?case
   proof (cases "s\<in>b")
     case True
     then have "\<Gamma>\<turnstile> (While b c, Normal s) \<rightarrow> (Seq c (While b c), Normal s)"
       by (rule step.WhileTrue)
     from hyp [OF this] have "\<Gamma>\<turnstile>(Seq c (While b c)) \<down> Normal s".
     with True show ?thesis
       by (auto elim: terminates_Normal_elim_cases intro: terminates.intros)
   next
     case False
     thus ?thesis
       by (auto intro: terminates.intros)
   qed
 next
   case (Call p)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (Call p, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   show ?case
   proof (cases "\<Gamma> p")
     case None
     thus ?thesis
       by (auto intro: terminates.intros)
   next
     case (Some bdy)
     then have "\<Gamma>\<turnstile> (Call p, Normal s) \<rightarrow> (bdy, Normal s)"
       by (rule step.Call)
     from hyp [OF this] have "\<Gamma>\<turnstile>bdy \<down> Normal s".
     with Some show ?thesis
       by (auto intro: terminates.intros)
   qed
 next
   case (DynCom c)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (DynCom c, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   have "\<Gamma>\<turnstile> (DynCom c, Normal s) \<rightarrow> (c s, Normal s)"
     by (rule step.DynCom)
   from hyp [OF this] have "\<Gamma>\<turnstile>c s \<down> Normal s".
   then show ?case
     by (auto intro: terminates.intros)
 next
   case (Guard f g c)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (Guard f g c, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   show ?case
   proof (cases "s\<in>g")
     case True
     then have "\<Gamma>\<turnstile> (Guard f g c, Normal s) \<rightarrow> (c, Normal s)"
       by (rule step.Guard)
     from hyp [OF this] have "\<Gamma>\<turnstile>c\<down> Normal s".
     with True show ?thesis
       by (auto intro: terminates.intros)
   next
     case False
     thus ?thesis
       by (auto intro: terminates.intros)
   qed
 next
   case Throw show ?case by (auto intro: terminates.intros)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have hyp: "\<And>c' s'. \<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (c', s') \<Longrightarrow> \<Gamma>\<turnstile>c' \<down> s'" by fact
   show ?case
   proof (rule terminates.Catch)
     {
       fix c' s'
       assume step_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow> (c', s')"
       have "\<Gamma>\<turnstile>c' \<down> s'"
       proof -
         from step_c\<^sub>1
         have "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (Catch c' c\<^sub>2, s')"
           by (rule step.Catch)
         from hyp [OF this]
         have "\<Gamma>\<turnstile>Catch c' c\<^sub>2 \<down> s'".
         thus "\<Gamma>\<turnstile>c'\<down> s'"
           by cases auto
       qed
     }
     from Catch.hyps (1) [OF this]
     show "\<Gamma>\<turnstile>c\<^sub>1 \<down> Normal s".
   next
     show "\<forall>s'. \<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> Abrupt s' \<longrightarrow> \<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s'"
     proof (intro allI impI)
       fix s'
       assume exec_c\<^sub>1: "\<Gamma>\<turnstile> \<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> Abrupt s'"
       show "\<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s'"
       proof (cases "final (c\<^sub>1,Normal s)")
         case True
         with exec_c\<^sub>1
         have Throw: "c\<^sub>1=Throw"
           by (auto simp add: final_def elim: exec_Normal_elim_cases)
         have "\<Gamma>\<turnstile>(Catch Throw c\<^sub>2,Normal s) \<rightarrow> (c\<^sub>2,Normal s)"
           by (rule step.CatchThrow)
         from hyp [simplified Throw, OF this]
         have "\<Gamma>\<turnstile>c\<^sub>2 \<down> Normal s".
         moreover from exec_c\<^sub>1 Throw
         have "s'=s"
           by (auto elim: exec_Normal_elim_cases)
         ultimately show ?thesis by simp
       next
         case False
         from exec_impl_steps [OF exec_c\<^sub>1]
         obtain c\<^sub>f t where
           steps_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow>\<^sup>* (Throw, Normal s')"
           by (fastforce split: xstate.splits)
         from split_computation [OF steps_c\<^sub>1 False]
         obtain c'' s'' where
           first: "\<Gamma>\<turnstile> (c\<^sub>1, Normal s) \<rightarrow> (c'', s'')" and
           rest: "\<Gamma>\<turnstile> (c'', s'') \<rightarrow>\<^sup>* (Throw, Normal s')"
           by (auto simp add: final_def)
         from step.Catch [OF first]
         have "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, Normal s) \<rightarrow> (Catch c'' c\<^sub>2, s'')".
         from hyp [OF this]
         have "\<Gamma>\<turnstile>Catch c'' c\<^sub>2 \<down> s''".
         moreover
         from steps_Throw_impl_exec [OF rest]
         have "\<Gamma>\<turnstile> \<langle>c'',s''\<rangle> \<Rightarrow> Abrupt s'".
         moreover
         from rest obtain x where "s''=Normal x"
           by (cases s'')
              (auto dest: steps_Fault_prop steps_Abrupt_prop steps_Stuck_prop)
         ultimately show ?thesis
           by (fastforce elim: terminates_elim_cases)
       qed
     qed
   qed
 qed
 
 lemma wf_implies_termi_reach:
 assumes wf: "wf {(cfg2,cfg1). \<Gamma> \<turnstile> (c,s) \<rightarrow>\<^sup>* cfg1 \<and> \<Gamma> \<turnstile> cfg1 \<rightarrow> cfg2}"
 shows "\<And>c1 s1. \<lbrakk>\<Gamma> \<turnstile> (c,s) \<rightarrow>\<^sup>* cfg1;  cfg1=(c1,s1)\<rbrakk>\<Longrightarrow> \<Gamma>\<turnstile>c1\<down>s1"
 using wf
 proof (induct cfg1, simp)
   fix c1 s1
   assume reach: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>* (c1, s1)"
   assume hyp_raw: "\<And>y c2 s2.
            \<lbrakk>\<Gamma>\<turnstile> (c1, s1) \<rightarrow> (c2, s2); \<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>* (c2, s2); y = (c2, s2)\<rbrakk>
            \<Longrightarrow> \<Gamma>\<turnstile>c2 \<down> s2"
   have hyp: "\<And>c2 s2. \<Gamma>\<turnstile> (c1, s1) \<rightarrow> (c2, s2) \<Longrightarrow> \<Gamma>\<turnstile>c2 \<down> s2"
     apply -
     apply (rule hyp_raw)
     apply   assumption
     using reach
     apply  simp
     apply (rule refl)
     done
 
   show "\<Gamma>\<turnstile>c1 \<down> s1"
   proof (cases s1)
     case (Normal s1')
     with wf_implies_termi_reach_step_case [OF hyp [simplified Normal]]
     show ?thesis
       by auto
   qed (auto intro: terminates.intros)
 qed
 
 theorem no_infinite_computation_impl_terminates:
   assumes not_inf: "\<not> \<Gamma>\<turnstile> (c, s) \<rightarrow> \<dots>(\<infinity>)"
   shows "\<Gamma>\<turnstile>c\<down>s"
 proof -
   from no_infinite_computation_implies_wf [OF not_inf]
   have wf: "wf {(c2, c1). \<Gamma>\<turnstile>(c, s) \<rightarrow>\<^sup>* c1 \<and> \<Gamma>\<turnstile>c1 \<rightarrow> c2}".
   show ?thesis
     by (rule wf_implies_termi_reach [OF wf]) auto
 qed
 
 corollary terminates_iff_no_infinite_computation:
   "\<Gamma>\<turnstile>c\<down>s = (\<not> \<Gamma>\<turnstile> (c, s) \<rightarrow> \<dots>(\<infinity>))"
   apply (rule)
   apply  (erule terminates_impl_no_infinite_computation)
   apply (erule no_infinite_computation_impl_terminates)
   done
 
 (* ************************************************************************* *)
 subsection \<open>Generalised Redexes\<close>
 (* ************************************************************************* *)
 
 text \<open>
 For an important lemma for the completeness proof of the Hoare-logic for
 total correctness we need a generalisation of @{const "redex"} that not only
 yield the redex itself but all the enclosing statements as well.
 \<close>
 
 primrec redexes:: "('s,'p,'f)com \<Rightarrow> ('s,'p,'f)com set"
 where
 "redexes Skip = {Skip}" |
 "redexes (Basic f) = {Basic f}" |
 "redexes (Spec r) = {Spec r}" |
 "redexes (Seq c\<^sub>1 c\<^sub>2) = {Seq c\<^sub>1 c\<^sub>2} \<union> redexes c\<^sub>1" |
 "redexes (Cond b c\<^sub>1 c\<^sub>2) = {Cond b c\<^sub>1 c\<^sub>2}" |
 "redexes (While b c) = {While b c}" |
 "redexes (Call p) = {Call p}" |
 "redexes (DynCom d) = {DynCom d}" |
 "redexes (Guard f b c) = {Guard f b c}" |
 "redexes (Throw) = {Throw}" |
 "redexes (Catch c\<^sub>1 c\<^sub>2) = {Catch c\<^sub>1 c\<^sub>2} \<union> redexes c\<^sub>1"
 
 lemma root_in_redexes: "c \<in> redexes c"
   apply (induct c)
   apply auto
   done
 
 lemma redex_in_redexes: "redex c \<in> redexes c"
   apply (induct c)
   apply auto
   done
 
 lemma redex_redexes: "\<And>c'. \<lbrakk>c' \<in> redexes c; redex c' = c'\<rbrakk> \<Longrightarrow> redex c = c'"
   apply (induct c)
   apply auto
   done
 
 lemma step_redexes:
   shows "\<And>r r'. \<lbrakk>\<Gamma>\<turnstile>(r,s) \<rightarrow> (r',s'); r \<in> redexes c\<rbrakk>
   \<Longrightarrow> \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow> (c',s') \<and> r' \<in> redexes c'"
 proof (induct c)
   case Skip thus ?case by (fastforce intro: step.intros elim: step_elim_cases)
 next
   case Basic thus ?case by (fastforce intro: step.intros elim: step_elim_cases)
 next
   case Spec thus ?case by (fastforce intro: step.intros elim: step_elim_cases)
 next
   case (Seq c\<^sub>1 c\<^sub>2)
   have "r \<in> redexes (Seq c\<^sub>1 c\<^sub>2)" by fact
   hence r: "r = Seq c\<^sub>1 c\<^sub>2 \<or> r \<in> redexes c\<^sub>1"
     by simp
   have step_r: "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r', s')" by fact
   from r show ?case
   proof
     assume "r = Seq c\<^sub>1 c\<^sub>2"
     with step_r
     show ?case
       by (auto simp add: root_in_redexes)
   next
     assume r: "r \<in> redexes c\<^sub>1"
     from Seq.hyps (1) [OF step_r this]
     obtain c' where
       step_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c', s')" and
       r': "r' \<in> redexes c'"
       by blast
     from step.Seq [OF step_c\<^sub>1]
     have "\<Gamma>\<turnstile> (Seq c\<^sub>1 c\<^sub>2, s) \<rightarrow> (Seq c' c\<^sub>2, s')".
     with r'
     show ?case
       by auto
   qed
 next
   case Cond
   thus ?case
     by (fastforce intro: step.intros elim: step_elim_cases simp add: root_in_redexes)
 next
   case While
   thus ?case
     by (fastforce intro: step.intros elim: step_elim_cases simp add: root_in_redexes)
 next
   case Call thus ?case
     by (fastforce intro: step.intros elim: step_elim_cases simp add: root_in_redexes)
 next
   case DynCom thus ?case
     by (fastforce intro: step.intros elim: step_elim_cases simp add: root_in_redexes)
 next
   case Guard thus ?case
     by (fastforce intro: step.intros elim: step_elim_cases simp add: root_in_redexes)
 next
   case Throw thus ?case
     by (fastforce intro: step.intros elim: step_elim_cases simp add: root_in_redexes)
 next
   case (Catch c\<^sub>1 c\<^sub>2)
   have "r \<in> redexes (Catch c\<^sub>1 c\<^sub>2)" by fact
   hence r: "r = Catch c\<^sub>1 c\<^sub>2 \<or> r \<in> redexes c\<^sub>1"
     by simp
   have step_r: "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r', s')" by fact
   from r show ?case
   proof
     assume "r = Catch c\<^sub>1 c\<^sub>2"
     with step_r
     show ?case
       by (auto simp add: root_in_redexes)
   next
     assume r: "r \<in> redexes c\<^sub>1"
     from Catch.hyps (1) [OF step_r this]
     obtain c' where
       step_c\<^sub>1: "\<Gamma>\<turnstile> (c\<^sub>1, s) \<rightarrow> (c', s')" and
       r': "r' \<in> redexes c'"
       by blast
     from step.Catch [OF step_c\<^sub>1]
     have "\<Gamma>\<turnstile> (Catch c\<^sub>1 c\<^sub>2, s) \<rightarrow> (Catch c' c\<^sub>2, s')".
     with r'
     show ?case
       by auto
   qed
 qed
 
 lemma steps_redexes:
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>* (r', s')"
   shows "\<And>c. r \<in> redexes c \<Longrightarrow> \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (c',s') \<and> r' \<in> redexes c'"
 using steps
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl
   then
   show "\<exists>c'. \<Gamma>\<turnstile> (c, s') \<rightarrow>\<^sup>* (c', s') \<and> r' \<in> redexes c'"
     by auto
 next
   case (Trans r s r'' s'')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r'', s'')" "r \<in> redexes c" by fact+
   from step_redexes [OF this]
   obtain c' where
     step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s'')" and
     r'': "r'' \<in> redexes c'"
     by blast
   note step
   also
   from Trans.hyps (3) [OF r'']
   obtain c'' where
     steps: "\<Gamma>\<turnstile> (c', s'') \<rightarrow>\<^sup>* (c'', s')" and
     r': "r' \<in> redexes c''"
     by blast
   note steps
   finally
   show ?case
     using r'
     by blast
 qed
 
 
 
 lemma steps_redexes':
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>+ (r', s')"
   shows "\<And>c. r \<in> redexes c \<Longrightarrow> \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>+ (c',s') \<and> r' \<in> redexes c'"
 using steps
 proof (induct rule: tranclp_induct2 [consumes 1, case_names Step Trans])
   case (Step r' s' c')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r', s')" "r \<in> redexes c'" by fact+
   from step_redexes [OF this]
   show ?case
     by (blast intro: r_into_trancl)
 next
   case (Trans r' s' r'' s'')
   from Trans obtain c' where
     steps: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>+ (c', s')" and
     r': "r' \<in> redexes c'"
     by blast
   note steps
   moreover
   have "\<Gamma>\<turnstile> (r', s') \<rightarrow> (r'', s'')" by fact
   from step_redexes [OF this r'] obtain c'' where
     step: "\<Gamma>\<turnstile> (c', s') \<rightarrow> (c'', s'')" and
     r'': "r'' \<in> redexes c''"
     by blast
   note step
   finally show ?case
     using r'' by blast
 qed
 
 lemma step_redexes_Seq:
   assumes step: "\<Gamma>\<turnstile>(r,s) \<rightarrow> (r',s')"
   assumes Seq: "Seq r c\<^sub>2 \<in> redexes c"
   shows "\<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow> (c',s') \<and> Seq r' c\<^sub>2 \<in> redexes c'"
 proof -
   from step.Seq [OF step]
   have "\<Gamma>\<turnstile> (Seq r c\<^sub>2, s) \<rightarrow> (Seq r' c\<^sub>2, s')".
   from step_redexes [OF this Seq]
   show ?thesis .
 qed
 
 lemma steps_redexes_Seq:
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>* (r', s')"
   shows "\<And>c. Seq r c\<^sub>2 \<in> redexes c \<Longrightarrow>
               \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (c',s') \<and> Seq r' c\<^sub>2 \<in> redexes c'"
 using steps
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl
   then show ?case
     by (auto)
 
 next
   case (Trans r s r'' s'')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r'', s'')" "Seq r c\<^sub>2 \<in> redexes c" by fact+
   from step_redexes_Seq [OF this]
   obtain c' where
     step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s'')" and
     r'': "Seq r'' c\<^sub>2 \<in> redexes c'"
     by blast
   note step
   also
   from Trans.hyps (3) [OF r'']
   obtain c'' where
     steps: "\<Gamma>\<turnstile> (c', s'') \<rightarrow>\<^sup>* (c'', s')" and
     r': "Seq r' c\<^sub>2 \<in> redexes c''"
     by blast
   note steps
   finally
   show ?case
     using r'
     by blast
 qed
 
 lemma steps_redexes_Seq':
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>+ (r', s')"
   shows "\<And>c. Seq r c\<^sub>2 \<in> redexes c
              \<Longrightarrow> \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>+ (c',s') \<and> Seq r' c\<^sub>2 \<in> redexes c'"
 using steps
 proof (induct rule: tranclp_induct2 [consumes 1, case_names Step Trans])
   case (Step r' s' c')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r', s')" "Seq r c\<^sub>2 \<in> redexes c'" by fact+
   from step_redexes_Seq [OF this]
   show ?case
     by (blast intro: r_into_trancl)
 next
   case (Trans r' s' r'' s'')
   from Trans obtain c' where
     steps: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>+ (c', s')" and
     r': "Seq r' c\<^sub>2 \<in> redexes c'"
     by blast
   note steps
   moreover
   have "\<Gamma>\<turnstile> (r', s') \<rightarrow> (r'', s'')" by fact
   from step_redexes_Seq [OF this r'] obtain c'' where
     step: "\<Gamma>\<turnstile> (c', s') \<rightarrow> (c'', s'')" and
     r'': "Seq r'' c\<^sub>2 \<in> redexes c''"
     by blast
   note step
   finally show ?case
     using r'' by blast
 qed
 
 lemma step_redexes_Catch:
   assumes step: "\<Gamma>\<turnstile>(r,s) \<rightarrow> (r',s')"
   assumes Catch: "Catch r c\<^sub>2 \<in> redexes c"
   shows "\<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow> (c',s') \<and> Catch r' c\<^sub>2 \<in> redexes c'"
 proof -
   from step.Catch [OF step]
   have "\<Gamma>\<turnstile> (Catch r c\<^sub>2, s) \<rightarrow> (Catch r' c\<^sub>2, s')".
   from step_redexes [OF this Catch]
   show ?thesis .
 qed
 
 lemma steps_redexes_Catch:
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>* (r', s')"
   shows "\<And>c. Catch r c\<^sub>2 \<in> redexes c \<Longrightarrow>
               \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>* (c',s') \<and> Catch r' c\<^sub>2 \<in> redexes c'"
 using steps
 proof (induct rule: converse_rtranclp_induct2 [case_names Refl Trans])
   case Refl
   then show ?case
     by (auto)
 
 next
   case (Trans r s r'' s'')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r'', s'')" "Catch r c\<^sub>2 \<in> redexes c" by fact+
   from step_redexes_Catch [OF this]
   obtain c' where
     step: "\<Gamma>\<turnstile> (c, s) \<rightarrow> (c', s'')" and
     r'': "Catch r'' c\<^sub>2 \<in> redexes c'"
     by blast
   note step
   also
   from Trans.hyps (3) [OF r'']
   obtain c'' where
     steps: "\<Gamma>\<turnstile> (c', s'') \<rightarrow>\<^sup>* (c'', s')" and
     r': "Catch r' c\<^sub>2 \<in> redexes c''"
     by blast
   note steps
   finally
   show ?case
     using r'
     by blast
 qed
 
 lemma steps_redexes_Catch':
   assumes steps: "\<Gamma>\<turnstile> (r, s) \<rightarrow>\<^sup>+ (r', s')"
   shows "\<And>c. Catch r c\<^sub>2 \<in> redexes c
              \<Longrightarrow> \<exists>c'. \<Gamma>\<turnstile>(c,s) \<rightarrow>\<^sup>+ (c',s') \<and> Catch r' c\<^sub>2 \<in> redexes c'"
 using steps
 proof (induct rule: tranclp_induct2 [consumes 1, case_names Step Trans])
   case (Step r' s' c')
   have "\<Gamma>\<turnstile> (r, s) \<rightarrow> (r', s')" "Catch r c\<^sub>2 \<in> redexes c'" by fact+
   from step_redexes_Catch [OF this]
   show ?case
     by (blast intro: r_into_trancl)
 next
   case (Trans r' s' r'' s'')
   from Trans obtain c' where
     steps: "\<Gamma>\<turnstile> (c, s) \<rightarrow>\<^sup>+ (c', s')" and
     r': "Catch r' c\<^sub>2 \<in> redexes c'"
     by blast
   note steps
   moreover
   have "\<Gamma>\<turnstile> (r', s') \<rightarrow> (r'', s'')" by fact
   from step_redexes_Catch [OF this r'] obtain c'' where
     step: "\<Gamma>\<turnstile> (c', s') \<rightarrow> (c'', s'')" and
     r'': "Catch r'' c\<^sub>2 \<in> redexes c''"
     by blast
   note step
   finally show ?case
     using r'' by blast
 qed
 
 lemma redexes_subset:"\<And>c'. c' \<in> redexes c \<Longrightarrow> redexes c' \<subseteq> redexes c"
   by (induct c) auto
 
 lemma redexes_preserves_termination:
   assumes termi: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<And>c'. c' \<in> redexes c \<Longrightarrow> \<Gamma>\<turnstile>c'\<down>s"
 using termi
 by induct (auto intro: terminates.intros)
 
 
 end
diff --git a/thys/Simpl/StateSpace.thy b/thys/Simpl/StateSpace.thy
--- a/thys/Simpl/StateSpace.thy
+++ b/thys/Simpl/StateSpace.thy
@@ -1,46 +1,38 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      StateSpace.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>State Space Template\<close>
 theory StateSpace imports Hoare
 begin
 
 record 'g state = "globals"::'g
 
 definition
   upd_globals:: "('g \<Rightarrow> 'g) \<Rightarrow> ('g,'z) state_scheme \<Rightarrow> ('g,'z) state_scheme"
 where
   "upd_globals upd s = s\<lparr>globals := upd (globals s)\<rparr>"
 
+named_theorems state_simp
+
+lemma upd_globals_conv [state_simp]: "upd_globals f = (\<lambda>s. s\<lparr>globals := f (globals s)\<rparr>)"
+  by (rule ext) (simp add: upd_globals_def)
+
+record ('g, 'l) state_locals = "'g state" +
+  locals :: 'l
+
+(*
 record ('g, 'n, 'val) stateSP = "'g state" +
   locals :: "'n \<Rightarrow> 'val"
+*)
 
-lemma upd_globals_conv: "upd_globals f = (\<lambda>s. s\<lparr>globals := f (globals s)\<rparr>)"
-  by (rule ext) (simp add: upd_globals_def)
+type_synonym ('g, 'n, 'val) stateSP = "('g, 'n \<Rightarrow> 'val) state_locals"
+type_synonym ('g, 'n, 'val, 'x) stateSP_scheme = "('g, 'n \<Rightarrow> 'val, 'x) state_locals_scheme"
+
 
 end
diff --git a/thys/Simpl/SyntaxTest.thy b/thys/Simpl/SyntaxTest.thy
--- a/thys/Simpl/SyntaxTest.thy
+++ b/thys/Simpl/SyntaxTest.thy
@@ -1,97 +1,77 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      SyntaxTest.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+*)
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
-*)
 (*<*)
 theory SyntaxTest imports HeapList Vcg begin
 
 record "globals" =
  alloc_' :: "ref list"
  free_':: nat
  GA_' :: "ref list list"
  next_' :: "ref \<Rightarrow> ref"
  cont_' :: "ref \<Rightarrow> nat"
 
 record 'g vars = "'g state" +
   A_' :: "nat list"
   AA_' :: "nat list list"
   I_' :: nat
   M_' :: nat
   N_' :: nat
   R_' :: int
   S_' :: int
   B_' :: bool
   Abr_':: string
   p_' :: ref
   q_' :: ref
 
 procedures Foo (p,I|p) = "\<acute>p :== \<acute>p"
 
 term "\<acute>I :==\<^sub>g 3 - 1"
 term "\<acute>R :==\<^sub>g 3 - 1"
 term "\<acute>I :==\<^sub>g \<acute>A!i"
 term " \<acute>A!i :== j"
 term " \<acute>AA :== \<acute>AA!![i,j]"
 term " \<acute>AA!![i,j] :== \<acute>AA"
 term "\<acute>A!i :==\<^sub>g j"
 term "\<acute>p :==\<^sub>g \<acute>GA!i!j"
 term "\<acute>GA!i!j :==\<^sub>g \<acute>p"
 term "\<acute>p :==\<^sub>g \<acute>p \<rightarrow> \<acute>next"
 term "\<acute>p \<rightarrow> \<acute>next :==\<^sub>g \<acute>p"
 term "\<acute>p \<rightarrow> \<acute>next \<rightarrow> \<acute>next :==\<^sub>g \<acute>p"
 term "\<acute>p :== NEW sz [\<acute>next :== Null,\<acute>cont :== 0]"
 term "\<acute>p\<rightarrow>\<acute>next :==\<^sub>g NEW sz [\<acute>next :== Null,\<acute>cont :== 0]"
 term "\<acute>p :== NNEW sz [\<acute>next :== Null,\<acute>cont :== 0]"
 term "\<acute>p\<rightarrow>\<acute>next :==\<^sub>g NNEW sz [\<acute>next :== Null,\<acute>cont :== 0]"
 term "\<acute>B :==\<^sub>g \<acute>N + 1 < 0 \<and> \<acute>M + \<acute>N < n"
 term "\<acute>B :==\<^sub>g \<acute>N + 1 < 0 \<or>  \<acute>M + \<acute>N < n"
 term "\<acute>I :==\<^sub>g \<acute>N mod n"
 term "\<acute>I :==\<^sub>g \<acute>N div n"
 term "\<acute>R :==\<^sub>g \<acute>R div n"
 term "\<acute>R :==\<^sub>g \<acute>R mod n"
 term "\<acute>R :==\<^sub>g \<acute>R * n"
 term "\<acute>I :==\<^sub>g \<acute>I - \<acute>N"
 term "\<acute>R :==\<^sub>g \<acute>R - \<acute>S"
 term "\<acute>R :==\<^sub>g int \<acute>I"
 term "\<acute>I :==\<^sub>g nat \<acute>R"
 term "\<acute>R :==\<^sub>g -\<acute>R"
 term "IF\<^sub>g \<acute>A!i < \<acute>N THEN c1 ELSE c2 FI"
 term "WHILE\<^sub>g \<acute>A!i < \<acute>N DO c OD"
 term "WHILE\<^sub>g \<acute>A!i < \<acute>N INV \<lbrace>foo\<rbrace> DO c OD"
 term "WHILE\<^sub>g \<acute>A!i < \<acute>N INV \<lbrace>foo\<rbrace> VAR bar x DO c OD"
 term "WHILE\<^sub>g \<acute>A!i < \<acute>N INV \<lbrace>foo\<rbrace> VAR bar x DO c OD;;c"
 term "c;;WHILE\<^sub>g \<acute>A!i < \<acute>N INV \<lbrace>foo\<rbrace> VAR MEASURE \<acute>N + \<acute>M DO c;;c OD;;c"
 context Foo_impl
 begin
 term "\<acute>q :== CALL Foo(\<acute>p,\<acute>M)"
 term "\<acute>q :== CALL\<^sub>g Foo(\<acute>p,\<acute>M + 1)"
 term "\<acute>q :== CALL Foo(\<acute>p\<rightarrow>\<acute>next,\<acute>M)"
 term "\<acute>q \<rightarrow> \<acute>next :== CALL Foo(\<acute>p,\<acute>M)"
 end
 
 end
 
 (*>*)
diff --git a/thys/Simpl/Termination.thy b/thys/Simpl/Termination.thy
--- a/thys/Simpl/Termination.thy
+++ b/thys/Simpl/Termination.thy
@@ -1,2334 +1,2407 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Termination.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 section \<open>Terminating Programs\<close>
 
 theory Termination imports Semantic begin
 
 subsection \<open>Inductive Characterisation: \<open>\<Gamma>\<turnstile>c\<down>s\<close>\<close>
 
 inductive "terminates"::"('s,'p,'f) body \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'f) xstate \<Rightarrow> bool"
   ("_\<turnstile>_ \<down> _" [60,20,60] 89)
   for  \<Gamma>::"('s,'p,'f) body"
 where
   Skip: "\<Gamma>\<turnstile>Skip \<down>(Normal s)"
 
 | Basic: "\<Gamma>\<turnstile>Basic f \<down>(Normal s)"
 
 | Spec: "\<Gamma>\<turnstile>Spec r \<down>(Normal s)"
 
 | Guard: "\<lbrakk>s\<in>g; \<Gamma>\<turnstile>c\<down>(Normal s)\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>Guard f g c\<down>(Normal s)"
 
 | GuardFault: "s\<notin>g
                \<Longrightarrow>
                \<Gamma>\<turnstile>Guard f g c\<down>(Normal s)"
 
 
 | Fault [intro,simp]: "\<Gamma>\<turnstile>c\<down>Fault f"
 
 
 | Seq: "\<lbrakk>\<Gamma>\<turnstile>c\<^sub>1\<down>Normal s; \<forall>s'. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s\<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>c\<^sub>2\<down>s'\<rbrakk>
         \<Longrightarrow>
         \<Gamma>\<turnstile>Seq c\<^sub>1 c\<^sub>2\<down>(Normal s)"
 
 | CondTrue: "\<lbrakk>s \<in> b; \<Gamma>\<turnstile>c\<^sub>1\<down>(Normal s)\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>Cond b c\<^sub>1 c\<^sub>2\<down>(Normal s)"
 
 
 | CondFalse: "\<lbrakk>s \<notin> b; \<Gamma>\<turnstile>c\<^sub>2\<down>(Normal s)\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>Cond b c\<^sub>1 c\<^sub>2\<down>(Normal s)"
 
 
 | WhileTrue: "\<lbrakk>s \<in> b; \<Gamma>\<turnstile>c\<down>(Normal s);
                \<forall>s'. \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>While b c\<down>s'\<rbrakk>
               \<Longrightarrow>
               \<Gamma>\<turnstile>While b c\<down>(Normal s)"
 
 | WhileFalse: "\<lbrakk>s \<notin> b\<rbrakk>
                \<Longrightarrow>
                \<Gamma>\<turnstile>While b c\<down>(Normal s)"
 
 | Call:  "\<lbrakk>\<Gamma> p=Some bdy;\<Gamma>\<turnstile>bdy\<down>(Normal s)\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>Call p\<down>(Normal s)"
 
 | CallUndefined:  "\<lbrakk>\<Gamma> p = None\<rbrakk>
                    \<Longrightarrow>
                    \<Gamma>\<turnstile>Call p\<down>(Normal s)"
 
 | Stuck [intro,simp]: "\<Gamma>\<turnstile>c\<down>Stuck"
 
 | DynCom:  "\<lbrakk>\<Gamma>\<turnstile>(c s)\<down>(Normal s)\<rbrakk>
              \<Longrightarrow>
              \<Gamma>\<turnstile>DynCom c\<down>(Normal s)"
 
 | Throw: "\<Gamma>\<turnstile>Throw\<down>(Normal s)"
 
 | Abrupt [intro,simp]: "\<Gamma>\<turnstile>c\<down>Abrupt s"
 
 | Catch: "\<lbrakk>\<Gamma>\<turnstile>c\<^sub>1\<down>Normal s;
            \<forall>s'. \<Gamma>\<turnstile>\<langle>c\<^sub>1,Normal s \<rangle> \<Rightarrow> Abrupt s' \<longrightarrow> \<Gamma>\<turnstile>c\<^sub>2\<down>Normal s'\<rbrakk>
           \<Longrightarrow>
           \<Gamma>\<turnstile>Catch c\<^sub>1 c\<^sub>2\<down>Normal s"
 
 
 inductive_cases terminates_elim_cases [cases set]:
   "\<Gamma>\<turnstile>Skip \<down> s"
   "\<Gamma>\<turnstile>Guard f g c \<down> s"
   "\<Gamma>\<turnstile>Basic f \<down> s"
   "\<Gamma>\<turnstile>Spec r \<down> s"
   "\<Gamma>\<turnstile>Seq c1 c2 \<down> s"
   "\<Gamma>\<turnstile>Cond b c1 c2 \<down> s"
   "\<Gamma>\<turnstile>While b c \<down> s"
   "\<Gamma>\<turnstile>Call p \<down> s"
   "\<Gamma>\<turnstile>DynCom c \<down> s"
   "\<Gamma>\<turnstile>Throw \<down> s"
   "\<Gamma>\<turnstile>Catch c1 c2 \<down> s"
 
 inductive_cases terminates_Normal_elim_cases [cases set]:
   "\<Gamma>\<turnstile>Skip \<down> Normal s"
   "\<Gamma>\<turnstile>Guard f g c \<down> Normal s"
   "\<Gamma>\<turnstile>Basic f \<down> Normal s"
   "\<Gamma>\<turnstile>Spec r \<down> Normal s"
   "\<Gamma>\<turnstile>Seq c1 c2 \<down> Normal s"
   "\<Gamma>\<turnstile>Cond b c1 c2 \<down> Normal s"
   "\<Gamma>\<turnstile>While b c \<down> Normal s"
   "\<Gamma>\<turnstile>Call p \<down> Normal s"
   "\<Gamma>\<turnstile>DynCom c \<down> Normal s"
   "\<Gamma>\<turnstile>Throw \<down> Normal s"
   "\<Gamma>\<turnstile>Catch c1 c2 \<down> Normal s"
 
 lemma terminates_Skip': "\<Gamma>\<turnstile>Skip \<down> s"
   by (cases s) (auto intro: terminates.intros)
 
 lemma terminates_Call_body:
  "\<Gamma> p=Some bdy\<Longrightarrow>\<Gamma>\<turnstile>Call  p \<down>s = \<Gamma>\<turnstile>(the (\<Gamma> p))\<down>s"
   by (cases s)
      (auto elim: terminates_Normal_elim_cases intro: terminates.intros)
 
 lemma terminates_Normal_Call_body:
  "p \<in> dom \<Gamma> \<Longrightarrow>
   \<Gamma>\<turnstile>Call p \<down>Normal s = \<Gamma>\<turnstile>(the (\<Gamma> p))\<down>Normal s"
   by (auto elim: terminates_Normal_elim_cases intro: terminates.intros)
 
 lemma terminates_implies_exec:
   assumes terminates: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<exists>t. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t"
 using terminates
 proof (induct)
   case Skip thus ?case by (iprover intro: exec.intros)
 next
   case Basic thus ?case by (iprover intro: exec.intros)
 next
   case (Spec r s) thus ?case
     by (cases "\<exists>t. (s,t)\<in> r") (auto intro: exec.intros)
 next
   case Guard thus ?case by (iprover intro: exec.intros)
 next
   case GuardFault thus ?case by (iprover intro: exec.intros)
 next
   case Fault thus ?case by (iprover intro: exec.intros)
 next
   case Seq thus ?case by (iprover intro: exec_Seq')
 next
   case CondTrue thus ?case by (iprover intro: exec.intros)
 next
   case CondFalse thus ?case by (iprover intro: exec.intros)
 next
   case WhileTrue thus ?case by (iprover intro: exec.intros)
 next
   case WhileFalse thus ?case by (iprover intro: exec.intros)
 next
   case (Call p bdy s)
   then obtain s' where
     "\<Gamma>\<turnstile>\<langle>bdy,Normal s \<rangle> \<Rightarrow> s'"
     by iprover
   moreover have "\<Gamma> p = Some bdy" by fact
   ultimately show ?case
     by (cases s') (iprover intro: exec.intros)+
 next
   case CallUndefined thus ?case by (iprover intro: exec.intros)
 next
   case Stuck thus ?case by (iprover intro: exec.intros)
 next
   case DynCom thus ?case by (iprover intro: exec.intros)
 next
   case Throw thus ?case by (iprover intro: exec.intros)
 next
   case Abrupt thus ?case by (iprover intro: exec.intros)
 next
   case (Catch c1 s c2)
   then obtain s' where exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
     by iprover
   thus ?case
   proof (cases s')
     case (Normal s'')
     with exec_c1 show ?thesis by (auto intro!: exec.intros)
   next
     case (Abrupt s'')
     with exec_c1 Catch.hyps
     obtain t where "\<Gamma>\<turnstile>\<langle>c2,Normal s'' \<rangle> \<Rightarrow> t"
       by auto
     with exec_c1 Abrupt show ?thesis by (auto intro: exec.intros)
   next
     case Fault
     with exec_c1 show ?thesis by (auto intro!: exec.CatchMiss)
   next
     case Stuck
     with exec_c1 show ?thesis by (auto intro!: exec.CatchMiss)
   qed
 qed
 
+lemma terminates_block_exn:
+"\<lbrakk>\<Gamma>\<turnstile>bdy \<down> Normal (init s);
+  \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)\<rbrakk>
+ \<Longrightarrow> \<Gamma>\<turnstile>block_exn init bdy return result_exn c \<down> Normal s"
+apply (unfold block_exn_def)
+apply (fastforce intro: terminates.intros elim!: exec_Normal_elim_cases
+        dest!: not_isAbrD)
+  done
+
 lemma terminates_block:
 "\<lbrakk>\<Gamma>\<turnstile>bdy \<down> Normal (init s);
   \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)\<rbrakk>
  \<Longrightarrow> \<Gamma>\<turnstile>block init bdy return c \<down> Normal s"
-apply (unfold block_def)
-apply (fastforce intro: terminates.intros elim!: exec_Normal_elim_cases
-        dest!: not_isAbrD)
-done
+  unfolding block_def
+  by (rule terminates_block_exn)
 
-lemma terminates_block_elim [cases set, consumes 1]:
-assumes termi: "\<Gamma>\<turnstile>block init bdy return c \<down> Normal s"
+lemma terminates_block_exn_elim [cases set, consumes 1]:
+assumes termi: "\<Gamma>\<turnstile>block_exn init bdy return result_exn c \<down> Normal s"
 assumes e: "\<lbrakk>\<Gamma>\<turnstile>bdy \<down> Normal (init s);
           \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)
          \<rbrakk> \<Longrightarrow> P"
 shows P
 proof -
   have "\<Gamma>\<turnstile>\<langle>Basic init,Normal s\<rangle> \<Rightarrow> Normal (init s)"
     by (auto intro: exec.intros)
   with termi
   have "\<Gamma>\<turnstile>bdy \<down> Normal (init s)"
-    apply (unfold block_def)
+    apply (unfold block_exn_def)
     apply (elim terminates_Normal_elim_cases)
     by simp
   moreover
   {
     fix t
     assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t"
     have "\<Gamma>\<turnstile>c s t \<down> Normal (return s t)"
     proof -
       from exec_bdy
       have "\<Gamma>\<turnstile>\<langle>Catch (Seq (Basic init) bdy)
-                               (Seq (Basic (return s)) Throw),Normal s\<rangle> \<Rightarrow> Normal t"
+                               (Seq (Basic (\<lambda>t. result_exn (return s t) t)) Throw),Normal s\<rangle> \<Rightarrow> Normal t"
         by (fastforce intro: exec.intros)
       with termi have "\<Gamma>\<turnstile>DynCom (\<lambda>t. Seq (Basic (return s)) (c s t)) \<down> Normal t"
-        apply (unfold block_def)
+        apply (unfold block_exn_def)
         apply (elim terminates_Normal_elim_cases)
         by simp
       thus ?thesis
         apply (elim terminates_Normal_elim_cases)
         apply (auto intro: exec.intros)
         done
     qed
   }
   ultimately show P by (iprover intro: e)
 qed
 
+lemma terminates_block_elim [cases set, consumes 1]:
+assumes termi: "\<Gamma>\<turnstile>block init bdy return c \<down> Normal s"
+assumes e: "\<lbrakk>\<Gamma>\<turnstile>bdy \<down> Normal (init s);
+          \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)
+         \<rbrakk> \<Longrightarrow> P"
+shows P
+  using termi e unfolding block_def by (rule terminates_block_exn_elim)
+
 
 lemma terminates_call:
 "\<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>bdy \<down> Normal (init s);
   \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)\<rbrakk>
  \<Longrightarrow> \<Gamma>\<turnstile>call init p return c \<down> Normal s"
   apply (unfold call_def)
   apply (rule terminates_block)
   apply  (iprover intro: terminates.intros)
   apply (auto elim: exec_Normal_elim_cases)
   done
 
+lemma terminates_call_exn:
+"\<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>bdy \<down> Normal (init s);
+  \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)\<rbrakk>
+ \<Longrightarrow> \<Gamma>\<turnstile>call_exn init p return result_exn c \<down> Normal s"
+  apply (unfold call_exn_def)
+  apply (rule terminates_block_exn)
+  apply  (iprover intro: terminates.intros)
+  apply (auto elim: exec_Normal_elim_cases)
+  done
+
 lemma terminates_callUndefined:
 "\<lbrakk>\<Gamma> p = None\<rbrakk>
  \<Longrightarrow> \<Gamma>\<turnstile>call init p return result \<down> Normal s"
   apply (unfold call_def)
   apply (rule terminates_block)
   apply  (iprover intro: terminates.intros)
   apply (auto elim: exec_Normal_elim_cases)
   done
 
-lemma terminates_call_elim [cases set, consumes 1]:
-assumes termi: "\<Gamma>\<turnstile>call init p return c \<down> Normal s"
+lemma terminates_call_exnUndefined:
+"\<lbrakk>\<Gamma> p = None\<rbrakk>
+ \<Longrightarrow> \<Gamma>\<turnstile>call_exn init p return result_exn result \<down> Normal s"
+  apply (unfold call_exn_def)
+  apply (rule terminates_block_exn)
+  apply  (iprover intro: terminates.intros)
+  apply (auto elim: exec_Normal_elim_cases)
+  done
+
+lemma terminates_call_exn_elim [cases set, consumes 1]:
+assumes termi: "\<Gamma>\<turnstile>call_exn init p return result_exn c \<down> Normal s"
 assumes bdy: "\<And>bdy. \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>bdy \<down> Normal (init s);
      \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)\<rbrakk> \<Longrightarrow> P"
 assumes undef: "\<lbrakk>\<Gamma> p = None\<rbrakk> \<Longrightarrow> P"
 shows P
 apply (cases "\<Gamma> p")
 apply  (erule undef)
 using termi
-apply (unfold call_def)
-apply (erule terminates_block_elim)
+apply (unfold call_exn_def)
+apply (erule terminates_block_exn_elim)
 apply (erule terminates_Normal_elim_cases)
 apply  simp
 apply  (frule (1) bdy)
 apply   (fastforce intro: exec.intros)
 apply  assumption
 apply simp
 done
 
+lemma terminates_call_elim [cases set, consumes 1]:
+assumes termi: "\<Gamma>\<turnstile>call init p return c \<down> Normal s"
+assumes bdy: "\<And>bdy. \<lbrakk>\<Gamma> p = Some bdy; \<Gamma>\<turnstile>bdy \<down> Normal (init s);
+     \<forall>t. \<Gamma>\<turnstile>\<langle>bdy,Normal (init s)\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<Gamma>\<turnstile>c s t \<down> Normal (return s t)\<rbrakk> \<Longrightarrow> P"
+assumes undef: "\<lbrakk>\<Gamma> p = None\<rbrakk> \<Longrightarrow> P"
+shows P
+  using termi bdy undef unfolding call_call_exn by (rule terminates_call_exn_elim)
+
+
 lemma terminates_dynCall:
 "\<lbrakk>\<Gamma>\<turnstile>call init (p s) return c \<down> Normal s\<rbrakk>
  \<Longrightarrow> \<Gamma>\<turnstile>dynCall init p return c \<down> Normal s"
   apply (unfold dynCall_def)
   apply (auto intro: terminates.intros terminates_call)
   done
 
+lemma terminates_guards: "\<Gamma>\<turnstile>c \<down> Normal s \<Longrightarrow> \<Gamma>\<turnstile>guards gs c \<down> Normal s"
+  by (induct gs) (auto intro: terminates.intros)
+
+lemma terminates_guards_Fault: "find (\<lambda>(f, g). s \<notin> g) gs = Some (f, g) \<Longrightarrow> \<Gamma>\<turnstile>guards gs c \<down> Normal s"
+ by (induct gs) (auto intro: terminates.intros split: if_split_asm prod.splits)
+
+lemma terminates_maybe_guard_Fault: "s \<notin> g \<Longrightarrow> \<Gamma>\<turnstile>maybe_guard f g c \<down> Normal s"
+  by (metis UNIV_I maybe_guard_def terminates.GuardFault)
+
+lemma terminates_guards_DynCom: "\<Gamma>\<turnstile>(c s) \<down> Normal s \<Longrightarrow> \<Gamma>\<turnstile>guards gs (DynCom c) \<down> Normal s"
+  by (induct gs) (auto intro: terminates.intros)
+
+lemma terminates_maybe_guard_DynCom: "\<Gamma>\<turnstile>(c s) \<down> Normal s \<Longrightarrow> \<Gamma>\<turnstile>maybe_guard f g (DynCom c) \<down> Normal s"
+  by (metis maybe_guard_def terminates.DynCom terminates.Guard terminates.GuardFault)
+
+
+lemma terminates_dynCall_exn:
+"\<lbrakk>\<Gamma>\<turnstile>call_exn init (p s) return result_exn c \<down> Normal s\<rbrakk>
+ \<Longrightarrow> \<Gamma>\<turnstile>dynCall_exn f g init p return result_exn c \<down> Normal s"
+  apply (unfold dynCall_exn_def)
+  by (rule terminates_maybe_guard_DynCom)
+
 lemma terminates_dynCall_elim [cases set, consumes 1]:
 assumes termi: "\<Gamma>\<turnstile>dynCall init p return c \<down> Normal s"
 assumes "\<lbrakk>\<Gamma>\<turnstile>call init (p s) return c \<down> Normal s\<rbrakk> \<Longrightarrow> P"
 shows P
 using termi
 apply (unfold dynCall_def)
 apply (elim terminates_Normal_elim_cases)
 apply fact
 done
 
+lemma terminates_guards_elim [cases set, consumes 1, case_names noFault someFault]:
+  assumes termi: "\<Gamma>\<turnstile>guards gs c \<down> Normal s"
+  assumes noFault: "\<lbrakk>\<forall>f g. (f, g) \<in> set gs \<longrightarrow> s \<in> g; \<Gamma>\<turnstile>c \<down> Normal s\<rbrakk> \<Longrightarrow> P"
+  assumes someFault: "\<And>f g. find (\<lambda>(f,g). s \<notin> g) gs = Some (f, g) \<Longrightarrow> P"
+  shows P
+  using termi noFault someFault
+  by (induct gs)
+     (auto elim: terminates_Normal_elim_cases split: if_split_asm prod.splits)
+
+lemma terminates_maybe_guard_elim [cases set, consumes 1, case_names noFault someFault]:
+  assumes termi: "\<Gamma>\<turnstile>maybe_guard f g c \<down> Normal s"
+  assumes noFault: "\<lbrakk>s \<in> g; \<Gamma>\<turnstile>c \<down> Normal s\<rbrakk> \<Longrightarrow> P"
+  assumes someFault: "s \<notin> g \<Longrightarrow> P"
+  shows P
+  using termi noFault someFault
+  by (metis maybe_guard_def terminates_Normal_elim_cases(2))
+
+lemma terminates_dynCall_exn_elim [cases set, consumes 1, case_names noFault someFault]:
+assumes termi: "\<Gamma>\<turnstile>dynCall_exn f g init p return result_exn c \<down> Normal s"
+assumes noFault: "\<lbrakk>s \<in> g;
+ \<Gamma>\<turnstile>call_exn init (p s) return result_exn c \<down> Normal s\<rbrakk> \<Longrightarrow> P"
+assumes someFault: "s \<notin> g \<Longrightarrow> P"
+shows P
+using termi noFault someFault
+  apply (unfold dynCall_exn_def)
+  apply (erule terminates_maybe_guard_elim)
+  apply (auto elim: terminates_Normal_elim_cases)
+  done
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "sequence"}, @{const "flatten"} and
  @{const "normalize"}\<close>
 (* ************************************************************************ *)
 
 lemma terminates_sequence_app:
   "\<And>s. \<lbrakk>\<Gamma>\<turnstile>sequence Seq xs \<down> Normal s;
         \<forall>s'. \<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow>  \<Gamma>\<turnstile>sequence Seq ys \<down> s'\<rbrakk>
 \<Longrightarrow> \<Gamma>\<turnstile>sequence Seq (xs @ ys) \<down> Normal s"
 proof (induct xs)
   case Nil
   thus ?case by (auto intro: exec.intros)
 next
   case (Cons x xs)
   have termi_x_xs: "\<Gamma>\<turnstile>sequence Seq (x # xs) \<down> Normal s" by fact
   have termi_ys: "\<forall>s'. \<Gamma>\<turnstile>\<langle>sequence Seq (x # xs),Normal s \<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>sequence Seq ys \<down> s'" by fact
   show ?case
   proof (cases xs)
     case Nil
     with termi_x_xs termi_ys show ?thesis
       by (cases ys) (auto intro: terminates.intros)
   next
     case Cons
     from termi_x_xs Cons
     have "\<Gamma>\<turnstile>x \<down> Normal s"
       by (auto elim: terminates_Normal_elim_cases)
     moreover
     {
       fix s'
       assume exec_x: "\<Gamma>\<turnstile>\<langle>x,Normal s \<rangle> \<Rightarrow> s'"
       have "\<Gamma>\<turnstile>sequence Seq (xs @ ys) \<down> s'"
       proof -
         from exec_x termi_x_xs Cons
         have termi_xs: "\<Gamma>\<turnstile>sequence Seq xs \<down> s'"
           by (auto elim: terminates_Normal_elim_cases)
         show ?thesis
         proof (cases s')
           case (Normal s'')
           with exec_x termi_ys Cons
           have "\<forall>s'. \<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s'' \<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>sequence Seq ys \<down> s'"
             by (auto intro: exec.intros)
           from Cons.hyps [OF termi_xs [simplified Normal] this]
           have "\<Gamma>\<turnstile>sequence Seq (xs @ ys) \<down> Normal s''".
           with Normal show ?thesis by simp
         next
           case Abrupt thus ?thesis by (auto intro: terminates.intros)
         next
           case Fault thus ?thesis by (auto intro: terminates.intros)
         next
           case Stuck thus ?thesis by (auto intro: terminates.intros)
         qed
       qed
     }
     ultimately show ?thesis
       using Cons
       by (auto intro: terminates.intros)
   qed
 qed
 
 lemma terminates_sequence_appD:
   "\<And>s. \<Gamma>\<turnstile>sequence Seq (xs @ ys) \<down> Normal s
    \<Longrightarrow> \<Gamma>\<turnstile>sequence Seq xs \<down> Normal s \<and>
        (\<forall>s'. \<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow>  \<Gamma>\<turnstile>sequence Seq ys \<down> s')"
 proof (induct xs)
   case Nil
   thus ?case
     by (auto elim: terminates_Normal_elim_cases exec_Normal_elim_cases
          intro: terminates.intros)
 next
   case (Cons x xs)
   have termi_x_xs_ys: "\<Gamma>\<turnstile>sequence Seq ((x # xs) @ ys) \<down> Normal s" by fact
   show ?case
   proof (cases xs)
     case Nil
     with termi_x_xs_ys show ?thesis
       by (cases ys)
          (auto elim: terminates_Normal_elim_cases exec_Normal_elim_cases
            intro:  terminates_Skip')
   next
     case Cons
     with termi_x_xs_ys
     obtain termi_x: "\<Gamma>\<turnstile>x \<down> Normal s" and
            termi_xs_ys: "\<forall>s'. \<Gamma>\<turnstile>\<langle>x,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow>  \<Gamma>\<turnstile>sequence Seq (xs@ys) \<down> s'"
       by (auto elim: terminates_Normal_elim_cases)
 
     have "\<Gamma>\<turnstile>Seq x (sequence Seq xs) \<down> Normal s"
     proof (rule terminates.Seq [rule_format])
       show "\<Gamma>\<turnstile>x \<down> Normal s" by (rule termi_x)
     next
       fix s'
       assume exec_x: "\<Gamma>\<turnstile>\<langle>x,Normal s \<rangle> \<Rightarrow> s'"
       show "\<Gamma>\<turnstile>sequence Seq xs \<down> s'"
       proof -
         from termi_xs_ys [rule_format, OF exec_x]
         have termi_xs_ys': "\<Gamma>\<turnstile>sequence Seq (xs@ys) \<down> s'" .
         show ?thesis
         proof (cases s')
           case (Normal s'')
           from Cons.hyps [OF termi_xs_ys' [simplified Normal]]
           show ?thesis
             using Normal by auto
         next
           case Abrupt thus ?thesis by (auto intro: terminates.intros)
         next
           case Fault thus ?thesis by (auto intro: terminates.intros)
         next
           case Stuck thus ?thesis by (auto intro: terminates.intros)
         qed
       qed
     qed
     moreover
     {
       fix s'
       assume exec_x_xs: "\<Gamma>\<turnstile>\<langle>Seq x (sequence Seq xs),Normal s \<rangle> \<Rightarrow> s'"
       have "\<Gamma>\<turnstile>sequence Seq ys \<down> s'"
       proof -
         from exec_x_xs obtain t where
           exec_x: "\<Gamma>\<turnstile>\<langle>x,Normal s \<rangle> \<Rightarrow> t" and
           exec_xs: "\<Gamma>\<turnstile>\<langle>sequence Seq xs,t \<rangle> \<Rightarrow> s'"
           by cases
         show ?thesis
         proof (cases t)
           case (Normal t')
           with exec_x termi_xs_ys have "\<Gamma>\<turnstile>sequence Seq (xs@ys) \<down> Normal t'"
             by auto
           from Cons.hyps [OF this] exec_xs Normal
           show ?thesis
             by auto
         next
           case (Abrupt t')
           with exec_xs have "s'=Abrupt t'"
             by (auto dest: Abrupt_end)
           thus ?thesis by (auto intro: terminates.intros)
         next
           case (Fault f)
           with exec_xs have "s'=Fault f"
             by (auto dest: Fault_end)
           thus ?thesis by (auto intro: terminates.intros)
         next
           case Stuck
           with exec_xs have "s'=Stuck"
             by (auto dest: Stuck_end)
           thus ?thesis by (auto intro: terminates.intros)
         qed
       qed
     }
     ultimately show ?thesis
       using Cons
       by auto
   qed
 qed
 
 lemma terminates_sequence_appE [consumes 1]:
   "\<lbrakk>\<Gamma>\<turnstile>sequence Seq (xs @ ys) \<down> Normal s;
     \<lbrakk>\<Gamma>\<turnstile>sequence Seq xs \<down> Normal s;
      \<forall>s'. \<Gamma>\<turnstile>\<langle>sequence Seq xs,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow>  \<Gamma>\<turnstile>sequence Seq ys \<down> s'\<rbrakk> \<Longrightarrow> P\<rbrakk>
    \<Longrightarrow> P"
   by (auto dest: terminates_sequence_appD)
 
 lemma terminates_to_terminates_sequence_flatten:
   assumes termi: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<Gamma>\<turnstile>sequence Seq (flatten c)\<down>s"
 using termi
 by (induct)
    (auto intro: terminates.intros terminates_sequence_app
      exec_sequence_flatten_to_exec)
 
 lemma terminates_to_terminates_normalize:
   assumes termi: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<Gamma>\<turnstile>normalize c\<down>s"
 using termi
 proof induct
   case Seq
   thus ?case
     by (fastforce intro: terminates.intros terminates_sequence_app
                  terminates_to_terminates_sequence_flatten
         dest: exec_sequence_flatten_to_exec exec_normalize_to_exec)
 next
   case WhileTrue
   thus ?case
     by (fastforce intro: terminates.intros terminates_sequence_app
                  terminates_to_terminates_sequence_flatten
         dest: exec_sequence_flatten_to_exec exec_normalize_to_exec)
 next
   case Catch
   thus ?case
     by (fastforce intro: terminates.intros terminates_sequence_app
                  terminates_to_terminates_sequence_flatten
         dest: exec_sequence_flatten_to_exec exec_normalize_to_exec)
 qed (auto intro: terminates.intros)
 
 lemma terminates_sequence_flatten_to_terminates:
   shows "\<And>s. \<Gamma>\<turnstile>sequence Seq (flatten c)\<down>s \<Longrightarrow> \<Gamma>\<turnstile>c\<down>s"
 proof (induct c)
   case (Seq c1 c2)
   have "\<Gamma>\<turnstile>sequence Seq (flatten (Seq c1 c2)) \<down> s" by fact
   hence termi_app: "\<Gamma>\<turnstile>sequence Seq (flatten c1 @ flatten c2) \<down> s" by simp
   show ?case
   proof (cases s)
     case (Normal s')
     have "\<Gamma>\<turnstile>Seq c1 c2 \<down> Normal s'"
     proof (rule terminates.Seq [rule_format])
       from termi_app [simplified Normal]
       have "\<Gamma>\<turnstile>sequence Seq (flatten c1) \<down> Normal s'"
         by (cases rule: terminates_sequence_appE)
       with Seq.hyps
       show "\<Gamma>\<turnstile>c1 \<down> Normal s'"
         by simp
     next
       fix s''
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal s' \<rangle> \<Rightarrow> s''"
       from termi_app [simplified Normal] exec_to_exec_sequence_flatten [OF this]
       have "\<Gamma>\<turnstile>sequence Seq (flatten c2) \<down> s''"
         by (cases rule: terminates_sequence_appE) auto
       with Seq.hyps
       show "\<Gamma>\<turnstile>c2 \<down> s''"
         by simp
     qed
     with Normal show ?thesis
       by simp
   qed (auto intro: terminates.intros)
 qed (auto intro: terminates.intros)
 
 lemma terminates_normalize_to_terminates:
   shows "\<And>s. \<Gamma>\<turnstile>normalize c\<down>s \<Longrightarrow> \<Gamma>\<turnstile>c\<down>s"
 proof (induct c)
   case Skip thus ?case by (auto intro:  terminates_Skip')
 next
   case Basic thus ?case by (cases s) (auto intro: terminates.intros)
 next
   case Spec thus ?case by (cases s) (auto intro: terminates.intros)
 next
   case (Seq c1 c2)
   have "\<Gamma>\<turnstile>normalize (Seq c1 c2) \<down> s" by fact
   hence termi_app: "\<Gamma>\<turnstile>sequence Seq (flatten (normalize c1) @ flatten (normalize c2)) \<down> s"
     by simp
   show ?case
   proof (cases s)
     case (Normal s')
     have "\<Gamma>\<turnstile>Seq c1 c2 \<down> Normal s'"
     proof (rule terminates.Seq [rule_format])
       from termi_app [simplified Normal]
       have "\<Gamma>\<turnstile>sequence Seq (flatten (normalize c1))  \<down> Normal s'"
         by (cases rule: terminates_sequence_appE)
       from terminates_sequence_flatten_to_terminates [OF this] Seq.hyps
       show "\<Gamma>\<turnstile>c1 \<down> Normal s'"
         by simp
     next
       fix s''
       assume "\<Gamma>\<turnstile>\<langle>c1,Normal s' \<rangle> \<Rightarrow> s''"
       from exec_to_exec_normalize [OF this]
       have "\<Gamma>\<turnstile>\<langle>normalize c1,Normal s' \<rangle> \<Rightarrow> s''" .
       from termi_app [simplified Normal] exec_to_exec_sequence_flatten [OF this]
       have "\<Gamma>\<turnstile>sequence Seq (flatten (normalize c2))  \<down> s''"
         by (cases rule: terminates_sequence_appE) auto
       from terminates_sequence_flatten_to_terminates [OF this] Seq.hyps
       show "\<Gamma>\<turnstile>c2 \<down> s''"
         by simp
     qed
     with Normal show ?thesis by simp
   qed (auto intro: terminates.intros)
 next
   case (Cond b c1 c2)
   thus ?case
     by (cases s)
        (auto intro: terminates.intros elim!: terminates_Normal_elim_cases)
 next
   case (While b c)
   have "\<Gamma>\<turnstile>normalize (While b c) \<down> s" by fact
   hence termi_norm_w: "\<Gamma>\<turnstile>While b (normalize c) \<down> s" by simp
   {
     fix t w
     assume termi_w: "\<Gamma>\<turnstile> w \<down> t"
     have "w=While b (normalize c) \<Longrightarrow> \<Gamma>\<turnstile>While b c \<down> t"
       using termi_w
     proof (induct)
       case (WhileTrue t' b' c')
       from WhileTrue obtain
         t'_b: "t' \<in> b" and
         termi_norm_c: "\<Gamma>\<turnstile>normalize c \<down> Normal t'" and
         termi_norm_w': "\<forall>s'. \<Gamma>\<turnstile>\<langle>normalize c,Normal t' \<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>While b c \<down> s'"
         by auto
       from While.hyps [OF termi_norm_c]
       have "\<Gamma>\<turnstile>c \<down> Normal t'".
       moreover
       from termi_norm_w'
       have "\<forall>s'. \<Gamma>\<turnstile>\<langle>c,Normal t' \<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>While b c \<down> s'"
         by (auto intro: exec_to_exec_normalize)
       ultimately show ?case
         using t'_b
         by (auto intro: terminates.intros)
     qed (auto intro: terminates.intros)
   }
   from this [OF termi_norm_w]
   show ?case
     by auto
 next
   case Call thus ?case by simp
 next
   case DynCom thus ?case
     by (cases s) (auto intro: terminates.intros rangeI elim: terminates_Normal_elim_cases)
 next
   case Guard thus ?case
     by (cases s) (auto intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case Throw thus ?case by (cases s) (auto intro: terminates.intros)
 next
   case Catch
   thus ?case
     by (cases s)
        (auto dest: exec_to_exec_normalize elim!: terminates_Normal_elim_cases
          intro!: terminates.Catch)
 qed
 
 lemma terminates_iff_terminates_normalize:
 "\<Gamma>\<turnstile>normalize c\<down>s = \<Gamma>\<turnstile>c\<down>s"
   by (auto intro: terminates_to_terminates_normalize
     terminates_normalize_to_terminates)
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "strip_guards"}\<close>
 (* ************************************************************************* *)
 
 lemma terminates_strip_guards_to_terminates: "\<And>s. \<Gamma>\<turnstile>strip_guards F c\<down>s  \<Longrightarrow> \<Gamma>\<turnstile>c\<down>s"
 proof (induct c)
   case Skip thus ?case by simp
 next
   case Basic thus ?case by simp
 next
   case Spec thus ?case by simp
 next
   case (Seq c1 c2)
   hence "\<Gamma>\<turnstile>Seq (strip_guards F c1) (strip_guards F c2) \<down> s" by simp
   thus "\<Gamma>\<turnstile>Seq c1 c2 \<down> s"
   proof (cases)
     fix f assume "s=Fault f" thus ?thesis by simp
   next
     assume "s=Stuck" thus ?thesis by simp
   next
     fix s' assume "s=Abrupt s'" thus ?thesis by simp
   next
     fix s'
     assume s: "s=Normal s'"
     assume "\<Gamma>\<turnstile>strip_guards F c1 \<down> Normal s'"
     hence "\<Gamma>\<turnstile>c1 \<down> Normal s'"
       by (rule Seq.hyps)
     moreover
     assume c2:
       "\<forall>s''. \<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s'\<rangle> \<Rightarrow> s'' \<longrightarrow> \<Gamma>\<turnstile>strip_guards F c2\<down>s''"
     {
       fix s'' assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s' \<rangle> \<Rightarrow> s''"
       have " \<Gamma>\<turnstile>c2 \<down> s''"
       proof (cases s'')
         case (Normal s''')
         with exec_c1
         have "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s' \<rangle> \<Rightarrow> s''"
           by (auto intro: exec_to_exec_strip_guards)
         with c2
         show ?thesis
           by (iprover intro: Seq.hyps)
       next
         case (Abrupt s''')
         with exec_c1
         have "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s' \<rangle> \<Rightarrow> s''"
           by (auto intro: exec_to_exec_strip_guards )
         with c2
         show ?thesis
           by (iprover intro: Seq.hyps)
       next
         case Fault thus ?thesis by simp
       next
         case Stuck thus ?thesis by simp
       qed
     }
     ultimately show ?thesis
       using s
       by (iprover intro: terminates.intros)
   qed
 next
   case (Cond b c1 c2)
   hence "\<Gamma>\<turnstile>Cond b (strip_guards F c1) (strip_guards F c2) \<down> s" by simp
   thus "\<Gamma>\<turnstile>Cond b c1 c2 \<down> s"
   proof (cases)
     fix f assume "s=Fault f" thus ?thesis by simp
   next
     assume "s=Stuck" thus ?thesis by simp
   next
     fix s' assume "s=Abrupt s'" thus ?thesis by simp
   next
     fix s'
     assume "s'\<in>b" "\<Gamma>\<turnstile>strip_guards F c1 \<down> Normal s'" "s = Normal s'"
     thus ?thesis
       by (iprover intro: terminates.intros Cond.hyps)
   next
     fix s'
     assume "s'\<notin>b" "\<Gamma>\<turnstile>strip_guards F c2 \<down> Normal s'" "s = Normal s'"
     thus ?thesis
       by (iprover intro: terminates.intros Cond.hyps)
   qed
 next
   case (While b c)
   have hyp_c: "\<And>s. \<Gamma>\<turnstile>strip_guards F c \<down> s \<Longrightarrow> \<Gamma>\<turnstile>c \<down> s" by fact
   have "\<Gamma>\<turnstile>While b (strip_guards F c) \<down> s" using While.prems by simp
   moreover
   {
     fix sw
     assume "\<Gamma>\<turnstile>sw\<down>s"
     then have "sw=While b (strip_guards F c) \<Longrightarrow>
       \<Gamma>\<turnstile>While b c \<down> s"
     proof (induct)
       case (WhileTrue s b' c')
       have eqs: "While b' c' = While b (strip_guards F c)" by fact
       with \<open>s\<in>b'\<close> have b: "s\<in>b" by simp
       from eqs \<open>\<Gamma>\<turnstile>c' \<down> Normal s\<close> have "\<Gamma>\<turnstile>strip_guards F c \<down> Normal s"
         by simp
       hence term_c: "\<Gamma>\<turnstile>c \<down> Normal s"
         by (rule hyp_c)
       moreover
       {
         fix t
         assume exec_c: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t"
         have "\<Gamma>\<turnstile>While b c \<down> t"
         proof (cases t)
           case Fault
           thus ?thesis by simp
         next
           case Stuck
           thus ?thesis by simp
         next
           case (Abrupt t')
           thus ?thesis by simp
         next
           case (Normal t')
           with exec_c
           have "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s \<rangle> \<Rightarrow> Normal t'"
             by (auto intro: exec_to_exec_strip_guards)
           with WhileTrue.hyps eqs Normal
           show ?thesis
             by fastforce
         qed
       }
       ultimately
       show ?case
         using b
         by (auto intro: terminates.intros)
     next
       case WhileFalse thus ?case by (auto intro: terminates.intros)
     qed simp_all
   }
   ultimately show "\<Gamma>\<turnstile>While b c \<down> s"
     by auto
 next
   case Call thus ?case by simp
 next
   case DynCom thus ?case
      by (cases s) (auto elim: terminates_Normal_elim_cases intro: terminates.intros rangeI)
 next
   case Guard
   thus ?case
     by (cases s) (auto elim: terminates_Normal_elim_cases intro: terminates.intros
                   split: if_split_asm)
 next
   case Throw thus ?case by simp
 next
   case (Catch c1 c2)
   hence "\<Gamma>\<turnstile>Catch (strip_guards F c1) (strip_guards F c2) \<down> s" by simp
   thus "\<Gamma>\<turnstile>Catch c1 c2 \<down> s"
   proof (cases)
     fix f assume "s=Fault f" thus ?thesis by simp
   next
     assume "s=Stuck" thus ?thesis by simp
   next
     fix s' assume "s=Abrupt s'" thus ?thesis by simp
   next
     fix s'
     assume s: "s=Normal s'"
     assume "\<Gamma>\<turnstile>strip_guards F c1 \<down> Normal s'"
     hence "\<Gamma>\<turnstile>c1 \<down> Normal s'"
       by (rule Catch.hyps)
     moreover
     assume c2:
       "\<forall>s''. \<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s'\<rangle> \<Rightarrow> Abrupt s''
              \<longrightarrow> \<Gamma>\<turnstile>strip_guards F c2\<down>Normal s''"
     {
       fix s'' assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s' \<rangle> \<Rightarrow> Abrupt s''"
       have " \<Gamma>\<turnstile>c2 \<down> Normal s''"
       proof -
         from exec_c1
         have "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s' \<rangle> \<Rightarrow> Abrupt s''"
           by (auto intro: exec_to_exec_strip_guards)
         with c2
         show ?thesis
           by (auto intro: Catch.hyps)
       qed
     }
     ultimately show ?thesis
       using s
       by (iprover intro: terminates.intros)
   qed
 qed
 
 lemma terminates_strip_to_terminates:
   assumes termi_strip: "strip F \<Gamma>\<turnstile>c\<down>s"
   shows "\<Gamma>\<turnstile>c\<down>s"
 using termi_strip
 proof induct
   case (Seq c1 s c2)
   have "\<Gamma>\<turnstile>c1 \<down> Normal s" by fact
   moreover
   {
     fix s'
     assume exec: "\<Gamma>\<turnstile> \<langle>c1,Normal s\<rangle> \<Rightarrow> s'"
     have "\<Gamma>\<turnstile>c2 \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis
         by (auto elim: isFaultE)
     next
       case False
       from exec_to_exec_strip [OF exec this] Seq.hyps
       show ?thesis
         by auto
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 next
   case (WhileTrue s b c)
   have "\<Gamma>\<turnstile>c \<down> Normal s" by fact
   moreover
   {
     fix s'
     assume exec: "\<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow> s'"
     have "\<Gamma>\<turnstile>While b c \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis
         by (auto elim: isFaultE)
     next
       case False
       from exec_to_exec_strip [OF exec this] WhileTrue.hyps
       show ?thesis
         by auto
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 next
   case (Catch c1 s c2)
   have "\<Gamma>\<turnstile>c1 \<down> Normal s" by fact
   moreover
   {
     fix s'
     assume exec: "\<Gamma>\<turnstile> \<langle>c1,Normal s\<rangle> \<Rightarrow> Abrupt s'"
     from exec_to_exec_strip [OF exec] Catch.hyps
     have "\<Gamma>\<turnstile>c2 \<down> Normal s'"
       by auto
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 next
   case Call thus ?case
     by (auto intro: terminates.intros terminates_strip_guards_to_terminates)
 qed (auto intro: terminates.intros)
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{term "c\<^sub>1 \<inter>\<^sub>g c\<^sub>2"}\<close>
 (* ************************************************************************* *)
 
 lemma inter_guards_terminates:
   "\<And>c c2 s. \<lbrakk>(c1 \<inter>\<^sub>g c2) = Some c; \<Gamma>\<turnstile>c1\<down>s \<rbrakk>
         \<Longrightarrow> \<Gamma>\<turnstile>c\<down>s"
 proof (induct c1)
   case Skip thus ?case by (fastforce simp add: inter_guards_Skip)
 next
   case (Basic f) thus ?case by (fastforce simp add: inter_guards_Basic)
 next
   case (Spec r) thus ?case by (fastforce simp add: inter_guards_Spec)
 next
   case (Seq a1 a2)
   have "(Seq a1 a2 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain b1 b2 d1 d2 where
     c2: "c2=Seq b1 b2" and
     d1: "(a1 \<inter>\<^sub>g b1) = Some d1" and d2: "(a2 \<inter>\<^sub>g b2) = Some d2" and
     c: "c=Seq d1 d2"
     by (auto simp add: inter_guards_Seq)
   have termi_c1: "\<Gamma>\<turnstile>Seq a1 a2 \<down> s" by fact
   have "\<Gamma>\<turnstile>Seq d1 d2 \<down> s"
   proof (cases s)
     case Fault thus ?thesis by simp
   next
     case Stuck thus ?thesis by simp
   next
     case Abrupt thus ?thesis by simp
   next
     case (Normal s')
     note Normal_s = this
     with d1 termi_c1
     have "\<Gamma>\<turnstile>d1 \<down> Normal s'"
       by (auto elim: terminates_Normal_elim_cases intro: Seq.hyps)
     moreover
     {
       fix t
       assume exec_d1: "\<Gamma>\<turnstile>\<langle>d1,Normal s' \<rangle> \<Rightarrow> t"
       have "\<Gamma>\<turnstile>d2 \<down> t"
       proof (cases t)
         case Fault thus ?thesis by simp
       next
         case Stuck thus ?thesis by simp
       next
         case Abrupt thus ?thesis by simp
       next
         case (Normal t')
         with inter_guards_exec_noFault [OF d1 exec_d1]
         have "\<Gamma>\<turnstile>\<langle>a1,Normal s' \<rangle> \<Rightarrow> Normal t'"
           by simp
         with termi_c1 Normal_s have "\<Gamma>\<turnstile>a2 \<down> Normal t'"
           by (auto elim: terminates_Normal_elim_cases)
         with d2 have "\<Gamma>\<turnstile>d2 \<down> Normal t'"
           by (auto intro: Seq.hyps)
         with Normal show ?thesis by simp
       qed
     }
     ultimately have "\<Gamma>\<turnstile>Seq d1 d2 \<down> Normal s'"
       by (fastforce intro: terminates.intros)
     with Normal show ?thesis by simp
   qed
   with c show ?case by simp
 next
   case Cond thus ?case
     by - (cases s,
           auto intro: terminates.intros elim!: terminates_Normal_elim_cases
                simp add: inter_guards_Cond)
 next
   case (While b bdy1)
   have "(While b bdy1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain bdy2 bdy where
     c2: "c2=While b bdy2" and
     bdy: "(bdy1 \<inter>\<^sub>g bdy2) = Some bdy" and
     c: "c=While b bdy"
     by (auto simp add: inter_guards_While)
   have "\<Gamma>\<turnstile>While b bdy1 \<down> s" by fact
   moreover
   {
     fix s w w1 w2
     assume termi_w:  "\<Gamma>\<turnstile>w \<down> s"
     assume w: "w=While b bdy1"
     from termi_w w
     have "\<Gamma>\<turnstile>While b bdy \<down> s"
     proof (induct)
       case (WhileTrue s b' bdy1')
       have eqs: "While b' bdy1' = While b bdy1" by fact
       from WhileTrue have s_in_b: "s \<in> b" by simp
       from WhileTrue have termi_bdy1: "\<Gamma>\<turnstile>bdy1 \<down> Normal s" by simp
       show ?case
       proof -
         from bdy termi_bdy1
         have "\<Gamma>\<turnstile>bdy\<down>(Normal s)"
           by (rule While.hyps)
         moreover
         {
           fix t
           assume exec_bdy: "\<Gamma>\<turnstile>\<langle>bdy,Normal s \<rangle> \<Rightarrow> t"
           have "\<Gamma>\<turnstile>While b bdy\<down>t"
           proof (cases t)
             case Fault thus ?thesis by simp
           next
             case Stuck thus ?thesis by simp
           next
             case Abrupt thus ?thesis by simp
           next
             case (Normal t')
             with inter_guards_exec_noFault [OF bdy exec_bdy]
             have "\<Gamma>\<turnstile>\<langle>bdy1,Normal s \<rangle> \<Rightarrow> Normal t'"
               by simp
             with WhileTrue have "\<Gamma>\<turnstile>While b bdy \<down> Normal t'"
               by simp
             with Normal show ?thesis by simp
           qed
         }
         ultimately show ?thesis
           using s_in_b
           by (blast intro: terminates.WhileTrue)
       qed
     next
       case WhileFalse thus ?case
         by (blast intro: terminates.WhileFalse)
     qed (simp_all)
   }
   ultimately
   show ?case using c by simp
 next
   case Call thus ?case by (simp add: inter_guards_Call)
 next
   case (DynCom f1)
   have "(DynCom f1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain f2 f where
     c2: "c2=DynCom f2" and
     f_defined: "\<forall>s. ((f1 s) \<inter>\<^sub>g (f2 s)) \<noteq> None" and
     c: "c=DynCom (\<lambda>s. the ((f1 s) \<inter>\<^sub>g (f2 s)))"
     by (auto simp add: inter_guards_DynCom)
   have termi: "\<Gamma>\<turnstile>DynCom f1 \<down> s" by fact
   show ?case
   proof (cases s)
     case Fault thus ?thesis by simp
   next
     case Stuck thus ?thesis by simp
   next
     case Abrupt thus ?thesis by simp
   next
     case (Normal s')
     from f_defined obtain f where f: "((f1 s') \<inter>\<^sub>g (f2 s')) = Some f"
       by auto
     from Normal termi
     have "\<Gamma>\<turnstile>f1 s'\<down> (Normal s')"
       by (auto elim: terminates_Normal_elim_cases)
     from DynCom.hyps f this
     have "\<Gamma>\<turnstile>f\<down> (Normal s')"
       by blast
     with c f Normal
     show ?thesis
       by (auto intro: terminates.intros)
   qed
 next
   case (Guard f g1 bdy1)
   have "(Guard f g1 bdy1 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain g2 bdy2 bdy where
     c2: "c2=Guard f g2 bdy2" and
     bdy: "(bdy1 \<inter>\<^sub>g bdy2) = Some bdy" and
     c: "c=Guard f (g1 \<inter> g2) bdy"
     by (auto simp add: inter_guards_Guard)
   have termi_c1: "\<Gamma>\<turnstile>Guard f g1 bdy1 \<down> s" by fact
   show ?case
   proof (cases s)
     case Fault thus ?thesis by simp
   next
     case Stuck thus ?thesis by simp
   next
     case Abrupt thus ?thesis by simp
   next
     case (Normal s')
     show ?thesis
     proof (cases "s' \<in> g1")
       case False
       with Normal c show ?thesis by (auto intro: terminates.GuardFault)
     next
       case True
       note s_in_g1 = this
       show ?thesis
       proof (cases "s' \<in> g2")
         case False
         with Normal c show ?thesis by (auto intro: terminates.GuardFault)
       next
         case True
         with termi_c1 s_in_g1 Normal have "\<Gamma>\<turnstile>bdy1 \<down> Normal s'"
           by (auto elim: terminates_Normal_elim_cases)
         with c bdy Guard.hyps Normal True s_in_g1
         show ?thesis by (auto intro: terminates.Guard)
       qed
     qed
   qed
 next
   case Throw thus ?case
     by (auto simp add: inter_guards_Throw)
 next
   case (Catch a1 a2)
   have "(Catch a1 a2 \<inter>\<^sub>g c2) = Some c" by fact
   then obtain b1 b2 d1 d2 where
     c2: "c2=Catch b1 b2" and
     d1: "(a1 \<inter>\<^sub>g b1) = Some d1" and d2: "(a2 \<inter>\<^sub>g b2) = Some d2" and
     c: "c=Catch d1 d2"
     by (auto simp add: inter_guards_Catch)
   have termi_c1: "\<Gamma>\<turnstile>Catch a1 a2 \<down> s" by fact
   have "\<Gamma>\<turnstile>Catch d1 d2 \<down> s"
   proof (cases s)
     case Fault thus ?thesis by simp
   next
     case Stuck thus ?thesis by simp
   next
     case Abrupt thus ?thesis by simp
   next
     case (Normal s')
     note Normal_s = this
     with d1 termi_c1
     have "\<Gamma>\<turnstile>d1 \<down> Normal s'"
       by (auto elim: terminates_Normal_elim_cases intro: Catch.hyps)
     moreover
     {
       fix t
       assume exec_d1: "\<Gamma>\<turnstile>\<langle>d1,Normal s' \<rangle> \<Rightarrow> Abrupt t"
       have "\<Gamma>\<turnstile>d2 \<down> Normal t"
       proof -
         from inter_guards_exec_noFault [OF d1 exec_d1]
         have "\<Gamma>\<turnstile>\<langle>a1,Normal s' \<rangle> \<Rightarrow> Abrupt t"
           by simp
         with termi_c1 Normal_s have "\<Gamma>\<turnstile>a2 \<down> Normal t"
           by (auto elim: terminates_Normal_elim_cases)
         with d2 have "\<Gamma>\<turnstile>d2 \<down> Normal t"
           by (auto intro: Catch.hyps)
         with Normal show ?thesis by simp
       qed
     }
     ultimately have "\<Gamma>\<turnstile>Catch d1 d2 \<down> Normal s'"
       by (fastforce intro: terminates.intros)
     with Normal show ?thesis by simp
   qed
   with c show ?case by simp
 qed
 
 lemma inter_guards_terminates':
   assumes c: "(c1 \<inter>\<^sub>g c2) = Some c"
   assumes termi_c2: "\<Gamma>\<turnstile>c2\<down>s"
   shows "\<Gamma>\<turnstile>c\<down>s"
 proof -
   from c have "(c2 \<inter>\<^sub>g c1) = Some c"
     by (rule inter_guards_sym)
   from this termi_c2 show ?thesis
     by (rule inter_guards_terminates)
 qed
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "mark_guards"}\<close>
 (* ************************************************************************ *)
 
 lemma terminates_to_terminates_mark_guards:
   assumes termi: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<Gamma>\<turnstile>mark_guards f c\<down>s"
 using termi
 proof (induct)
   case Skip thus ?case by (fastforce intro: terminates.intros)
 next
   case Basic thus ?case by (fastforce intro: terminates.intros)
 next
   case Spec thus ?case by (fastforce intro: terminates.intros)
 next
   case Guard thus ?case by (fastforce intro: terminates.intros)
 next
   case GuardFault thus ?case by (fastforce intro: terminates.intros)
 next
   case Fault thus ?case by (fastforce intro: terminates.intros)
 next
   case (Seq c1 s c2)
   have "\<Gamma>\<turnstile>mark_guards f c1 \<down> Normal s" by fact
   moreover
   {
     fix t
     assume exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s \<rangle> \<Rightarrow> t"
     have "\<Gamma>\<turnstile>mark_guards f c2 \<down> t"
     proof -
       from exec_mark_guards_to_exec [OF exec_mark] obtain t' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> t'" and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t'_Fault_f: "t' = Fault f \<longrightarrow> t' = t" and
         t'_Fault: "isFault t' \<longrightarrow> isFault t" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         with t'_Fault have "isFault t" by simp
         thus ?thesis
           by (auto elim: isFaultE)
       next
         case False
         with t'_noFault have "t'=t" by simp
         with exec_c1 Seq.hyps
         show ?thesis
           by auto
       qed
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 next
   case CondTrue thus ?case by (fastforce intro: terminates.intros)
 next
   case CondFalse thus ?case by (fastforce intro: terminates.intros)
 next
   case (WhileTrue s b c)
   have s_in_b: "s \<in> b" by fact
   have "\<Gamma>\<turnstile>mark_guards f c \<down> Normal s" by fact
   moreover
   {
     fix t
     assume exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s \<rangle> \<Rightarrow> t"
     have "\<Gamma>\<turnstile>mark_guards f (While b c) \<down> t"
     proof -
       from exec_mark_guards_to_exec [OF exec_mark] obtain t' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t'" and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t'_Fault_f: "t' = Fault f \<longrightarrow> t' = t" and
         t'_Fault: "isFault t' \<longrightarrow> isFault t" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         with t'_Fault have "isFault t" by simp
         thus ?thesis
           by (auto elim: isFaultE)
       next
         case False
         with t'_noFault have "t'=t" by simp
         with exec_c1 WhileTrue.hyps
         show ?thesis
           by auto
       qed
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 next
   case WhileFalse thus ?case by (fastforce intro: terminates.intros)
 next
   case Call thus ?case by (fastforce intro: terminates.intros)
 next
   case CallUndefined thus ?case by (fastforce intro: terminates.intros)
 next
   case Stuck thus ?case by (fastforce intro: terminates.intros)
 next
   case DynCom thus ?case by (fastforce intro: terminates.intros)
 next
   case Throw thus ?case by (fastforce intro: terminates.intros)
 next
   case Abrupt thus ?case by (fastforce intro: terminates.intros)
 next
   case (Catch c1 s c2)
   have "\<Gamma>\<turnstile>mark_guards f c1 \<down> Normal s" by fact
   moreover
   {
     fix t
     assume exec_mark: "\<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s \<rangle> \<Rightarrow> Abrupt t"
     have "\<Gamma>\<turnstile>mark_guards f c2 \<down> Normal t"
     proof -
       from exec_mark_guards_to_exec [OF exec_mark] obtain t' where
         exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> t'" and
         t'_Fault_f: "t' = Fault f \<longrightarrow> t' = Abrupt t" and
         t'_Fault: "isFault t' \<longrightarrow> isFault (Abrupt t)" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t' = Abrupt t"
         by fastforce
       show ?thesis
       proof (cases "isFault t'")
         case True
         with t'_Fault have "isFault (Abrupt t)" by simp
         thus ?thesis by simp
       next
         case False
         with t'_noFault have "t'=Abrupt t" by simp
         with exec_c1 Catch.hyps
         show ?thesis
           by auto
       qed
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 qed
 
 lemma terminates_mark_guards_to_terminates_Normal:
   "\<And>s. \<Gamma>\<turnstile>mark_guards f c\<down>Normal s \<Longrightarrow> \<Gamma>\<turnstile>c\<down>Normal s"
 proof (induct c)
   case Skip thus ?case by (fastforce intro: terminates.intros)
 next
   case Basic thus ?case by (fastforce intro: terminates.intros)
 next
   case Spec thus ?case by (fastforce intro: terminates.intros)
 next
   case (Seq c1 c2)
   have "\<Gamma>\<turnstile>mark_guards f (Seq c1 c2) \<down> Normal s" by fact
   then obtain
     termi_merge_c1: "\<Gamma>\<turnstile>mark_guards f c1 \<down> Normal s" and
     termi_merge_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow>
                            \<Gamma>\<turnstile>mark_guards f c2 \<down> s'"
     by (auto elim: terminates_Normal_elim_cases)
   from termi_merge_c1 Seq.hyps
   have "\<Gamma>\<turnstile>c1 \<down> Normal s" by iprover
   moreover
   {
     fix s'
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
     have "\<Gamma>\<turnstile> c2 \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis by (auto elim: isFaultE)
     next
       case False
       from exec_to_exec_mark_guards [OF exec_c1 False]
       have "\<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s \<rangle> \<Rightarrow> s'" .
       from termi_merge_c2 [rule_format, OF this] Seq.hyps
       show ?thesis
         by (cases s') (auto)
     qed
   }
   ultimately show ?case by (auto intro: terminates.intros)
 next
   case Cond thus ?case
     by (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case (While b c)
   {
     fix u c'
     assume termi_c': "\<Gamma>\<turnstile>c' \<down> Normal u"
     assume c': "c' = mark_guards f (While b c)"
     have "\<Gamma>\<turnstile>While b c \<down> Normal u"
       using termi_c' c'
     proof (induct)
       case (WhileTrue s b' c')
       have s_in_b: "s \<in> b" using WhileTrue by simp
       have "\<Gamma>\<turnstile>mark_guards f c \<down> Normal s"
         using WhileTrue by (auto elim: terminates_Normal_elim_cases)
       with While.hyps have "\<Gamma>\<turnstile>c \<down> Normal s"
         by auto
       moreover
       have hyp_w: "\<forall>w. \<Gamma>\<turnstile>\<langle>mark_guards f c,Normal s \<rangle> \<Rightarrow> w \<longrightarrow> \<Gamma>\<turnstile>While b c \<down> w"
         using WhileTrue by simp
       hence "\<forall>w. \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> w \<longrightarrow> \<Gamma>\<turnstile>While b c \<down> w"
         apply -
         apply (rule allI)
         apply (case_tac "w")
         apply (auto dest: exec_to_exec_mark_guards)
         done
       ultimately show ?case
         using s_in_b
         by (auto intro: terminates.intros)
     next
       case WhileFalse thus ?case by (auto intro: terminates.intros)
     qed auto
   }
   with While show ?case by simp
 next
   case Call thus ?case
     by (fastforce intro: terminates.intros )
 next
   case DynCom thus ?case
     by (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case (Guard f g c)
   thus ?case by (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case Throw thus ?case
     by (fastforce intro: terminates.intros )
 next
   case (Catch c1 c2)
   have "\<Gamma>\<turnstile>mark_guards f (Catch c1 c2) \<down> Normal s" by fact
   then obtain
     termi_merge_c1: "\<Gamma>\<turnstile>mark_guards f c1 \<down> Normal s" and
     termi_merge_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s \<rangle> \<Rightarrow> Abrupt s' \<longrightarrow>
                            \<Gamma>\<turnstile>mark_guards f c2 \<down> Normal s'"
     by (auto elim: terminates_Normal_elim_cases)
   from termi_merge_c1 Catch.hyps
   have "\<Gamma>\<turnstile>c1 \<down> Normal s" by iprover
   moreover
   {
     fix s'
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
     have "\<Gamma>\<turnstile> c2 \<down> Normal s'"
     proof -
       from exec_to_exec_mark_guards [OF exec_c1]
       have "\<Gamma>\<turnstile>\<langle>mark_guards f c1,Normal s \<rangle> \<Rightarrow> Abrupt s'" by simp
       from termi_merge_c2 [rule_format, OF this] Catch.hyps
       show ?thesis
         by iprover
     qed
   }
   ultimately show ?case by (auto intro: terminates.intros)
 qed
 
 lemma terminates_mark_guards_to_terminates:
   "\<Gamma>\<turnstile>mark_guards f c\<down>s \<Longrightarrow> \<Gamma>\<turnstile>c\<down> s"
   by (cases s) (auto intro: terminates_mark_guards_to_terminates_Normal)
 
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "merge_guards"}\<close>
 (* ************************************************************************ *)
 
 lemma terminates_to_terminates_merge_guards:
   assumes termi: "\<Gamma>\<turnstile>c\<down>s"
   shows "\<Gamma>\<turnstile>merge_guards c\<down>s"
 using termi
 proof (induct)
   case (Guard s g c f)
   have s_in_g: "s \<in> g" by fact
   have termi_merge_c: "\<Gamma>\<turnstile>merge_guards c \<down> Normal s" by fact
   show ?case
   proof (cases "\<exists>f' g' c'. merge_guards c = Guard f' g' c'")
     case False
     hence "merge_guards (Guard f g c) = Guard f g (merge_guards c)"
       by (cases "merge_guards c") (auto simp add: Let_def)
     with s_in_g termi_merge_c show ?thesis
       by (auto intro: terminates.intros)
   next
     case True
     then obtain f' g' c' where
       mc: "merge_guards c = Guard f' g' c'"
       by blast
     show ?thesis
     proof (cases "f=f'")
       case False
       with mc have "merge_guards (Guard f g c) = Guard f g (merge_guards c)"
         by (simp add: Let_def)
       with s_in_g termi_merge_c show ?thesis
         by (auto intro: terminates.intros)
     next
       case True
       with mc have "merge_guards (Guard f g c) = Guard f (g \<inter> g') c'"
         by simp
       with s_in_g mc True termi_merge_c
       show ?thesis
         by (cases "s \<in> g'")
            (auto intro: terminates.intros elim: terminates_Normal_elim_cases)
     qed
   qed
 next
   case (GuardFault s g f c)
   have "s \<notin> g" by fact
   thus ?case
     by (cases "merge_guards c")
        (auto intro: terminates.intros split: if_split_asm simp add: Let_def)
 qed (fastforce intro: terminates.intros dest: exec_merge_guards_to_exec)+
 
 lemma terminates_merge_guards_to_terminates_Normal:
   shows "\<And>s. \<Gamma>\<turnstile>merge_guards c\<down>Normal s \<Longrightarrow> \<Gamma>\<turnstile>c\<down>Normal s"
 proof (induct c)
   case Skip thus ?case by (fastforce intro: terminates.intros)
 next
   case Basic thus ?case by (fastforce intro: terminates.intros)
 next
   case Spec thus ?case by (fastforce intro: terminates.intros)
 next
   case (Seq c1 c2)
   have "\<Gamma>\<turnstile>merge_guards (Seq c1 c2) \<down> Normal s" by fact
   then obtain
     termi_merge_c1: "\<Gamma>\<turnstile>merge_guards c1 \<down> Normal s" and
     termi_merge_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>merge_guards c1,Normal s \<rangle> \<Rightarrow> s' \<longrightarrow>
                            \<Gamma>\<turnstile>merge_guards c2 \<down> s'"
     by (auto elim: terminates_Normal_elim_cases)
   from termi_merge_c1 Seq.hyps
   have "\<Gamma>\<turnstile>c1 \<down> Normal s" by iprover
   moreover
   {
     fix s'
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
     have "\<Gamma>\<turnstile> c2 \<down> s'"
     proof -
       from exec_to_exec_merge_guards [OF exec_c1]
       have "\<Gamma>\<turnstile>\<langle>merge_guards c1,Normal s \<rangle> \<Rightarrow> s'" .
       from termi_merge_c2 [rule_format, OF this] Seq.hyps
       show ?thesis
         by (cases s') (auto)
     qed
   }
   ultimately show ?case by (auto intro: terminates.intros)
 next
   case Cond thus ?case
     by (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case (While b c)
   {
     fix u c'
     assume termi_c': "\<Gamma>\<turnstile>c' \<down> Normal u"
     assume c': "c' = merge_guards (While b c)"
     have "\<Gamma>\<turnstile>While b c \<down> Normal u"
       using termi_c' c'
     proof (induct)
       case (WhileTrue s b' c')
       have s_in_b: "s \<in> b" using WhileTrue by simp
       have "\<Gamma>\<turnstile>merge_guards c \<down> Normal s"
         using WhileTrue by (auto elim: terminates_Normal_elim_cases)
       with While.hyps have "\<Gamma>\<turnstile>c \<down> Normal s"
         by auto
       moreover
       have hyp_w: "\<forall>w. \<Gamma>\<turnstile>\<langle>merge_guards c,Normal s \<rangle> \<Rightarrow> w \<longrightarrow> \<Gamma>\<turnstile>While b c \<down> w"
         using WhileTrue by simp
       hence "\<forall>w. \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> w \<longrightarrow> \<Gamma>\<turnstile>While b c \<down> w"
         by (simp add: exec_iff_exec_merge_guards [symmetric])
       ultimately show ?case
         using s_in_b
         by (auto intro: terminates.intros)
     next
       case WhileFalse thus ?case by (auto intro: terminates.intros)
     qed auto
   }
   with While show ?case by simp
 next
   case Call thus ?case
     by (fastforce intro: terminates.intros )
 next
   case DynCom thus ?case
     by (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
 next
   case (Guard f g c)
   have termi_merge: "\<Gamma>\<turnstile>merge_guards (Guard f g c) \<down> Normal s" by fact
   show ?case
   proof (cases "\<exists>f' g' c'. merge_guards c = Guard f' g' c'")
     case False
     hence m: "merge_guards (Guard f g c) = Guard f g (merge_guards c)"
       by (cases "merge_guards c") (auto simp add: Let_def)
     from termi_merge Guard.hyps show ?thesis
       by (simp only: m)
          (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
   next
     case True
     then obtain f' g' c' where
       mc: "merge_guards c = Guard f' g' c'"
       by blast
     show ?thesis
     proof (cases "f=f'")
       case False
       with mc have m: "merge_guards (Guard f g c) = Guard f g (merge_guards c)"
         by (simp add: Let_def)
       from termi_merge Guard.hyps show ?thesis
       by (simp only: m)
          (fastforce intro: terminates.intros elim: terminates_Normal_elim_cases)
     next
       case True
       with mc have m: "merge_guards (Guard f g c) = Guard f (g \<inter> g') c'"
         by simp
       from termi_merge Guard.hyps
       show ?thesis
         by (simp only: m mc)
            (auto intro: terminates.intros elim: terminates_Normal_elim_cases)
     qed
   qed
 next
   case Throw thus ?case
     by (fastforce intro: terminates.intros )
 next
   case (Catch c1 c2)
   have "\<Gamma>\<turnstile>merge_guards (Catch c1 c2) \<down> Normal s" by fact
   then obtain
     termi_merge_c1: "\<Gamma>\<turnstile>merge_guards c1 \<down> Normal s" and
     termi_merge_c2: "\<forall>s'. \<Gamma>\<turnstile>\<langle>merge_guards c1,Normal s \<rangle> \<Rightarrow> Abrupt s' \<longrightarrow>
                            \<Gamma>\<turnstile>merge_guards c2 \<down> Normal s'"
     by (auto elim: terminates_Normal_elim_cases)
   from termi_merge_c1 Catch.hyps
   have "\<Gamma>\<turnstile>c1 \<down> Normal s" by iprover
   moreover
   {
     fix s'
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
     have "\<Gamma>\<turnstile> c2 \<down> Normal s'"
     proof -
       from exec_to_exec_merge_guards [OF exec_c1]
       have "\<Gamma>\<turnstile>\<langle>merge_guards c1,Normal s \<rangle> \<Rightarrow> Abrupt s'" .
       from termi_merge_c2 [rule_format, OF this] Catch.hyps
       show ?thesis
         by iprover
     qed
   }
   ultimately show ?case by (auto intro: terminates.intros)
 qed
 
 lemma terminates_merge_guards_to_terminates:
    "\<Gamma>\<turnstile>merge_guards c\<down> s \<Longrightarrow> \<Gamma>\<turnstile>c\<down> s"
 by (cases s) (auto intro: terminates_merge_guards_to_terminates_Normal)
 
 theorem terminates_iff_terminates_merge_guards:
   "\<Gamma>\<turnstile>c\<down> s = \<Gamma>\<turnstile>merge_guards c\<down> s"
   by (iprover intro: terminates_to_terminates_merge_guards
     terminates_merge_guards_to_terminates)
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{term "c\<^sub>1 \<subseteq>\<^sub>g c\<^sub>2"}\<close>
 (* ************************************************************************ *)
 
 lemma terminates_fewer_guards_Normal:
   shows "\<And>c s. \<lbrakk>\<Gamma>\<turnstile>c'\<down>Normal s; c \<subseteq>\<^sub>g c'; \<Gamma>\<turnstile>\<langle>c',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV\<rbrakk>
               \<Longrightarrow> \<Gamma>\<turnstile>c\<down>Normal s"
 proof (induct c')
   case Skip thus ?case by (auto intro: terminates.intros dest: subseteq_guardsD)
 next
   case Basic thus ?case by (auto intro: terminates.intros dest: subseteq_guardsD)
 next
   case Spec thus ?case by (auto intro: terminates.intros dest: subseteq_guardsD)
 next
   case (Seq c1' c2')
   have termi: "\<Gamma>\<turnstile>Seq c1' c2' \<down> Normal s" by fact
   then obtain
     termi_c1': "\<Gamma>\<turnstile>c1'\<down> Normal s" and
     termi_c2': "\<forall>s'. \<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow> s' \<longrightarrow> \<Gamma>\<turnstile>c2'\<down> s'"
     by (auto elim: terminates_Normal_elim_cases)
   have noFault: "\<Gamma>\<turnstile>\<langle>Seq c1' c2',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" by fact
   hence noFault_c1': "\<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
     by (auto intro: exec.intros simp add: final_notin_def)
   have "c \<subseteq>\<^sub>g Seq c1' c2'" by fact
   from subseteq_guards_Seq [OF this] obtain c1 c2 where
     c: "c = Seq c1 c2" and
     c1_c1': "c1 \<subseteq>\<^sub>g c1'" and
     c2_c2': "c2 \<subseteq>\<^sub>g c2'"
     by blast
   from termi_c1' c1_c1' noFault_c1'
   have "\<Gamma>\<turnstile>c1\<down> Normal s"
     by (rule Seq.hyps)
   moreover
   {
     fix t
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> t"
     have "\<Gamma>\<turnstile>c2\<down> t"
     proof -
       from exec_to_exec_subseteq_guards [OF c1_c1' exec_c1] obtain t' where
         exec_c1': "\<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow> t'" and
         t_Fault: "isFault t \<longrightarrow> isFault t'" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t' = t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         with exec_c1' noFault_c1'
         have False
           by (fastforce elim: isFaultE dest: Fault_end simp add: final_notin_def)
         thus ?thesis ..
       next
         case False
         with t'_noFault have t': "t'=t" by simp
         with termi_c2' exec_c1'
         have termi_c2': "\<Gamma>\<turnstile>c2'\<down> t"
           by auto
         show ?thesis
         proof (cases t)
           case Fault thus ?thesis by auto
         next
           case Abrupt thus ?thesis by auto
         next
           case Stuck thus ?thesis by auto
         next
           case (Normal u)
           with noFault exec_c1' t'
           have "\<Gamma>\<turnstile>\<langle>c2',Normal u \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
             by (auto intro: exec.intros simp add: final_notin_def)
           from termi_c2' [simplified Normal] c2_c2' this
           have "\<Gamma>\<turnstile>c2 \<down> Normal u"
             by (rule Seq.hyps)
           with Normal exec_c1
           show ?thesis by simp
         qed
       qed
     qed
   }
   ultimately show ?case using c by (auto intro: terminates.intros)
 next
   case (Cond b c1' c2')
   have noFault: "\<Gamma>\<turnstile>\<langle>Cond b c1' c2',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" by fact
   have termi: "\<Gamma>\<turnstile>Cond b c1' c2' \<down> Normal s" by fact
   have "c \<subseteq>\<^sub>g Cond b c1' c2'" by fact
   from subseteq_guards_Cond [OF this] obtain c1 c2 where
     c: "c = Cond b c1 c2" and
     c1_c1': "c1 \<subseteq>\<^sub>g c1'" and
     c2_c2': "c2 \<subseteq>\<^sub>g c2'"
     by blast
   thus ?case
   proof (cases "s \<in> b")
     case True
     with termi have termi_c1': "\<Gamma>\<turnstile>c1' \<down> Normal s"
       by (auto elim: terminates_Normal_elim_cases)
     from True noFault have "\<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
       by (auto intro: exec.intros simp add: final_notin_def)
     from termi_c1' c1_c1' this
     have "\<Gamma>\<turnstile>c1 \<down> Normal s"
       by (rule Cond.hyps)
     with True c show ?thesis
       by (auto intro: terminates.intros)
   next
     case False
     with termi have termi_c2': "\<Gamma>\<turnstile>c2' \<down> Normal s"
       by (auto elim: terminates_Normal_elim_cases)
     from False noFault have "\<Gamma>\<turnstile>\<langle>c2',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
       by (auto intro: exec.intros simp add: final_notin_def)
     from termi_c2' c2_c2' this
     have "\<Gamma>\<turnstile>c2 \<down> Normal s"
       by (rule Cond.hyps)
     with False c show ?thesis
       by (auto intro: terminates.intros)
   qed
 next
   case (While b c')
   have noFault: "\<Gamma>\<turnstile>\<langle>While b c',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" by fact
   have termi: "\<Gamma>\<turnstile>While b c' \<down> Normal s" by fact
   have "c \<subseteq>\<^sub>g While b c'" by fact
   from subseteq_guards_While [OF this]
   obtain c'' where
     c: "c = While b c''" and
     c''_c': "c'' \<subseteq>\<^sub>g c'"
     by blast
   {
     fix d u
     assume termi: "\<Gamma>\<turnstile>d \<down> u"
     assume d: "d = While b c'"
     assume noFault: "\<Gamma>\<turnstile>\<langle>While b c',u \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
     have "\<Gamma>\<turnstile>While b c'' \<down> u"
     using termi d noFault
     proof (induct)
       case (WhileTrue u b' c''')
       have u_in_b: "u \<in> b" using WhileTrue by simp
       have termi_c': "\<Gamma>\<turnstile>c' \<down> Normal u" using WhileTrue by simp
       have noFault: "\<Gamma>\<turnstile>\<langle>While b c',Normal u \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" using WhileTrue by simp
       hence noFault_c': "\<Gamma>\<turnstile>\<langle>c',Normal u \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" using u_in_b
         by (auto intro: exec.intros simp add: final_notin_def)
       from While.hyps [OF termi_c' c''_c' this]
       have "\<Gamma>\<turnstile>c'' \<down> Normal u".
       moreover
       from WhileTrue
       have hyp_w: "\<forall>s'. \<Gamma>\<turnstile>\<langle>c',Normal u \<rangle> \<Rightarrow> s'  \<longrightarrow> \<Gamma>\<turnstile>\<langle>While b c',s' \<rangle> \<Rightarrow>\<notin>Fault ` UNIV
                         \<longrightarrow> \<Gamma>\<turnstile>While b c'' \<down> s'"
         by simp
       {
         fix v
         assume exec_c'': "\<Gamma>\<turnstile>\<langle>c'',Normal u \<rangle> \<Rightarrow> v"
         have "\<Gamma>\<turnstile>While b c'' \<down> v"
         proof -
           from exec_to_exec_subseteq_guards [OF c''_c' exec_c''] obtain v' where
             exec_c': "\<Gamma>\<turnstile>\<langle>c',Normal u \<rangle> \<Rightarrow> v'" and
             v_Fault: "isFault v \<longrightarrow> isFault v'" and
             v'_noFault: "\<not> isFault v' \<longrightarrow> v' = v"
             by auto
           show ?thesis
           proof (cases "isFault v'")
             case True
             with exec_c' noFault u_in_b
             have False
               by (fastforce
                    simp add: final_notin_def intro: exec.intros elim: isFaultE)
             thus ?thesis ..
           next
             case False
             with v'_noFault have v': "v'=v"
               by simp
             with noFault exec_c' u_in_b
             have "\<Gamma>\<turnstile>\<langle>While b c',v \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
               by (fastforce simp add: final_notin_def intro: exec.intros)
             from hyp_w [rule_format, OF exec_c' [simplified v'] this]
             show "\<Gamma>\<turnstile>While b c'' \<down> v" .
           qed
         qed
       }
       ultimately
       show ?case using u_in_b
         by (auto intro: terminates.intros)
     next
       case WhileFalse thus ?case by (auto intro: terminates.intros)
     qed auto
   }
   with c noFault termi show ?case
     by auto
 next
   case Call thus ?case by (auto intro: terminates.intros dest: subseteq_guardsD)
 next
   case (DynCom C')
   have termi: "\<Gamma>\<turnstile>DynCom C' \<down> Normal s" by fact
   hence termi_C': "\<Gamma>\<turnstile>C' s \<down> Normal s"
     by cases
   have noFault: "\<Gamma>\<turnstile>\<langle>DynCom C',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" by fact
   hence noFault_C': "\<Gamma>\<turnstile>\<langle>C' s,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
     by (auto intro: exec.intros simp add: final_notin_def)
   have "c \<subseteq>\<^sub>g DynCom C'" by fact
   from subseteq_guards_DynCom [OF this] obtain C where
     c: "c = DynCom C" and
     C_C': "\<forall>s. C s \<subseteq>\<^sub>g C' s"
     by blast
   from DynCom.hyps termi_C' C_C' [rule_format] noFault_C'
   have "\<Gamma>\<turnstile>C s \<down> Normal s"
     by fast
   with c show ?case
     by (auto intro: terminates.intros)
 next
   case (Guard f' g' c')
   have noFault: "\<Gamma>\<turnstile>\<langle>Guard f' g' c',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" by fact
   have termi: "\<Gamma>\<turnstile>Guard f' g' c' \<down> Normal s" by fact
   have "c \<subseteq>\<^sub>g Guard f' g' c'" by fact
   hence c_cases: "(c \<subseteq>\<^sub>g c') \<or> (\<exists>c''. c = Guard f' g' c'' \<and> (c'' \<subseteq>\<^sub>g c'))"
     by (rule subseteq_guards_Guard)
   thus ?case
   proof (cases "s \<in> g'")
     case True
     note s_in_g' = this
     with noFault have noFault_c': "\<Gamma>\<turnstile>\<langle>c',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
       by (auto simp add: final_notin_def intro: exec.intros)
     from termi s_in_g' have termi_c': "\<Gamma>\<turnstile>c' \<down> Normal s"
       by cases auto
     from c_cases show ?thesis
     proof
       assume "c \<subseteq>\<^sub>g c'"
       from termi_c' this noFault_c'
       show "\<Gamma>\<turnstile>c \<down> Normal s"
         by (rule Guard.hyps)
     next
       assume "\<exists>c''. c = Guard f' g' c'' \<and> (c'' \<subseteq>\<^sub>g c')"
       then obtain c'' where
         c: "c = Guard f' g' c''" and c''_c': "c'' \<subseteq>\<^sub>g c'"
         by blast
       from termi_c' c''_c' noFault_c'
       have "\<Gamma>\<turnstile>c'' \<down> Normal s"
         by (rule Guard.hyps)
       with s_in_g' c
       show ?thesis
         by (auto intro: terminates.intros)
     qed
   next
     case False
     with noFault have False
       by (auto intro: exec.intros simp add: final_notin_def)
     thus ?thesis ..
   qed
 next
   case Throw thus ?case by (auto intro: terminates.intros dest: subseteq_guardsD)
 next
   case (Catch c1' c2')
   have termi: "\<Gamma>\<turnstile>Catch c1' c2' \<down> Normal s" by fact
   then obtain
     termi_c1': "\<Gamma>\<turnstile>c1'\<down> Normal s" and
     termi_c2': "\<forall>s'. \<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow> Abrupt s' \<longrightarrow> \<Gamma>\<turnstile>c2'\<down> Normal s'"
     by (auto elim: terminates_Normal_elim_cases)
   have noFault: "\<Gamma>\<turnstile>\<langle>Catch c1' c2',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV" by fact
   hence noFault_c1': "\<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
     by (fastforce intro: exec.intros simp add: final_notin_def)
   have "c \<subseteq>\<^sub>g Catch c1' c2'"  by fact
   from subseteq_guards_Catch [OF this] obtain c1 c2 where
     c: "c = Catch c1 c2" and
     c1_c1': "c1 \<subseteq>\<^sub>g c1'" and
     c2_c2': "c2 \<subseteq>\<^sub>g c2'"
     by blast
   from termi_c1' c1_c1' noFault_c1'
   have "\<Gamma>\<turnstile>c1\<down> Normal s"
     by (rule Catch.hyps)
   moreover
   {
     fix t
     assume exec_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt t"
     have "\<Gamma>\<turnstile>c2\<down> Normal t"
     proof -
       from exec_to_exec_subseteq_guards [OF c1_c1' exec_c1] obtain t' where
         exec_c1': "\<Gamma>\<turnstile>\<langle>c1',Normal s \<rangle> \<Rightarrow> t'" and
         t'_noFault: "\<not> isFault t' \<longrightarrow> t' = Abrupt t"
         by blast
       show ?thesis
       proof (cases "isFault t'")
         case True
         with exec_c1' noFault_c1'
         have False
           by (fastforce elim: isFaultE dest: Fault_end simp add: final_notin_def)
         thus ?thesis ..
       next
         case False
         with t'_noFault have t': "t'=Abrupt t" by simp
         with termi_c2' exec_c1'
         have termi_c2': "\<Gamma>\<turnstile>c2'\<down> Normal t"
           by auto
         with noFault exec_c1' t'
         have "\<Gamma>\<turnstile>\<langle>c2',Normal t \<rangle> \<Rightarrow>\<notin>Fault ` UNIV"
           by (auto intro: exec.intros simp add: final_notin_def)
         from termi_c2' c2_c2' this
         show "\<Gamma>\<turnstile>c2 \<down> Normal t"
           by (rule Catch.hyps)
       qed
     qed
   }
   ultimately show ?case using c by (auto intro: terminates.intros)
 qed
 
 theorem terminates_fewer_guards:
   shows "\<lbrakk>\<Gamma>\<turnstile>c'\<down>s; c \<subseteq>\<^sub>g c'; \<Gamma>\<turnstile>\<langle>c',s \<rangle> \<Rightarrow>\<notin>Fault ` UNIV\<rbrakk>
          \<Longrightarrow> \<Gamma>\<turnstile>c\<down>s"
   by (cases s) (auto intro: terminates_fewer_guards_Normal)
 
 lemma terminates_noFault_strip_guards:
   assumes termi: "\<Gamma>\<turnstile>c\<down>Normal s"
   shows "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>strip_guards F c\<down>Normal s"
 using termi
 proof (induct)
   case Skip thus ?case by (auto intro: terminates.intros)
 next
   case Basic thus ?case by (auto intro: terminates.intros)
 next
   case Spec thus ?case by (auto intro: terminates.intros)
 next
   case (Guard s g c f)
   have s_in_g: "s \<in> g" by fact
   have "\<Gamma>\<turnstile>c \<down> Normal s" by fact
   have "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   with s_in_g have "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (fastforce simp add: final_notin_def intro: exec.intros)
   with Guard.hyps have "\<Gamma>\<turnstile>strip_guards F c \<down> Normal s" by simp
   with s_in_g show ?case
     by (auto intro: terminates.intros)
 next
   case GuardFault thus ?case
     by (auto intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case Fault thus ?case by (auto intro: terminates.intros)
 next
   case (Seq c1 s c2)
   have noFault_Seq: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   hence noFault_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (auto simp add: final_notin_def intro: exec.intros)
   with Seq.hyps have "\<Gamma>\<turnstile>strip_guards F c1 \<down> Normal s" by simp
   moreover
   {
     fix s'
     assume exec_strip_guards_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s \<rangle> \<Rightarrow> s'"
     have "\<Gamma>\<turnstile>strip_guards F c2 \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis by (auto elim: isFaultE intro: terminates.intros)
     next
       case False
       with exec_strip_guards_to_exec [OF exec_strip_guards_c1] noFault_c1
       have *: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
         by (auto simp add: final_notin_def elim!: isFaultE)
       with noFault_Seq have "\<Gamma>\<turnstile>\<langle>c2,s' \<rangle> \<Rightarrow>\<notin>Fault ` F"
         by (auto simp add: final_notin_def intro: exec.intros)
       with * show ?thesis
         using Seq.hyps by simp
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 next
   case CondTrue thus ?case
     by (fastforce intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case CondFalse thus ?case
     by (fastforce intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case (WhileTrue s b c)
   have s_in_b: "s \<in> b" by fact
   have noFault_while: "\<Gamma>\<turnstile>\<langle>While b c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   with s_in_b have noFault_c: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (auto simp add: final_notin_def intro: exec.intros)
   with WhileTrue.hyps have "\<Gamma>\<turnstile>strip_guards F c \<down> Normal s" by simp
   moreover
   {
     fix s'
     assume exec_strip_guards_c: "\<Gamma>\<turnstile>\<langle>strip_guards F c,Normal s \<rangle> \<Rightarrow> s'"
     have "\<Gamma>\<turnstile>strip_guards F (While b c) \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis by (auto elim: isFaultE intro: terminates.intros)
     next
       case False
       with exec_strip_guards_to_exec [OF exec_strip_guards_c] noFault_c
       have *: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> s'"
         by (auto simp add: final_notin_def elim!: isFaultE)
       with s_in_b noFault_while have "\<Gamma>\<turnstile>\<langle>While b c,s' \<rangle> \<Rightarrow>\<notin>Fault ` F"
         by (auto simp add: final_notin_def intro: exec.intros)
       with * show ?thesis
         using WhileTrue.hyps by simp
     qed
   }
   ultimately show ?case
     using WhileTrue.hyps by (auto intro: terminates.intros)
 next
   case WhileFalse thus ?case by (auto intro: terminates.intros)
 next
   case Call thus ?case by (auto intro: terminates.intros)
 next
   case CallUndefined thus ?case by (auto intro: terminates.intros)
 next
   case Stuck thus ?case by (auto intro: terminates.intros)
 next
   case DynCom thus ?case
     by (auto intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case Throw thus ?case by (auto intro: terminates.intros)
 next
   case Abrupt thus ?case by (auto intro: terminates.intros)
 next
   case (Catch c1 s c2)
   have noFault_Catch: "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   hence noFault_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (fastforce simp add: final_notin_def intro: exec.intros)
   with Catch.hyps have "\<Gamma>\<turnstile>strip_guards F c1 \<down> Normal s" by simp
   moreover
   {
     fix s'
     assume exec_strip_guards_c1: "\<Gamma>\<turnstile>\<langle>strip_guards F c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
     have "\<Gamma>\<turnstile>strip_guards F c2 \<down> Normal s'"
     proof -
       from exec_strip_guards_to_exec [OF exec_strip_guards_c1] noFault_c1
       have *: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
         by (auto simp add: final_notin_def elim!: isFaultE)
       with noFault_Catch have "\<Gamma>\<turnstile>\<langle>c2,Normal s' \<rangle> \<Rightarrow>\<notin>Fault ` F"
         by (auto simp add: final_notin_def intro: exec.intros)
       with * show ?thesis
         using Catch.hyps by simp
     qed
   }
   ultimately show ?case
     using Catch.hyps by (auto intro: terminates.intros)
 qed
 
 (* ************************************************************************* *)
 subsection \<open>Lemmas about @{const "strip_guards"}\<close>
 (* ************************************************************************* *)
 
 lemma terminates_noFault_strip:
   assumes termi: "\<Gamma>\<turnstile>c\<down>Normal s"
   shows "\<lbrakk>\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F\<rbrakk> \<Longrightarrow> strip F \<Gamma>\<turnstile>c\<down>Normal s"
 using termi
 proof (induct)
   case Skip thus ?case by (auto intro: terminates.intros)
 next
   case Basic thus ?case by (auto intro: terminates.intros)
 next
   case Spec thus ?case by (auto intro: terminates.intros)
 next
   case (Guard s g c f)
   have s_in_g: "s \<in> g" by fact
   have "\<Gamma>\<turnstile>\<langle>Guard f g c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   with s_in_g have "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (fastforce simp add: final_notin_def intro: exec.intros)
   then have "strip F \<Gamma>\<turnstile>c \<down> Normal s" by (simp add: Guard.hyps)
   with s_in_g show ?case
     by (auto intro: terminates.intros simp del: strip_simp)
 next
   case GuardFault thus ?case
     by (auto intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case Fault thus ?case by (auto intro: terminates.intros)
 next
   case (Seq c1 s c2)
   have noFault_Seq: "\<Gamma>\<turnstile>\<langle>Seq c1 c2,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   hence noFault_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (auto simp add: final_notin_def intro: exec.intros)
   then have "strip F \<Gamma>\<turnstile>c1 \<down> Normal s" by (simp add: Seq.hyps)
   moreover
   {
     fix s'
     assume exec_strip_c1: "strip F \<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
     have "strip F \<Gamma>\<turnstile>c2 \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis by (auto elim: isFaultE intro: terminates.intros)
     next
       case False
       with exec_strip_to_exec [OF exec_strip_c1] noFault_c1
       have *: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
         by (auto simp add: final_notin_def elim!: isFaultE)
       with noFault_Seq have "\<Gamma>\<turnstile>\<langle>c2,s' \<rangle> \<Rightarrow>\<notin>Fault ` F"
         by (auto simp add: final_notin_def intro: exec.intros)
       with * show ?thesis
         using Seq.hyps by (simp del: strip_simp)
     qed
   }
   ultimately show ?case
     by (fastforce intro: terminates.intros)
 next
   case CondTrue thus ?case
     by (fastforce intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case CondFalse thus ?case
     by (fastforce intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case (WhileTrue s b c)
   have s_in_b: "s \<in> b" by fact
   have noFault_while: "\<Gamma>\<turnstile>\<langle>While b c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   with s_in_b have noFault_c: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (auto simp add: final_notin_def intro: exec.intros)
   then have "strip F \<Gamma>\<turnstile>c \<down> Normal s" by (simp add: WhileTrue.hyps)
   moreover
   {
     fix s'
     assume exec_strip_c: "strip F \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> s'"
     have "strip F \<Gamma>\<turnstile>While b c \<down> s'"
     proof (cases "isFault s'")
       case True
       thus ?thesis by (auto elim: isFaultE intro: terminates.intros)
     next
       case False
       with exec_strip_to_exec [OF exec_strip_c] noFault_c
       have *: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> s'"
         by (auto simp add: final_notin_def elim!: isFaultE)
       with s_in_b noFault_while have "\<Gamma>\<turnstile>\<langle>While b c,s' \<rangle> \<Rightarrow>\<notin>Fault ` F"
         by (auto simp add: final_notin_def intro: exec.intros)
       with * show ?thesis
         using WhileTrue.hyps by (simp del: strip_simp)
     qed
   }
   ultimately show ?case
     using WhileTrue.hyps by (auto intro: terminates.intros simp del: strip_simp)
 next
   case WhileFalse thus ?case by (auto intro: terminates.intros)
 next
   case (Call p bdy s)
   have bdy: "\<Gamma> p = Some bdy" by fact
   have "\<Gamma>\<turnstile>\<langle>Call p,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   with bdy have bdy_noFault: "\<Gamma>\<turnstile>\<langle>bdy,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (auto intro: exec.intros simp add: final_notin_def)
   then have strip_bdy_noFault: "strip F \<Gamma>\<turnstile>\<langle>bdy,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (auto simp add: final_notin_def dest!: exec_strip_to_exec elim!: isFaultE)
 
   from bdy_noFault have "strip F \<Gamma>\<turnstile>bdy \<down> Normal s" by (simp add: Call.hyps)
   from terminates_noFault_strip_guards [OF this strip_bdy_noFault]
   have "strip F \<Gamma>\<turnstile>strip_guards F bdy \<down> Normal s".
   with bdy show ?case
     by (fastforce intro: terminates.Call)
 next
   case CallUndefined thus ?case by (auto intro: terminates.intros)
 next
   case Stuck thus ?case by (auto intro: terminates.intros)
 next
   case DynCom thus ?case
     by (auto intro: terminates.intros exec.intros simp add: final_notin_def )
 next
   case Throw thus ?case by (auto intro: terminates.intros)
 next
   case Abrupt thus ?case by (auto intro: terminates.intros)
 next
   case (Catch c1 s c2)
   have noFault_Catch: "\<Gamma>\<turnstile>\<langle>Catch c1 c2,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F" by fact
   hence noFault_c1: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow>\<notin>Fault ` F"
     by (fastforce simp add: final_notin_def intro: exec.intros)
   then have "strip F \<Gamma>\<turnstile>c1 \<down> Normal s" by (simp add: Catch.hyps)
   moreover
   {
     fix s'
     assume exec_strip_c1: "strip F \<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
     have "strip F \<Gamma>\<turnstile>c2 \<down> Normal s'"
     proof -
       from exec_strip_to_exec [OF exec_strip_c1] noFault_c1
       have *: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
         by (auto simp add: final_notin_def elim!: isFaultE)
       with * noFault_Catch have "\<Gamma>\<turnstile>\<langle>c2,Normal s' \<rangle> \<Rightarrow>\<notin>Fault ` F"
         by (auto simp add: final_notin_def intro: exec.intros)
       with * show ?thesis
         using Catch.hyps by (simp del: strip_simp)
     qed
   }
   ultimately show ?case
     using Catch.hyps by (auto intro: terminates.intros simp del: strip_simp)
 qed
 
 
 (* ************************************************************************* *)
 subsection \<open>Miscellaneous\<close>
 (* ************************************************************************* *)
 
 lemma terminates_while_lemma:
   assumes termi: "\<Gamma>\<turnstile>w\<down>fk"
   shows "\<And>k b c. \<lbrakk>fk = Normal (f k); w=While b c;
                        \<forall>i. \<Gamma>\<turnstile>\<langle>c,Normal (f i) \<rangle> \<Rightarrow> Normal (f (Suc i))\<rbrakk>
          \<Longrightarrow> \<exists>i. f i \<notin> b"
 using termi
 proof (induct)
   case WhileTrue thus ?case by blast
 next
   case WhileFalse thus ?case by blast
 qed simp_all
 
 lemma terminates_while:
   "\<lbrakk>\<Gamma>\<turnstile>(While b c)\<down>Normal (f k);
     \<forall>i. \<Gamma>\<turnstile>\<langle>c,Normal (f i) \<rangle> \<Rightarrow> Normal (f (Suc i))\<rbrakk>
          \<Longrightarrow> \<exists>i. f i \<notin> b"
   by (blast intro: terminates_while_lemma)
 
 lemma wf_terminates_while:
  "wf {(t,s). \<Gamma>\<turnstile>(While b c)\<down>Normal s \<and> s\<in>b \<and>
              \<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> Normal t}"
 apply(subst wf_iff_no_infinite_down_chain)
 apply(rule notI)
 apply clarsimp
 apply(insert terminates_while)
 apply blast
 done
 
 lemma terminates_restrict_to_terminates:
   assumes terminates_res: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile> c \<down> s"
   assumes not_Stuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c,s \<rangle> \<Rightarrow>\<notin>{Stuck}"
   shows "\<Gamma>\<turnstile> c \<down> s"
 using terminates_res not_Stuck
 proof (induct)
   case Skip show ?case by (rule terminates.Skip)
 next
   case Basic show ?case by (rule terminates.Basic)
 next
   case Spec show ?case by (rule terminates.Spec)
 next
   case Guard thus ?case
     by (auto intro: terminates.Guard dest: notStuck_GuardD)
 next
   case GuardFault thus ?case by (auto intro: terminates.GuardFault)
 next
   case Fault show ?case by (rule terminates.Fault)
 next
   case (Seq c1 s c2)
   have not_Stuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>Seq c1 c2,Normal s \<rangle> \<Rightarrow>\<notin>{Stuck}" by fact
   hence c1_notStuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow>\<notin>{Stuck}"
     by (rule notStuck_SeqD1)
   show "\<Gamma>\<turnstile>Seq c1 c2 \<down> Normal s"
   proof (rule terminates.Seq,safe)
     from c1_notStuck
     show "\<Gamma>\<turnstile>c1 \<down> Normal s"
       by (rule Seq.hyps)
   next
     fix s'
     assume exec: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> s'"
     show "\<Gamma>\<turnstile>c2 \<down> s'"
     proof -
       from exec_to_exec_restrict [OF exec] obtain t' where
         exec_res: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> t'" and
         t'_notStuck: "t' \<noteq> Stuck \<longrightarrow> t' = s'"
         by blast
       show ?thesis
       proof (cases "t'=Stuck")
         case True
         with c1_notStuck exec_res have "False"
           by (auto simp add: final_notin_def)
         thus ?thesis ..
       next
         case False
         with t'_notStuck have t': "t'=s'" by simp
         with not_Stuck exec_res
         have "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c2,s' \<rangle> \<Rightarrow>\<notin>{Stuck}"
           by (auto dest: notStuck_SeqD2)
         with exec_res t' Seq.hyps
         show ?thesis
           by auto
       qed
     qed
   qed
 next
   case CondTrue thus ?case
     by (auto intro: terminates.CondTrue dest: notStuck_CondTrueD)
 next
   case CondFalse thus ?case
     by (auto intro: terminates.CondFalse dest: notStuck_CondFalseD)
 next
   case (WhileTrue s b c)
   have s: "s \<in> b" by fact
   have not_Stuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>While b c,Normal s \<rangle> \<Rightarrow>\<notin>{Stuck}" by fact
   with WhileTrue have c_notStuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow>\<notin>{Stuck}"
     by (iprover intro:  notStuck_WhileTrueD1)
   show ?case
   proof (rule terminates.WhileTrue [OF s],safe)
     from c_notStuck
     show "\<Gamma>\<turnstile>c \<down> Normal s"
       by (rule WhileTrue.hyps)
   next
     fix s'
     assume exec: "\<Gamma>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> s'"
     show "\<Gamma>\<turnstile>While b c \<down> s'"
     proof -
       from exec_to_exec_restrict [OF exec] obtain t' where
         exec_res: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c,Normal s \<rangle> \<Rightarrow> t'" and
         t'_notStuck: "t' \<noteq> Stuck \<longrightarrow> t' = s'"
         by blast
       show ?thesis
       proof (cases "t'=Stuck")
         case True
         with c_notStuck exec_res have "False"
           by (auto simp add: final_notin_def)
         thus ?thesis ..
       next
         case False
         with t'_notStuck have t': "t'=s'" by simp
         with not_Stuck exec_res s
         have "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>While b c,s' \<rangle> \<Rightarrow>\<notin>{Stuck}"
           by (auto dest: notStuck_WhileTrueD2)
         with exec_res t' WhileTrue.hyps
         show ?thesis
           by auto
       qed
     qed
   qed
 next
   case WhileFalse then show ?case by (iprover intro: terminates.WhileFalse)
 next
   case Call thus ?case
     by (auto intro: terminates.Call dest: notStuck_CallD restrict_SomeD)
 next
   case CallUndefined
   thus ?case
     by (auto dest: notStuck_CallDefinedD)
 next
   case Stuck show ?case by (rule terminates.Stuck)
 next
   case DynCom
   thus ?case
     by (auto intro: terminates.DynCom dest: notStuck_DynComD)
 next
   case Throw show ?case by (rule terminates.Throw)
 next
   case Abrupt show ?case by (rule terminates.Abrupt)
 next
   case (Catch c1 s c2)
   have not_Stuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>Catch c1 c2,Normal s \<rangle> \<Rightarrow>\<notin>{Stuck}" by fact
   hence c1_notStuck: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow>\<notin>{Stuck}"
     by (rule notStuck_CatchD1)
   show "\<Gamma>\<turnstile>Catch c1 c2 \<down> Normal s"
   proof (rule terminates.Catch,safe)
     from c1_notStuck
     show "\<Gamma>\<turnstile>c1 \<down> Normal s"
       by (rule Catch.hyps)
   next
     fix s'
     assume exec: "\<Gamma>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> Abrupt s'"
     show "\<Gamma>\<turnstile>c2 \<down> Normal s'"
     proof -
       from exec_to_exec_restrict [OF exec] obtain t' where
         exec_res: "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c1,Normal s \<rangle> \<Rightarrow> t'" and
         t'_notStuck: "t' \<noteq> Stuck \<longrightarrow> t' = Abrupt s'"
         by blast
       show ?thesis
       proof (cases "t'=Stuck")
         case True
         with c1_notStuck exec_res have "False"
           by (auto simp add: final_notin_def)
         thus ?thesis ..
       next
         case False
         with t'_notStuck have t': "t'=Abrupt s'" by simp
         with not_Stuck exec_res
         have "\<Gamma>|\<^bsub>M\<^esub>\<turnstile>\<langle>c2,Normal s' \<rangle> \<Rightarrow>\<notin>{Stuck}"
           by (auto dest: notStuck_CatchD2)
         with exec_res t' Catch.hyps
         show ?thesis
           by auto
       qed
     qed
   qed
 qed
 
 end
diff --git a/thys/Simpl/UserGuide.thy b/thys/Simpl/UserGuide.thy
--- a/thys/Simpl/UserGuide.thy
+++ b/thys/Simpl/UserGuide.thy
@@ -1,1583 +1,1564 @@
 (*  Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      UserGuide.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
 section \<open>User Guide \label{sec:UserGuide}\<close>
 (*<*)
 theory UserGuide
 imports HeapList Vcg
   "HOL-Statespace.StateSpaceSyntax" "HOL-Library.LaTeXsugar"
 begin
 (*>*)
 
 (*<*)
 syntax
  "_statespace_updates" :: "('a \<Rightarrow> 'b) \<Rightarrow> updbinds \<Rightarrow> ('a \<Rightarrow> 'b)" ("_\<langle>_\<rangle>" [900,0] 900)
 (*>*)
 
 
 
 text \<open>
 We introduce the verification environment with a couple
 of examples that illustrate how to use the different
 bits and pieces to verify programs.
 \<close>
 
 
 subsection \<open>Basics\<close>
 
 text \<open>
 
 First of all we have to decide how to represent the state space. There
 are currently two implementations. One is based on records the other
 one on the concept called `statespace' that was introduced with
 Isabelle 2007 (see \texttt{HOL/Statespace}) . In contrast to records a
 'satespace' does not define a new type, but provides a notion of state,
 based on locales. Logically
 the state is modelled as a function from (abstract) names to
 (abstract) values and the statespace infrastructure organises
 distinctness of names an projection/injection of concrete values into
 the abstract one. Towards the user the interface of records and
 statespaces is quite similar. However, statespaces offer more
 flexibility, inherited from the locale infrastructure, in
 particular multiple inheritance and renaming of components.
 
 In this user guide we prefer statespaces, but give some comments on
 the usage of records in Section \ref{sec:records}.
 
 
 \<close>
 
 hoarestate vars =
   A :: nat
   I :: nat
   M :: nat
   N :: nat
   R :: nat
   S :: nat
 
 text (in vars) \<open>The command \isacommand{hoarestate} is a simple preprocessor
 for the command \isacommand{statespaces} which decorates the state
 components with the suffix \<open>_'\<close>, to avoid cluttering the
 namespace. Also note that underscores are printed as hyphens in this
 documentation. So what you see as @{term "A_'"} in this document is
 actually \texttt{A\_'}.  Every component name becomes a fixed variable in
 the locale \<open>vars\<close> and can no longer be used for logical
 variables.
 
 Lookup of a component @{term "A_'"} in a state @{term "s"} is written as
 @{term "s\<cdot>A_'"}, and update with a value @{term "term v"} as @{term "s\<langle>A_' := v\<rangle>"}.
 
 To deal with local and global variables in the context of procedures the
 program state is organised as a record containing the two componets @{const "locals"}
 and @{const "globals"}. The variables defined in hoarestate \<open>vars\<close> reside
 in the @{const "locals"} part.
 
 \<close>
 
 text \<open>
   Here is a first example.
 \<close>
 
 lemma (in vars) "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   apply vcg
   txt \<open>@{subgoals}\<close>
   apply simp
   txt \<open>@{subgoals}\<close>
   done
 
 text \<open>We enable the locale of statespace \<open>vars\<close> by the
 \texttt{in vars} directive.  The verification condition generator is
 invoked via the \<open>vcg\<close> method and leaves us with the expected
 subgoal that can be proved by simplification.\<close>
 
 text (in vars) \<open>
  If we refer to components (variables) of the state-space of the program
  we always mark these with \<open>\<acute>\<close> (in assertions and also in the
  program itself). It is the acute-symbol and is present on
  most keyboards. The assertions of the Hoare tuple are
  ordinary Isabelle sets. As we usually want to refer to the state space
  in the assertions, we provide special brackets for them. They can be written
  as {\verb+{| |}+} in ASCII or \<open>\<lbrace> \<rbrace>\<close> with symbols. Internally,
  marking variables has two effects. First of all we refer to the implicit
  state and secondary we get rid of the suffix \<open>_'\<close>.
  So the assertion @{term "{|\<acute>N = 5|}"} internally gets expanded to
  \<open>{s. locals s \<cdot>N_' = 5}\<close> written in ordinary set comprehension notation of
  Isabelle. It describes the set of states where the \<open>N_'\<close> component
  is equal to \<open>5\<close>.
  An empty context and an empty postcondition for abrupt termination can be
  omitted. The lemma above is a shorthand for
   \<open>\<Gamma>,{}\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>,{}\<close>.
 \<close>
 
 text \<open>We can step through verification condition generation by the
 method \<open>vcg_step\<close>.
 \<close>
 
 lemma (in vars) "\<Gamma>,{}\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   apply vcg_step
   txt \<open>@{subgoals}\<close>
   txt \<open>The last step of verification condition generation,
          transforms the inclusion of state sets to the corresponding
          predicate on components of the state space.
 \<close>
   apply vcg_step
   txt \<open>@{subgoals}\<close>
   by simp
 
 text \<open>
 Although our assertions work semantically on the state space, stepping
 through verification condition generation ``feels'' like the expected
 syntactic substitutions of traditional Hoare logic. This is achieved
 by light simplification on the assertions calculated by the Hoare rules.
 \<close>
 
 lemma (in vars) "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   apply (rule HoarePartial.Basic)
   txt \<open>@{subgoals}\<close>
   apply (simp only: mem_Collect_eq)
   txt \<open>@{subgoals}\<close>
   apply (tactic
     \<open>Hoare.BasicSimpTac @{context} Hoare.Function false
        [] (K all_tac) 1\<close>)
   txt \<open>@{subgoals}\<close>
   by simp
 
 
 text \<open>The next example shows how we deal with the while loop. Note the
 invariant annotation.
 \<close>
 
 lemma (in vars)
   "\<Gamma>,{}\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           WHILE \<acute>M \<noteq> a
           INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
           DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
   apply vcg
   txt \<open>@{subgoals [display]}\<close>
   txt \<open>The verification condition generator gives us three proof obligations,
          stemming from the path from the precondition to the invariant,
          from the invariant together with loop condition through the
          loop body to the invariant, and finally from the invariant together
          with the negated loop condition to the postcondition.\<close>
   apply auto
   done
 
 subsection \<open>Procedures\<close>
 
 subsubsection \<open>Declaration\<close>
 
 text \<open>
 Our first procedure is a simple square procedure. We provide the
 command \isacommand{procedures}, to declare and define a
 procedure.
 \<close>
 
 procedures
   Square (N::nat|R::nat)
   where I::nat in
   "\<acute>R :== \<acute>N * \<acute>N"
 
 
 
 text \<open>A procedure is given by the signature of the procedure
 followed by the procedure body.  The signature consists of the name of
 the procedure and a list of parameters together with their types. The
 parameters in front of the pipe \<open>|\<close> are value parameters and
 behind the pipe are the result parameters. Value parameters model call
 by value semantics. The value of a result parameter at the end of the
 procedure is passed back to the caller. Local variables follow the
 \<open>where\<close>. If there are no local variables the \<open>where \<dots>
 in\<close> can be omitted. The variable @{term "I"} is actually unused in
 the body, but is used in the examples below.\<close>
 
 
 text \<open>
 The procedures command provides convenient syntax
 for procedure calls (that creates the proper @{term init}, @{term return} and
 @{term result} functions on the fly) and creates locales and statespaces to
 reason about the procedure. The purpose of locales is to set up logical contexts
 to support modular reasoning. Locales can be seen as freeze-dried proof contexts that
-get alive as you setup a new lemma or theorem (\<^cite>\<open>"Ballarin-04-locales"\<close>).
+get alive as you setup a new lemma or theorem (\cite{Ballarin-04-locales}).
 The locale the user deals with is named \<open>Square_impl\<close>.
  It defines the procedure name (internally   @{term "Square_'proc"}), the procedure body
 (named \<open>Square_body\<close>) and the statespaces for parameters and local and
 global variables.
 Moreover it contains the
 assumption @{term "\<Gamma> Square_'proc = Some Square_body"}, which states
 that the procedure is properly defined in the procedure context.
 
 The purpose of the locale is to give us easy means to setup the context
 in which we prove programs correct.
 In this locale the procedure context @{term "\<Gamma>"} is fixed.
 So we always use this letter for the procedure
 specification. This is crucial, if we prove programs under the
 assumption of some procedure specifications.
 \<close>
 
 (*<*)
 context Square_impl
 begin
 (*>*)
 text \<open>The procedures command generates syntax, so that we can
 either write \<open>CALL Square(\<acute>I,\<acute>R)\<close> or @{term "\<acute>I :== CALL
 Square(\<acute>R)"} for the procedure call. The internal term is the
 following:
 \<close>
 
 (*<*) declare [[hoare_use_call_tr' = false]] (*>*)
 text \<open>\small @{term [display] "CALL Square(\<acute>I,\<acute>R)"}\<close>
 (*<*) declare [[hoare_use_call_tr' = true]] (*>*)
 
 text \<open>Note the
         additional decoration (with the procedure name) of the parameter and
          local variable names.\<close>
 (*<*)
 end
 (*>*)
 
 text \<open>The abstract syntax for the
 procedure call is @{term "call init p return result"}.  The @{term
 "init"} function copies the values of the actual parameters to the
 formal parameters, the @{term return} function copies the global
 variables back (in our case there are no global variables), and the
 @{term "result"} function additionally copies the values of the formal
 result parameters to the actual locations. Actual value parameters can
 be all kind of expressions, since we only need their value. But result
 parameters must be proper ``lvalues'': variables (including
 dereferenced pointers) or array locations, since we have to assign
 values to them.
 \<close>
 
 subsubsection \<open>Verification\<close>
 
 text (in Square_impl) \<open>
 A procedure specification is an ordinary Hoare tuple.
 We use the parameterless
 call for the specification; \<open>\<acute>R :== PROC Square(\<acute>N)\<close> is syntactic sugar
 for \<open>Call Square_'proc\<close>. This emphasises that the specification
 describes the internal behaviour of the procedure, whereas parameter passing
 corresponds to the procedure call.
 The following precondition fixes the current value \<open>\<acute>N\<close> to the logical
 variable @{term n}.
 Universal quantification of @{term "n"} enables us to adapt
 the specification to an actual parameter. The specification is
 used in the rule for procedure call when we come upon a call to @{term Square}.
 Thus @{term "n"} plays the role of the auxiliary variable @{term "Z"}.
 \<close>
 
 
 text \<open>To verify the procedure we need to verify the body. We use
 a derived variant of the general recursion rule, tailored for non recursive procedures:
 @{thm [source] HoarePartial.ProcNoRec1}:
 \begin{center}
 @{thm [mode=Rule,mode=ParenStmt] HoarePartial.ProcNoRec1 [no_vars]}
 \end{center}
 The naming convention for the rule
 is the following: The \<open>1\<close> expresses that we look at one
  procedure, and \<open>NoRec\<close> that the procedure is non
 recursive.
 \<close>
 
 
 lemma (in Square_impl)
 shows "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N = n\<rbrace>  \<acute>R :== PROC Square(\<acute>N) \<lbrace>\<acute>R = n * n\<rbrace>"
 txt \<open>The directive \<open>in\<close> has the effect that
 the context of the locale @{term "Square_impl"} is included to the current
 lemma, and that the lemma is added as a fact to the locale, after it is proven. The
 next time locale @{term "Square_impl"} is invoked this lemma is immediately available
 as fact, which the verification condition generator can use.
 \<close>
 apply (hoare_rule HoarePartial.ProcNoRec1)
  txt "@{subgoals[display]}"
  txt \<open>The method \<open>hoare_rule\<close>, like \<open>rule\<close> applies a
      single rule, but additionally does some ``obvious'' steps:
      It solves the canonical side-conditions of various Hoare-rules and it
      automatically expands the
      procedure body: With @{thm [source] Square_impl}:  @{thm [names_short] Square_impl [no_vars]} we
      get the procedure body out of the procedure context @{term "\<Gamma>"};
      with @{thm [source] Square_body_def}: @{thm [names_short] Square_body_def [no_vars]} we
      can unfold the definition of the body.
 
      The proof is finished by the vcg and simp.
 \<close>
 txt "@{subgoals[display]}"
 by vcg simp
 
 text \<open>If the procedure is non recursive and there is no specification given, the
 verification condition generator automatically expands the body.\<close>
 
 lemma (in Square_impl) Square_spec:
 shows "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N = n\<rbrace>  \<acute>R :== PROC Square(\<acute>N) \<lbrace>\<acute>R = n * n\<rbrace>"
   by vcg simp
 
 text \<open>An important naming convention is to name the specification as
 \<open><procedure-name>_spec\<close>. The verification condition generator refers to
 this name in order to search for a specification in the theorem database.
 \<close>
 
 subsubsection \<open>Usage\<close>
 
 
 text\<open>Let us see how we can use procedure specifications.\<close>
-(* FIXME: maybe don't show this at all *)
+(* fixme: maybe don't show this at all *)
 lemma (in Square_impl)
   shows "\<Gamma>\<turnstile>\<lbrace>\<acute>I = 2\<rbrace> \<acute>R :== CALL Square(\<acute>I) \<lbrace>\<acute>R = 4\<rbrace>"
   txt \<open>Remember that we have already proven @{thm [source] "Square_spec"} in the locale
   \<open>Square_impl\<close>. This is crucial for
   verification condition generation. When reaching a procedure call,
   it looks for the specification (by its name) and applies the
   rule @{thm [source,mode=ParenStmt] HoarePartial.ProcSpec}
 instantiated with the specification
   (as last premise).
   Before we apply the verification condition generator, let us
   take some time to think of what we can expect.
   Let's look at the specification @{thm [source] Square_spec} again:
   @{thm [display] Square_spec [no_vars]}
   The specification talks about the formal parameters @{term "N"} and
   @{term R}. The precondition @{term "\<lbrace>\<acute>N = n\<rbrace>"} just fixes the initial
   value of \<open>N\<close>.
   The actual parameters are @{term "I"} and @{term "R"}. We
   have to adapt the specification to this calling context.
   @{term "\<forall>n. \<Gamma>\<turnstile> \<lbrace>\<acute>I = n\<rbrace> \<acute>R :== CALL Square(\<acute>I) \<lbrace>\<acute>R = n * n\<rbrace>"}.
   From the postcondition @{term "\<lbrace>\<acute>R = n * n\<rbrace>"} we
   have to derive the actual postcondition @{term "\<lbrace>\<acute>R = 4\<rbrace>"}. So
   we gain something like: @{term "\<lbrace>n * n = (4::nat)\<rbrace>"}.
   The precondition is @{term "\<lbrace>\<acute>I = 2\<rbrace>"} and the specification
   tells us @{term "\<lbrace>\<acute>I = n\<rbrace>"} for the pre-state. So the value of @{term n}
   is the value of @{term I} in the pre-state. So we arrive at
   @{term "\<lbrace>\<acute>I = 2\<rbrace> \<subseteq> \<lbrace>\<acute>I * \<acute>I = 4\<rbrace>"}.
 \<close>
   apply vcg_step
   txt "@{subgoals[display]}"
   txt \<open>
   The second set looks slightly more involved:
     @{term "\<lbrace>\<forall>t. \<^bsup>t\<^esup>R = \<acute>I * \<acute>I \<longrightarrow> \<acute>I * \<acute>I = 4\<rbrace>"}, this is an artefact from the
   procedure call rule. Originally \<open>\<acute>I * \<acute>I = 4\<close> was \<open>\<^bsup>t\<^esup>R = 4\<close>. Where
   @{term "t"} denotes the final state of the procedure and the superscript notation
   allows to select a component from a particular state.
 \<close>
   apply vcg_step
   txt "@{subgoals[display]}"
   by simp
 
 text \<open>
 The adaption of the procedure specification to the actual calling
 context is done due to the @{term init}, @{term return} and @{term result} functions
 in the rule @{thm [source] HoarePartial.ProcSpec} (or in the variant
 @{thm [source] HoarePartial.ProcSpecNoAbrupt} which already
 incorporates the fact that the postcondition for abrupt termination
 is the empty set). For the readers interested in the internals,
 here a version without vcg.
 \<close>
 lemma (in Square_impl)
   shows "\<Gamma>\<turnstile>\<lbrace>\<acute>I = 2\<rbrace> \<acute>R :== CALL Square(\<acute>I) \<lbrace>\<acute>R = 4\<rbrace>"
   apply (rule HoarePartial.ProcSpecNoAbrupt [OF _ _ Square_spec])
   txt "@{subgoals[display]}"
   txt \<open>This is the raw verification condition,
          It is interesting to see how the auxiliary variable @{term "Z"} is
          actually used. It is unified with @{term n} of the specification and
          fixes the state after parameter passing.
 \<close>
   apply simp
   txt "@{subgoals[display]}"
   prefer 2
   apply vcg_step
   txt "@{subgoals[display]}"
   apply (auto intro: ext)
   done
 
 
 
 subsubsection \<open>Recursion\<close>
 
 text \<open>We want to define a procedure for the factorial. We first
 define a HOL function that calculates it, to specify the procedure later on.
 \<close>
 
 primrec fac:: "nat \<Rightarrow> nat"
 where
 "fac 0 = 1" |
 "fac (Suc n) = (Suc n) * fac n"
 
 (*<*)
 lemma fac_simp [simp]: "0 < i \<Longrightarrow>  fac i = i * fac (i - 1)"
   by (cases i) simp_all
 (*>*)
 
 text \<open>Now we define the procedure.\<close>
 procedures
   Fac (N::nat | R::nat)
   "IF \<acute>N = 0 THEN \<acute>R :== 1
    ELSE \<acute>R :== CALL Fac(\<acute>N - 1);;
         \<acute>R :== \<acute>N * \<acute>R
    FI"
 
 text \<open>
 Now let us prove that our implementation of @{term "Fac"} meets its specification.
 \<close>
 
 lemma (in Fac_impl)
 shows "\<forall>n. \<Gamma>\<turnstile> \<lbrace>\<acute>N = n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
 apply (hoare_rule HoarePartial.ProcRec1)
 txt "@{subgoals[display]}"
 apply vcg
 txt "@{subgoals[display]}"
 apply simp
 done
 
 text \<open>
 Since the factorial is implemented recursively,
 the main ingredient of this proof is, to assume that the specification holds for
 the recursive call of @{term Fac} and prove the body correct.
 The assumption for recursive calls is added to the context by
 the rule @{thm [source] HoarePartial.ProcRec1}
 (also derived from the general rule for mutually recursive procedures):
 \begin{center}
 @{thm [mode=Rule,mode=ParenStmt] HoarePartial.ProcRec1 [no_vars]}
 \end{center}
 The verification condition generator infers the specification out of the
 context @{term "\<Theta>"} when it encounters a recursive call of the factorial.
 \<close>
 
 subsection \<open>Global Variables and Heap \label{sec:VcgHeap}\<close>
 
 text \<open>
 Now we define and verify some procedures on heap-lists. We consider
 list structures consisting of two fields, a content element @{term "cont"} and
 a reference to the next list element @{term "next"}. We model this by the
 following state space where every field has its own heap.
 \<close>
 
 hoarestate globals_heap =
   "next" :: "ref \<Rightarrow> ref"
   cont :: "ref \<Rightarrow> nat"
 
 text \<open>It is mandatory to start the state name with `globals'. This is exploited
 by the syntax translations to store the components in the @{const globals} part
 of the state.
 \<close>
 
 text \<open>Updates to global components inside a procedure are
 always propagated to the caller. This is implicitly done by the
 parameter passing syntax translations.
 \<close>
 
 text \<open>We first define an append function on lists. It takes two
 references as parameters. It appends the list referred to by the first
 parameter with the list referred to by the second parameter. The statespace
 of the global variables has to be imported.
 \<close>
 
 procedures (imports globals_heap)
   append(p :: ref, q::ref | p::ref)
     "IF \<acute>p=Null THEN \<acute>p :== \<acute>q
      ELSE \<acute>p\<rightarrow>\<acute>next :== CALL append(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"
 
 (*<*)
 context append_impl
 begin
 (*>*)
 text \<open>
 The difference of a global and a local variable is that global
 variables are automatically copied back to the procedure caller.
 We can study this effect on the translation of @{term "\<acute>p :== CALL append(\<acute>p,\<acute>q)"}:
 \<close>
 (*<*)
 declare [[hoare_use_call_tr' = false]]
 (*>*)
 text \<open>
 @{term [display] "\<acute>p :== CALL append(\<acute>p,\<acute>q)"}
 \<close>
 (*<*)
 declare [[hoare_use_call_tr' = true]]
 end
 (*>*)
 
 text \<open>Below we give two specifications this time.
 One captures the functional behaviour and focuses on the
 entities that are potentially modified by the procedure, the second one
 is a pure frame condition.
 \<close>
 
 
 
 text \<open>
 The functional specification below introduces two logical variables besides the
 state space variable @{term "\<sigma>"}, namely @{term "Ps"} and @{term "Qs"}.
 They are universally quantified and range over both the pre-and the postcondition, so
 that we are able to properly instantiate the specification
 during the proofs. The syntax \<open>\<lbrace>\<sigma>. \<dots>\<rbrace>\<close> is a shorthand to fix the current
 state: \<open>{s. \<sigma> = s \<dots>}\<close>. Moreover \<open>\<^bsup>\<sigma>\<^esup>x\<close> abbreviates
 the lookup of variable \<open>x\<close> in the state
 \<open>\<sigma>\<close>.
 
 The approach to specify procedures on lists
-basically follows \<^cite>\<open>"MehtaN-CADE03"\<close>. From the pointer structure
+basically follows \cite{MehtaN-CADE03}. From the pointer structure
 in the heap we (relationally) abstract to HOL lists of references. Then
 we can specify further properties on the level of HOL lists, rather then
 on the heap. The basic abstractions are:
 
 @{thm [display] Path.simps [no_vars]}
 
 @{term [show_types] "Path x h y ps"}: @{term ps} is a list of references that we can obtain
 out of the heap @{term h} by starting with the reference @{term x}, following
 the references in @{term h} up to the reference @{term y}.
 
 
 @{thm [display] List_def [no_vars]}
 
 A list @{term "List p h ps"} is a path starting in @{term p} and ending up
 in @{term Null}.
 \<close>
 
 
 lemma (in append_impl) append_spec1:
 shows "\<forall>\<sigma> Ps Qs.
   \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
        \<acute>p :== PROC append(\<acute>p,\<acute>q)
      \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 apply (hoare_rule HoarePartial.ProcRec1)
 txt \<open>@{subgoals [margin=80,display]}
 Note that @{term "hoare_rule"} takes care of multiple auxiliary variables!
 @{thm [source] HoarePartial.ProcRec1} has only one auxiliary variable, namely @{term Z}.
 But the type of @{term Z} can be instantiated arbitrarily. So \<open>hoare_rule\<close>
 instantiates @{term Z} with the tuple @{term "(\<sigma>,Ps,Qs)"} and derives a proper variant
 of the rule. Therefore \<open>hoare_rule\<close> depends on the proper quantification of
 auxiliary variables!
 \<close>
 apply vcg
 txt \<open>@{subgoals [display]}
 For each branch of the \<open>IF\<close> statement we have one conjunct to prove. The
 \<open>THEN\<close> branch starts with \<open>p = Null \<longrightarrow> \<dots>\<close> and the \<open>ELSE\<close> branch
 with \<open>p \<noteq> Null \<longrightarrow> \<dots>\<close>. Let us focus on the \<open>ELSE\<close> branch, were the
 recursive call to append occurs. First of all we have to prove that the precondition for
 the recursive call is fulfilled. That means we have to provide some witnesses for
 the lists @{term Psa} and @{term Qsa} which are referenced by \<open>p\<rightarrow>next\<close> (now
 written as @{term "next p"}) and @{term q}. Then we have to show that we can
 derive the overall postcondition from the postcondition of the recursive call. The
 state components that have changed by the recursive call are the ones with the suffix
 \<open>a\<close>, like \<open>nexta\<close> and \<open>pa\<close>.
 \<close>
 apply fastforce
 done
 
 
 text \<open>If the verification condition generator works on a procedure
 call it checks whether it can find a modifies clause in the
 context. If one is present the procedure call is simplified before the
 Hoare rule @{thm [source] HoarePartial.ProcSpec} is
 applied. Simplification of the procedure call means that the ``copy
 back'' of the global components is simplified. Only those components
 that occur in the modifies clause are actually copied back.  This
 simplification is justified by the rule @{thm [source]
 HoarePartial.ProcModifyReturn}.
 So after this simplification all global
 components that do not appear in the modifies clause are treated
 as local variables.\<close>
 
 text \<open>We study the effect of the modifies clause on the following
 examples, where we want to prove that @{term "append"} does not change
 the @{term "cont"} part of the heap.
 \<close>
 lemma (in append_impl)
 shows "\<Gamma>\<turnstile> \<lbrace>\<acute>cont=c\<rbrace> \<acute>p :== CALL append(Null,Null) \<lbrace>\<acute>cont=c\<rbrace>"
 proof -
   note append_spec = append_spec1
   show ?thesis
     apply vcg
     txt \<open>@{subgoals [display]}\<close>
     txt \<open>Only focus on the very last line: @{term conta} is the heap component
       after the procedure call,
       and @{term cont} the heap component before the procedure call. Since
       we have not added the modified clause we do not know that they have
       to be equal.
 \<close>
     oops
 
 text \<open>
 We now add the frame condition.
 The list in the modifies clause names all global state components that
 may be changed by the procedure. Note that we know from the modifies clause
 that the @{term cont} parts are not changed. Also a small
 side note on the syntax. We use ordinary brackets in the postcondition
 of the modifies clause, and also the state components do not carry the
 acute, because we explicitly note the state @{term t} here.
 \<close>
 
 
 lemma (in append_impl) append_modifies:
   shows "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} \<acute>p :== PROC append(\<acute>p,\<acute>q)
              {t. t may_only_modify_globals \<sigma> in [next]}"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (vcg spec=modifies)
   done
 
 text \<open>We tell the verification condition generator to use only the
 modifies clauses and not to search for functional specifications by
 the parameter \<open>spec=modifies\<close>. It also tries to solve the
 verification conditions automatically. Again it is crucial to name
 the lemma with this naming scheme, since the verfication condition
 generator searches for these names.
 \<close>
 
 text \<open>The modifies clause is equal to a state update specification
 of the following form.
 \<close>
 
 lemma (in append_impl) shows "{t. t may_only_modify_globals Z in [next]}
        =
        {t. \<exists>next. globals t=update id id next_' (K_statefun next) (globals Z)}"
   apply (unfold mex_def meq_def)
   apply simp
   done
 
 text \<open>Now that we have proven the frame-condition, it is available within
 the locale \<open>append_impl\<close> and the \<open>vcg\<close> exploits it.\<close>
 
 lemma (in append_impl)
 shows "\<Gamma>\<turnstile> \<lbrace>\<acute>cont=c\<rbrace> \<acute>p :== CALL append(Null,Null) \<lbrace>\<acute>cont=c\<rbrace>"
 proof -
   note append_spec = append_spec1
   show ?thesis
     apply vcg
     txt \<open>@{subgoals [display]}\<close>
     txt \<open>With a modifies clause present we know that no change to @{term cont}
       has occurred.
 \<close>
     by simp
 qed
 
 
 text \<open>
 Of course we could add the modifies clause to the functional specification as
 well. But separating both has the advantage that we split up the verification
 work. We can make use of the modifies clause before we apply the
 functional specification in a fully automatic fashion.
 \<close>
 
 
 text \<open>
 To prove that a procedure respects the modifies clause, we only need
 the modifies clauses of the procedures called in the body. We do not need
 the functional specifications. So we can always prove the modifies
 clause without functional specifications, but we may need the modifies
 clause to prove the functional specifications. So usually the modifies clause is
 proved before the proof of the functional specification, so that it can already be used
 by the verification condition generator.
 \<close>
 
 
 
 subsection \<open>Total Correctness\<close>
 
 text \<open>When proving total correctness the additional proof burden to
 the user is to come up with a well-founded relation and to prove that
 certain states get smaller according to this relation. Proving that a
 relation is well-founded can be quite hard. But fortunately there are
 ways to construct and stick together relations so that they are
 well-founded by construction. This infrastructure is already present
 in Isabelle/HOL.  For example, @{term "measure f"} is always well-founded;
 the lexicographic product of two well-founded relations is again
 well-founded and the inverse image construction @{term "inv_image"} of
 a well-founded relation is again well-founded. The constructions are
 best explained by some equations:
 
 @{thm in_measure_iff [no_vars]}\\
 @{thm in_lex_iff [no_vars]}\\
 @{thm in_inv_image_iff [no_vars]}
 
 Another useful construction is \<open><*mlex*>\<close> which is a combination
 of a measure and a lexicographic product:
 
 @{thm in_mlex_iff [no_vars]}\\
 In contrast to the lexicographic product it does not construct a product type.
 The state may either decrease according to the measure function @{term f} or the
 measure stays the same and the state decreases because of the relation @{term r}.
 
 Lets look at a loop:
 \<close>
 
 lemma (in vars)
   "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
        WHILE \<acute>M \<noteq> a
        INV \<lbrace>\<acute>S = \<acute>M * b \<and> \<acute>M \<le> a\<rbrace>
        VAR MEASURE a - \<acute>M
        DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
        \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 txt \<open>@{subgoals [display]}
 The first conjunct of the second subgoal is the proof obligation that the
 variant decreases in the loop body.
 \<close>
 by auto
 
 
 
 text \<open>The variant annotation is preceded by \<open>VAR\<close>. The capital \<open>MEASURE\<close>
 is a shorthand for \<open>measure (\<lambda>s. a - \<^bsup>s\<^esup>M)\<close>. Analogous there is a capital
 \<open><*MLEX*>\<close>.
 \<close>
 
 lemma (in Fac_impl) Fac_spec':
 shows "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} \<acute>R :==  PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
 apply (hoare_rule HoareTotal.ProcRec1 [where r="measure (\<lambda>(s,p). \<^bsup>s\<^esup>N)"])
 txt \<open>In case of the factorial the parameter @{term N} decreases in every call. This
 is easily expressed by the measure function. Note that the well-founded relation for
 recursive procedures is formally defined on tuples
 containing the state space and the procedure name.
 \<close>
 txt \<open>@{subgoals [display]}
 The initial call to the factorial is in state @{term "\<sigma>"}. Note that in the
 precondition @{term "{\<sigma>} \<inter> {\<sigma>'}"}, @{term "\<sigma>'"} stems from the lemma we want to prove
 and @{term "\<sigma>"} stems from the recursion rule for total correctness. Both are
 synonym for the initial state. To use the assumption in the Hoare context we
 have to show that the call to the factorial is invoked on a smaller @{term N} compared
 to the initial \<open>\<^bsup>\<sigma>\<^esup>N\<close>.
 \<close>
 apply vcg
 txt \<open>@{subgoals [display]}
 The tribute to termination is that we have to show \<open>N - 1 < N\<close> in case of
 the recursive call.
 \<close>
 by simp
 
 lemma (in append_impl) append_spec2:
 shows "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>\<^sub>t
   \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
        \<acute>p :== PROC append(\<acute>p,\<acute>q)
   \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 apply (hoare_rule HoareTotal.ProcRec1
            [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
 txt \<open>In case of the append function the length of the list referenced by @{term p}
 decreases in every recursive call.
 \<close>
 txt \<open>@{subgoals [margin=80,display]}\<close>
 apply vcg
 apply (fastforce simp add: List_list)
 done
 
 text \<open>
 In case of the lists above, we have used a relational list abstraction @{term List}
 to construct the HOL lists @{term Ps} and @{term Qs} for the pre- and postcondition.
 To supply a proper measure function we use a functional abstraction @{term list}.
 The functional abstraction can be defined by means of the relational list abstraction,
 since the lists are already uniquely determined by the relational abstraction:
 
 @{thm islist_def [no_vars]}\\
 @{thm list_def [no_vars]}
 
 \isacommand{lemma} @{thm List_conv_islist_list [no_vars]}
 \<close>
 
 text \<open>
-The next contrived example is taken from \<^cite>\<open>"Homeier-95-vcg"\<close>, to illustrate
+The next contrived example is taken from \cite{Homeier-95-vcg}, to illustrate
 a more complex termination criterion for mutually recursive procedures. The procedures
 do not calculate anything useful.
 
 \<close>
 
 
 procedures
   pedal(N::nat,M::nat)
   "IF 0 < \<acute>N THEN
      IF 0 < \<acute>M THEN
        CALL coast(\<acute>N- 1,\<acute>M- 1) FI;;
        CALL pedal(\<acute>N- 1,\<acute>M)
      FI"
   and
 
   coast(N::nat,M::nat)
   "CALL pedal(\<acute>N,\<acute>M);;
    IF 0 < \<acute>M THEN CALL coast(\<acute>N,\<acute>M- 1) FI"
 
 
 text \<open>
 In the recursive calls in procedure \<open>pedal\<close> the first argument always decreases.
 In the body of \<open>coast\<close> in the recursive call of \<open>coast\<close> the second
 argument decreases, but in the call to \<open>pedal\<close> no argument decreases.
 Therefore an relation only on the state space is insufficient. We have to
 take the procedure names into account, too.
 We consider the procedure \<open>coast\<close> to be ``bigger'' than \<open>pedal\<close>
 when we construct a well-founded relation on the product of state space and procedure
 names.
 \<close>
 
 ML \<open>ML_Thms.bind_thm ("HoareTotal_ProcRec2", Hoare.gen_proc_rec @{context} Hoare.Total 2)\<close>
 
 
 text \<open>
   We provide the ML function {\tt gen\_proc\_rec} to
 automatically derive a convenient rule for recursion for a given number of mutually
 recursive procedures.
 \<close>
 
 
 lemma (in pedal_coast_clique)
 shows "(\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} PROC pedal(\<acute>N,\<acute>M) UNIV) \<and>
          (\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} PROC coast(\<acute>N,\<acute>M) UNIV)"
 apply (hoare_rule HoareTotal_ProcRec2
             [where r= "((\<lambda>(s,p). \<^bsup>s\<^esup>N) <*mlex*>
                            (\<lambda>(s,p). \<^bsup>s\<^esup>M) <*mlex*>
                            measure (\<lambda>(s,p). if p = coast_'proc then 1 else 0))"])
   txt \<open>We can directly express the termination condition described above with
   the \<open><*mlex*>\<close> construction. Either state component \<open>N\<close> decreases,
   or it stays the same and \<open>M\<close> decreases or this also stays the same, but
   then the procedure name has to decrease.\<close>
   txt \<open>@{subgoals [margin=80,display]}\<close>
 apply  simp_all
   txt \<open>@{subgoals [margin=75,display]}\<close>
 by (vcg,simp)+
 
 text \<open>We can achieve the same effect without \<open><*mlex*>\<close> by using
  the ordinary lexicographic product \<open><*lex*>\<close>, \<open>inv_image\<close> and
  \<open>measure\<close>
 \<close>
 
 lemma (in pedal_coast_clique)
 shows "(\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} PROC pedal(\<acute>N,\<acute>M) UNIV) \<and>
          (\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} PROC coast(\<acute>N,\<acute>M) UNIV)"
 apply (hoare_rule HoareTotal_ProcRec2
           [where r= "inv_image (measure (\<lambda>m. m) <*lex*>
                                         measure (\<lambda>m. m) <*lex*>
                                         measure (\<lambda>p. if p = coast_'proc then 1 else 0))
                            (\<lambda>(s,p). (\<^bsup>s\<^esup>N,\<^bsup>s\<^esup>M,p))"])
   txt \<open>With the lexicographic product we construct a well-founded relation on
          triples of type @{typ "(nat\<times>nat\<times>string)"}. With @{term inv_image} we project
          the components out of the state-space and the procedure names to this
          triple.
 \<close>
   txt \<open>@{subgoals [margin=75,display]}\<close>
 apply simp_all
-  by (vcg,force)+
+by (vcg,simp)+
+
 text \<open>By doing some arithmetic we can express the termination condition with a single
 measure function.
 \<close>
 
 lemma (in pedal_coast_clique)
 shows "(\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} PROC pedal(\<acute>N,\<acute>M) UNIV) \<and>
          (\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} PROC coast(\<acute>N,\<acute>M) UNIV)"
 apply(hoare_rule HoareTotal_ProcRec2
        [where r= "measure (\<lambda>(s,p). \<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M + (if p = coast_'proc then 1 else 0))"])
 apply simp_all
 txt \<open>@{subgoals [margin=75,display]}\<close>
 by (vcg,simp,arith?)+
 
 
 subsection \<open>Guards\<close>
 
 text (in vars) \<open>The purpose of a guard is to guard the {\bf (sub-) expressions} of a
 statement against runtime faults. Typical runtime faults are array bound violations,
 dereferencing null pointers or arithmetical overflow. Guards make the potential
 runtime faults explicit, since the expressions themselves never ``fail'' because
 they are ordinary HOL expressions. To relieve the user from typing in lots of standard
 guards for every subexpression, we supply some input syntax for the common
 language constructs that automatically generate the guards.
 For example the guarded assignment \<open>\<acute>M :==\<^sub>g (\<acute>M + 1) div \<acute>N\<close> gets expanded to
 guarded command @{term "\<acute>M :==\<^sub>g (\<acute>M + 1) div \<acute>N"}. Here @{term "in_range"} is
 uninterpreted by now.
 \<close>
 
 lemma (in vars) "\<Gamma>\<turnstile>\<lbrace>True\<rbrace> \<acute>M :==\<^sub>g (\<acute>M + 1) div \<acute>N \<lbrace>True\<rbrace>"
 apply vcg
 txt \<open>@{subgoals}\<close>
 oops
 
 text \<open>
 The user can supply on (overloaded) definition of \<open>in_range\<close>
 to fit to his needs.
 
 Currently guards are generated for:
 
 \begin{itemize}
 \item overflow and underflow of numbers (\<open>in_range\<close>). For subtraction of
       natural numbers \<open>a - b\<close> the guard \<open>b \<le> a\<close> is generated instead
       of \<open>in_range\<close> to guard against underflows.
 \item division by \<open>0\<close>
 \item dereferencing of @{term Null} pointers
 \item array bound violations
 \end{itemize}
 
 Following (input) variants of guarded statements are available:
 
 \begin{itemize}
 \item Assignment: \<open>\<dots> :==\<^sub>g \<dots>\<close>
 \item If: \<open>IF\<^sub>g \<dots>\<close>
 \item While: \<open>WHILE\<^sub>g \<dots>\<close>
 \item Call: \<open>CALL\<^sub>g \<dots>\<close> or \<open>\<dots> :== CALL\<^sub>g \<dots>\<close>
 \end{itemize}
 \<close>
 
 subsection \<open>Miscellaneous Techniques\<close>
 
 
 
 subsubsection \<open>Modifies Clause\<close>
 
 text \<open>We look at some issues regarding the modifies clause with the example
 of insertion sort for heap lists.
 \<close>
 
 primrec sorted:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list  \<Rightarrow> bool"
 where
 "sorted le [] = True" |
 "sorted le (x#xs) = ((\<forall>y\<in>set xs. le x y) \<and> sorted le xs)"
 
 procedures (imports globals_heap)
   insert(r::ref,p::ref | p::ref)
     "IF \<acute>r=Null THEN SKIP
      ELSE IF \<acute>p=Null THEN \<acute>p :== \<acute>r;; \<acute>p\<rightarrow>\<acute>next :== Null
           ELSE IF \<acute>r\<rightarrow>\<acute>cont \<le> \<acute>p\<rightarrow>\<acute>cont
                THEN \<acute>r\<rightarrow>\<acute>next :== \<acute>p;; \<acute>p:==\<acute>r
                ELSE \<acute>p\<rightarrow>\<acute>next :== CALL insert(\<acute>r,\<acute>p\<rightarrow>\<acute>next)
                FI
           FI
      FI"
 
 lemma (in insert_impl) insert_modifies:
    "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} \<acute>p :== PROC insert(\<acute>r,\<acute>p)
         {t. t may_only_modify_globals \<sigma> in [next]}"
   by (hoare_rule HoarePartial.ProcRec1) (vcg spec=modifies)
 
 lemma (in insert_impl) insert_spec:
   "\<forall>\<sigma> Ps . \<Gamma>\<turnstile>
   \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and> sorted (\<le>) (map \<acute>cont Ps) \<and>
       \<acute>r \<noteq> Null \<and> \<acute>r \<notin> set Ps\<rbrace>
     \<acute>p :== PROC insert(\<acute>r,\<acute>p)
   \<lbrace>\<exists>Qs. List \<acute>p \<acute>next Qs \<and> sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont  Qs) \<and>
         set Qs = insert \<^bsup>\<sigma>\<^esup>r (set Ps) \<and>
         (\<forall>x. x \<notin> set Qs \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   (*<*)
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply (intro conjI impI)
   apply    fastforce
   apply   fastforce
   apply  fastforce
   apply (clarsimp)
   apply force
   done
   (*>*)
 
 text \<open>
 In the postcondition of the functional specification there is a small but
 important subtlety. Whenever we talk about the @{term "cont"} part we refer to
 the one of the pre-state.
 The reason is that we have separated out the information that @{term "cont"} is not
 modified by the procedure, to the modifies clause. So whenever we talk about unmodified
 parts in the postcondition we have to use the pre-state part, or explicitly
 state an equality in the postcondition.
 The reason is simple. If the postcondition would talk about \<open>\<acute>cont\<close>
 instead of \mbox{\<open>\<^bsup>\<sigma>\<^esup>cont\<close>}, we get a new instance of \<open>cont\<close> during
 verification and the postcondition would only state something about this
 new instance. But as the verification condition generator uses the
 modifies clause the caller of @{term "insert"} instead still has the
 old \<open>cont\<close> after the call. Thats the sense of the modifies clause.
 So the caller and the specification simply talk about two different things,
 without being able to relate them (unless an explicit equality is added to
 the specification).
 \<close>
 
 
 subsubsection \<open>Annotations\<close>
 
 text \<open>
 Annotations (like loop invariants)
 are mere syntactic sugar of statements that are used by the \<open>vcg\<close>.
 Logically a statement with an annotation is
 equal to the statement without it. Hence annotations can be introduced by the user
 while building a proof:
 
 @{thm [source] HoarePartial.annotateI}: @{thm [mode=Rule] HoarePartial.annotateI [no_vars]}
 
 When introducing annotations it can easily happen that these mess around with the
 nesting of sequential composition. Then after stripping the annotations the resulting statement
 is no longer syntactically identical to original one, only equivalent modulo associativity of sequential composition. The following rule also deals with this case:
 
 @{thm [source] HoarePartial.annotate_normI}: @{thm [mode=Rule] HoarePartial.annotate_normI [no_vars]}
 \<close>
 
 text_raw \<open>\paragraph{Loop Annotations}
 \mbox{}
 \medskip
 
 \mbox{}
 \<close>
 
 procedures (imports globals_heap)
   insertSort(p::ref| p::ref)
   where r::ref q::ref in
     "\<acute>r:==Null;;
      WHILE (\<acute>p \<noteq> Null) DO
        \<acute>q :== \<acute>p;;
        \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
        \<acute>r :== CALL insert(\<acute>q,\<acute>r)
      OD;;
      \<acute>p:==\<acute>r"
 
 lemma (in insertSort_impl) insertSort_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} \<acute>p :== PROC insertSort(\<acute>p)
     {t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (vcg spec=modifies)
 done
 
 
 
 
 text \<open>Insertion sort is not implemented recursively here, but with a
 loop. Note that the while loop is not annotated with an invariant in the
 procedure definition. The invariant only comes into play during verification.
 Therefore we annotate the loop first, before we run the \<open>vcg\<close>.
 \<close>
 
 lemma (in insertSort_impl) insertSort_spec:
 shows "\<forall>\<sigma> Ps.
   \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<rbrace>
        \<acute>p :== PROC insertSort(\<acute>p)
      \<lbrace>\<exists>Qs. List \<acute>p \<acute>next Qs \<and> sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont Qs) \<and>
            set Qs = set Ps\<rbrace>"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (hoare_rule anno=
          "\<acute>r :== Null;;
          WHILE \<acute>p \<noteq> Null
          INV \<lbrace>\<exists>Qs Rs. List \<acute>p \<acute>next Qs \<and> List \<acute>r \<acute>next Rs \<and>
                   set Qs \<inter> set Rs = {} \<and>
                   sorted (\<le>) (map \<acute>cont Rs) \<and> set Qs \<union> set Rs = set Ps \<and>
                   \<acute>cont = \<^bsup>\<sigma>\<^esup>cont \<rbrace>
           DO \<acute>q :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;; \<acute>r :== CALL insert(\<acute>q,\<acute>r) OD;;
           \<acute>p :== \<acute>r" in HoarePartial.annotateI)
 apply vcg
 txt \<open>\<open>\<dots>\<close>\<close>
 (*<*)
 
   apply   fastforce
   prefer 2
   apply  fastforce
   apply (clarsimp)
   apply (rule_tac x=ps in exI)
   apply (intro conjI)
   apply    (rule heap_eq_ListI1)
   apply     assumption
   apply    clarsimp
   apply    (subgoal_tac "x\<noteq>p \<and> x \<notin> set Rs")
   apply     auto
   done
 (*>*)
 
 text \<open>The method \<open>hoare_rule\<close> automatically solves the side-condition
         that the annotated
         program is the same as the original one after stripping the annotations.\<close>
 
 text_raw \<open>\paragraph{Specification Annotations}
 \mbox{}
 \medskip
 
 \mbox{}
 \<close>
 
 
 
 text \<open>
 When verifying a larger block of program text, it might be useful to split up
 the block and to prove the parts in isolation. This is especially useful to
 isolate loops. On the level of the Hoare calculus
 the parts can then be combined with the consequence rule. To automate this
 process we introduce the derived command @{term specAnno}, which allows to introduce
 a Hoare tuple (inclusive auxiliary variables) in the program text:
 
 @{thm specAnno_def [no_vars]}
 
 The whole annotation reduces to the body @{term "c undefined"}. The
 type of the assertions @{term "P"}, @{term "Q"} and @{term "A"} is
 @{typ "'a \<Rightarrow> 's set"} and the type of command @{term c} is @{typ "'a \<Rightarrow> ('s,'p,'f) com"}.
 All entities formally depend on an auxiliary (logical) variable of type @{typ "'a"}.
 The body @{term "c"} formally also depends on this variable, since a nested annotation
 or loop invariant may also depend on this logical variable. But the raw body without
 annotations does not depend on the logical variable. The logical variable is only
 used by the verification condition generator. We express this by defining the
 whole @{term specAnno} to be equivalent with the body applied to an arbitrary
 variable.
 
 The Hoare rule for \<open>specAnno\<close> is mainly an instance of the consequence rule:
 
 @{thm [mode=Rule,mode=ParenStmt] HoarePartial.SpecAnno [no_vars]}
 
 The side-condition @{term "\<forall>Z. c Z = c undefined"} expresses the intention of body @{term c}
 explained above: The raw body is independent of the auxiliary variable. This
 side-condition is solved automatically by the \<open>vcg\<close>. The concrete syntax for
 this specification annotation is shown in the following example:
 \<close>
 
 lemma (in vars) "\<Gamma>\<turnstile> {\<sigma>}
             \<acute>I :== \<acute>M;;
             ANNO \<tau>. \<lbrace>\<tau>. \<acute>I = \<^bsup>\<sigma>\<^esup>M\<rbrace>
                          \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
                         \<lbrace>\<acute>M = \<^bsup>\<tau>\<^esup>N \<and> \<acute>N = \<^bsup>\<tau>\<^esup>I\<rbrace>
            \<lbrace>\<acute>M = \<^bsup>\<sigma>\<^esup>N \<and> \<acute>N = \<^bsup>\<sigma>\<^esup>M\<rbrace>"
 txt \<open>With the annotation we can name an intermediate state @{term \<tau>}. Since the
        postcondition refers to @{term "\<sigma>"} we have to link the information about
        the equivalence of \<open>\<^bsup>\<tau>\<^esup>I\<close> and \<open>\<^bsup>\<sigma>\<^esup>M\<close> in the specification in order
        to be able to derive the postcondition.
 \<close>
 apply vcg_step
 apply   vcg_step
 txt \<open>@{subgoals [display]}\<close>
 txt \<open>The first subgoal is the isolated Hoare tuple. The second one is the
        side-condition of the consequence rule that allows us to derive the outermost
        pre/post condition from our inserted specification.
        \<open>\<acute>I = \<^bsup>\<sigma>\<^esup>M\<close> is the precondition of the specification,
        The second conjunct is a simplified version of
        \<open>\<forall>t. \<^bsup>t\<^esup>M = \<acute>N \<and> \<^bsup>t\<^esup>N = \<acute>I \<longrightarrow> \<^bsup>t\<^esup>M = \<^bsup>\<sigma>\<^esup>N \<and> \<^bsup>t\<^esup>N = \<^bsup>\<sigma>\<^esup>M\<close> expressing that the
        postcondition of the specification implies the outermost postcondition.
 \<close>
 apply  vcg
 txt \<open>@{subgoals [display]}\<close>
 apply  simp
 apply vcg
 txt \<open>@{subgoals [display]}\<close>
 by simp
 
 
 lemma (in vars)
   "\<Gamma>\<turnstile> {\<sigma>}
   \<acute>I :== \<acute>M;;
   ANNO \<tau>. \<lbrace>\<tau>. \<acute>I = \<^bsup>\<sigma>\<^esup>M\<rbrace>
     \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
     \<lbrace>\<acute>M = \<^bsup>\<tau>\<^esup>N \<and> \<acute>N = \<^bsup>\<tau>\<^esup>I\<rbrace>
   \<lbrace>\<acute>M = \<^bsup>\<sigma>\<^esup>N \<and> \<acute>N = \<^bsup>\<sigma>\<^esup>M\<rbrace>"
 apply vcg
 txt \<open>@{subgoals [display]}\<close>
 by simp_all
 
 text \<open>Note that \<open>vcg_step\<close> changes the order of sequential composition, to
 allow the user to decompose sequences by repeated calls to \<open>vcg_step\<close>, whereas
 \<open>vcg\<close> preserves the order.
 
 The above example illustrates how we can introduce a new logical state variable
 @{term "\<tau>"}. You can introduce multiple variables by using a tuple:
 
 
 
 \<close>
 
 
 lemma (in vars)
   "\<Gamma>\<turnstile> {\<sigma>}
    \<acute>I :== \<acute>M;;
    ANNO (n,i,m). \<lbrace>\<acute>I = \<^bsup>\<sigma>\<^esup>M \<and> \<acute>N=n \<and> \<acute>I=i \<and> \<acute>M=m\<rbrace>
      \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
    \<lbrace>\<acute>M = n \<and> \<acute>N = i\<rbrace>
   \<lbrace>\<acute>M = \<^bsup>\<sigma>\<^esup>N \<and> \<acute>N = \<^bsup>\<sigma>\<^esup>M\<rbrace>"
 apply vcg
 txt \<open>@{subgoals [display]}\<close>
 by simp_all
 
 text_raw \<open>\paragraph{Lemma Annotations}
 \mbox{}
 \medskip
 
 \mbox{}
 
 \<close>
 
 text \<open>
 The specification annotations described before split the verification
 into several Hoare triples which result in several subgoals. If we
 instead want to proof the Hoare triples independently as
 separate lemmas we can use the \<open>LEMMA\<close> annotation to plug together the
 lemmas. It
 inserts the lemma in the same fashion as the specification annotation.
 \<close>
 lemma (in vars) foo_lemma:
   "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace> \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
              \<lbrace>\<acute>N = n + 1 \<and> \<acute>M = m + 1\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma (in vars)
   "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace>
        LEMMA foo_lemma
              \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
        END;;
        \<acute>N :== \<acute>N + 1
        \<lbrace>\<acute>N = n + 2 \<and> \<acute>M = m + 1\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma (in vars)
   "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace>
            LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END;;
            LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END
       \<lbrace>\<acute>N = n + 2 \<and> \<acute>M = m + 2\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma (in vars)
   "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace>
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1;;
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
       \<lbrace>\<acute>N = n + 2 \<and> \<acute>M = m + 2\<rbrace>"
   apply (hoare_rule anno=
           "LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END;;
            LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END"
           in HoarePartial.annotate_normI)
   apply vcg
   apply simp
   done
 
 
 subsubsection \<open>Total Correctness of Nested Loops\<close>
 
 text \<open>
 When proving termination of nested loops it is sometimes necessary to express that
 the loop variable of the outer loop is not modified in the inner loop. To express this
 one has to fix the value of the outer loop variable before the inner loop and use this value
 in the invariant of the inner loop. This can be achieved by surrounding the inner while loop
 with an \<open>ANNO\<close> specification as explained previously. However, this
 leads to repeating the invariant of the inner loop three times: in the invariant itself and
 in the the pre- and postcondition of the \<open>ANNO\<close> specification. Moreover one has
 to deal with the additional subgoal introduced by \<open>ANNO\<close> that expresses how
 the pre- and postcondition is connected to the invariant. To avoid this extra specification
 and verification work, we introduce an variant of the annotated while-loop, where one can
 introduce logical variables by \<open>FIX\<close>. As for the \<open>ANNO\<close> specification
 multiple logical variables can be introduced via a tuple (\<open>FIX (a,b,c).\<close>).
 
 The Hoare logic rule for the augmented while-loop is a mixture of the invariant rule for
 loops and the consequence rule for \<open>ANNO\<close>:
 
 \begin{center}
 @{thm [mode=Rule,mode=ParenStmt] HoareTotal.WhileAnnoFix' [no_vars]}
 \end{center}
 
 The first premise expresses that the precondition implies the invariant and that
 the invariant together with the negated loop condition implies the postcondition. Since
 both implications may depend on the choice of the auxiliary variable @{term "Z"} these two
 implications are expressed in a single premise and not in two of them as for the usual while
 rule. The second premise is the preservation of the invariant by the loop body. And the third
 premise is the side-condition that the computational part of the body does not depend on
 the auxiliary variable. Finally the last premise is the well-foundedness of the variant.
 The last two premises are usually discharged automatically by the verification condition
 generator. Hence usually two subgoals remain for the user, stemming from the first two
 premises.
 
 The following example illustrates the usage of this rule. The outer loop increments the
 loop variable @{term "M"} while the inner loop increments @{term "N"}. To discharge the
 proof obligation for the termination of the outer loop, we need to know that the inner loop
 does not mess around with @{term "M"}. This is expressed by introducing the logical variable
 @{term "m"} and fixing the value of @{term "M"} to it.
 \<close>
 
 
 lemma (in vars)
   "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>M=0 \<and> \<acute>N=0\<rbrace>
       WHILE (\<acute>M < i)
       INV \<lbrace>\<acute>M \<le> i \<and> (\<acute>M \<noteq> 0 \<longrightarrow> \<acute>N = j) \<and> \<acute>N \<le> j\<rbrace>
       VAR MEASURE (i - \<acute>M)
       DO
          \<acute>N :== 0;;
          WHILE (\<acute>N < j)
          FIX m.
          INV \<lbrace>\<acute>M=m \<and> \<acute>N \<le> j\<rbrace>
          VAR MEASURE (j - \<acute>N)
          DO
            \<acute>N :== \<acute>N + 1
          OD;;
        \<acute>M :== \<acute>M + 1
        OD
        \<lbrace>\<acute>M=i \<and> (\<acute>M\<noteq>0 \<longrightarrow> \<acute>N=j)\<rbrace>"
 apply vcg
 txt \<open>@{subgoals [display]}
 
 The first subgoal is from the precondition to the invariant of the outer loop.
 The fourth subgoal is from the invariant together with the negated loop condition
 of the outer loop to the postcondition. The subgoals two and three are from the body
 of the outer while loop which is mainly the inner while loop. Because we introduce the
 logical variable @{term "m"} here, the while Rule described above is used instead of the
 ordinary while Rule. That is why we end up with two subgoals for the inner loop. Subgoal
 two is from the invariant and the loop condition of the outer loop to the invariant
 of the inner loop. And at the same time from the invariant of the inner loop to the
 invariant of the outer loop (together with the proof obligation that the measure of the
 outer loop decreases). The universal quantified variables @{term "Ma"} and @{term "N"} are
 the ``fresh'' state variables introduced for the final state of the inner loop.
 The equality @{term "Ma=M"} is the result of the equality \<open>\<acute>M=m\<close> in the inner
 invariant. Subgoal three is the preservation of the invariant by the
 inner loop body (together with the proof obligation that the measure of
 the inner loop decreases).
 \<close>
 (*<*)
 apply    (simp)
 apply   (simp,arith)
 apply  (simp,arith)
 done
 (*>*)
 
 subsection \<open>Functional Correctness, Termination and Runtime Faults\<close>
 
 text \<open>
 Total correctness of a program with guards conceptually leads to three verification
 tasks.
 \begin{itemize}
 \item functional (partial) correctness
 \item absence of runtime faults
 \item termination
 \end{itemize}
 
 In case of a modifies specification the functional correctness part
 can be solved automatically. But the absence of runtime faults and
 termination may be non trivial.  Fortunately the modifies clause is
 usually just a helpful companion of another specification that
 expresses the ``real'' functional behaviour. Therefor the task to
 prove the absence of runtime faults and termination can be dealt with
 during the proof of this functional specification. In most cases the
 absence of runtime faults and termination heavily build on the
 functional specification parts.  So after all there is no reason why
 we should again prove the absence of runtime faults and termination
 for the modifies clause. Therefor it suffices to have partial
 correctness of the modifies clause for a program were all guards are
 ignored.  This leads to the following pattern:\<close>
 
 
 
 procedures foo (N::nat|M::nat)
   "\<acute>M :== \<acute>M
    \<comment> \<open>think of body with guards instead\<close>"
 
   foo_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t (P \<sigma>) \<acute>M :== PROC foo(\<acute>N) (Q \<sigma>)"
   foo_modifies: "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} \<acute>M :== PROC foo(\<acute>N)
                    {t. t may_only_modify_globals \<sigma> in []}"
 
 text \<open>
 The verification condition generator can solve those modifies clauses automatically
 and can use them to simplify calls to \<open>foo\<close> even in the context of total
 correctness.
 \<close>
 
 subsection \<open>Procedures and Locales \label{sec:Locales}\<close>
 
 
 
 text \<open>
 Verification of a larger program is organised on the granularity of procedures.
 We proof the procedures in a bottom up fashion.  Of course you can also always use Isabelle's
 dummy proof \<open>sorry\<close> to prototype your formalisation. So you can write the
 theory in a bottom up fashion but actually prove the lemmas in any other order.
 
 Here are some explanations of handling of locales. In the examples below, consider
 \<open>proc\<^sub>1\<close> and \<open>proc\<^sub>2\<close> to be ``leaf'' procedures, which do not call any
 other procedure.
 Procedure \<open>proc\<close> directly calls \<open>proc\<^sub>1\<close> and \<open>proc\<^sub>2\<close>.
 
 \isacommand{lemma} (\isacommand{in} \<open>proc\<^sub>1_impl\<close>) \<open>proc\<^sub>1_modifies\<close>:\\
 \isacommand{shows} \<open>\<dots>\<close>
 
 After the proof of \<open>proc\<^sub>1_modifies\<close>, the \isacommand{in} directive
 stores the lemma in the
 locale \<open>proc\<^sub>1_impl\<close>. When we later on include \<open>proc\<^sub>1_impl\<close> or prove
 another theorem in locale \<open>proc\<^sub>1_impl\<close> the lemma \<open>proc\<^sub>1_modifies\<close>
 will already be available as fact.
 
 \isacommand{lemma} (\isacommand{in} \<open>proc\<^sub>1_impl\<close>) \<open>proc\<^sub>1_spec\<close>:\\
 \isacommand{shows} \<open>\<dots>\<close>
 
 \isacommand{lemma} (\isacommand{in} \<open>proc\<^sub>2_impl\<close>) \<open>proc\<^sub>2_modifies\<close>:\\
 \isacommand{shows} \<open>\<dots>\<close>
 
 \isacommand{lemma} (\isacommand{in} \<open>proc\<^sub>2_impl\<close>) \<open>proc\<^sub>2_spec\<close>:\\
 \isacommand{shows} \<open>\<dots>\<close>
 
 
 \isacommand{lemma} (\isacommand{in} \<open>proc_impl\<close>) \<open>proc_modifies\<close>:\\
 \isacommand{shows} \<open>\<dots>\<close>
 
 Note that we do not explicitly include anything about \<open>proc\<^sub>1\<close> or
 \<open>proc\<^sub>2\<close> here. This is handled automatically. When defining
 an \<open>impl\<close>-locale it imports all \<open>impl\<close>-locales of procedures that are
 called in the body. In case of \<open>proc_impl\<close> this means, that \<open>proc\<^sub>1_impl\<close>
 and \<open>proc\<^sub>2_impl\<close> are imported. This has the neat effect that all theorems that
 are proven in \<open>proc\<^sub>1_impl\<close> and \<open>proc\<^sub>2_impl\<close> are also present
 in \<open>proc_impl\<close>.
 
 \isacommand{lemma} (\isacommand{in} \<open>proc_impl\<close>) \<open>proc_spec\<close>:\\
 \isacommand{shows} \<open>\<dots>\<close>
 
 As we have seen in this example you only have to prove a procedure in its own
 \<open>impl\<close> locale. You do not have to include any other locale.
 \<close>
 
 subsection \<open>Records \label{sec:records}\<close>
 
 text \<open>
 Before @{term "statespaces"} where introduced the state was represented as a @{term "record"}.
 This is still supported. Compared to the flexibility of statespaces there are some drawbacks
 in particular with respect to modularity. Even names of local variables and
 parameters are globally visible and records can only be extended in a linear fashion, whereas
 statespaces also allow multiple inheritance. The usage of records is quite similar to the usage of statespaces.
 We repeat the example of an append function for heap lists.
 First we define the global components.
 Again the appearance of the prefix `globals' is mandatory. This is the way the syntax layer distinguishes local and global variables.
 \<close>
 record globals_list =
   next_' :: "ref \<Rightarrow> ref"
   cont_' :: "ref \<Rightarrow> nat"
 
 
 text \<open>The local variables also have to be defined as a record before the actual definition
 of the procedure. The parent record \<open>state\<close> defines a generic @{term "globals"}
 field as a place-holder for the record of global components. In contrast to the
 statespace approach there is no single @{term "locals"} slot. The local components are
 just added to the record.
 \<close>
 record 'g list_vars = "'g state" +
   p_'    :: "ref"
   q_'    :: "ref"
   r_'    :: "ref"
   root_' :: "ref"
   tmp_'  :: "ref"
 
 text \<open>Since the parameters and local variables are determined by the record, there are
 no type annotations or definitions of local variables while defining a procedure.
 \<close>
 
 procedures
   append'(p,q|p) =
     "IF \<acute>p=Null THEN \<acute>p :== \<acute>q
      ELSE \<acute>p \<rightarrow>\<acute>next:== CALL append'(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"
 
 text \<open>As in the statespace approach, a locale called \<open>append'_impl\<close> is created.
 Note that we do not give any explicit information which global or local state-record to use.
 Since the records are already defined we rely on Isabelle's type inference.
 Dealing with the locale is analogous to the case with statespaces.
 \<close>
 
 lemma (in append'_impl) append'_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC append'(\<acute>p,\<acute>q)
         {t. t may_only_modify_globals \<sigma> in [next]}"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (vcg spec=modifies)
   done
 
 lemma (in append'_impl) append'_spec:
   shows "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>
             \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
                 \<acute>p :== PROC append'(\<acute>p,\<acute>q)
             \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply fastforce
   done
 
 
 text \<open>
 However, in some corner cases the inferred state type in a procedure definition
 can be too general which raises problems when  attempting to proof a suitable
 specifications in the locale.
 Consider for example the simple procedure body @{term "\<acute>p :== NULL"} for a procedure
 \<open>init\<close>.
 \<close>
 
 procedures init (|p) =
   "\<acute>p:== Null"
 
 
 text \<open>
 Here Isabelle can only
 infer the local variable record. Since no reference to any global variable is
 made the type fixed for the global variables (in the locale \<open>init'_impl\<close>) is a
 type variable say @{typ "'g"} and not a @{term "globals_list"} record. Any specification
 mentioning @{term "next"} or @{term "cont"} restricts the state type and cannot be
 added to the locale \<open>init_impl\<close>. Hence we have to restrict the body
 @{term "\<acute>p :== NULL"} in the first place by adding a typing annotation:
 \<close>
 
 procedures init' (|p) =
   "\<acute>p:== Null::(('a globals_list_scheme, 'b) list_vars_scheme, char list, 'c) com"
 
 
 subsubsection \<open>Extending State Spaces\<close>
 text \<open>
 The records in Isabelle are
-extensible \<^cite>\<open>"Nipkow-02-hol" and "NaraschewskiW-TPHOLs98"\<close>. In principle this can be exploited
+extensible \cite{Nipkow-02-hol,NaraschewskiW-TPHOLs98}. In principle this can be exploited
 during verification. The state space can be extended while we we add procedures.
 But there is one major drawback:
 \begin{itemize}
   \item records can only be extended in a linear fashion (there is no multiple inheritance)
 \end{itemize}
 
 You can extend both the main state record as well as the record for the global variables.
 \<close>
 
 subsubsection \<open>Mapping Variables to Record Fields\<close>
 
 text \<open>
 Generally the state space (global and local variables) is flat and all components
 are accessible from everywhere. Locality or globality of variables is achieved by
 the proper \<open>init\<close> and \<open>return\<close>/\<open>result\<close> functions in procedure
 calls. What is the best way to map programming language variables to the state records?
 One way is to disambiguate all names, by using the procedure names as prefix or the
 structure names for heap components. This leads to long names and lots of
 record components. But for local variables this is not necessary, since
 variable @{term i} of procedure @{term A} and variable @{term "i"} of procedure @{term B}
 can be mapped to the same record component, without any harm, provided they have the
 same logical type. Therefor for local variables it is preferable to map them per type. You
 only have to distinguish a variable with the same name if they have a different type.
 Note that all pointers just have logical type \<open>ref\<close>. So you even do not
 have to distinguish between a  pointer \<open>p\<close> to a integer and a pointer \<open>p\<close> to
 a list.
 For global components (global variables and heap structures) you have to disambiguate the
 name. But hopefully the field names of structures have different names anyway.
 Also note that there is no notion of hiding of a global component by a local one in
 the logic. You have to disambiguate global and local names!
 As the names of the components show up in the specifications and the
 proof obligations, names are even more important as for programming. Try to
 find meaningful and short names, to avoid cluttering up your reasoning.
 \<close>
 
 (*<*)
 text \<open>
 in locales, includes, spec or impl?
 Names: per type not per procedure\<dots>
 downgrading total to partial\<dots>
 \<close>
 (*>*)
 text \<open>\<close>
 (*<*)
 end
 (*>*)
diff --git a/thys/Simpl/Vcg.thy b/thys/Simpl/Vcg.thy
--- a/thys/Simpl/Vcg.thy
+++ b/thys/Simpl/Vcg.thy
@@ -1,663 +1,656 @@
 (*  Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Vcg.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>Facilitating the Hoare Logic\<close>
 theory Vcg
 imports StateSpace "HOL-Statespace.StateSpaceLocale" Generalise
 keywords "procedures" "hoarestate" :: thy_defn
 begin
 
 axiomatization NoBody::"('s,'p,'f) com"
 
 ML_file \<open>hoare.ML\<close>
 
 method_setup hoare = "Hoare.hoare"
   "raw verification condition generator for Hoare Logic"
 
 method_setup hoare_raw = "Hoare.hoare_raw"
   "even more raw verification condition generator for Hoare Logic"
 
 method_setup vcg = "Hoare.vcg"
   "verification condition generator for Hoare Logic"
 
 method_setup vcg_step = "Hoare.vcg_step"
   "single verification condition generation step with light simplification"
 
 
 method_setup hoare_rule = "Hoare.hoare_rule"
   "apply single hoare rule and solve certain sideconditions"
 
 text \<open>Variables of the programming language are represented as components
 of a record. To avoid cluttering up the namespace of Isabelle with lots of
 typical variable names, we append a unusual suffix at the end of each name by
 parsing
 \<close>
 
 definition list_multsel:: "'a list \<Rightarrow> nat list \<Rightarrow> 'a list" (infixl "!!" 100)
   where "xs !! ns = map (nth xs) ns"
 
 definition list_multupd:: "'a list \<Rightarrow> nat list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where "list_multupd xs ns ys = foldl (\<lambda>xs (n,v). xs[n:=v]) xs (zip ns ys)"
 
 nonterminal lmupdbinds and lmupdbind
 
 syntax
   \<comment> \<open>multiple list update\<close>
   "_lmupdbind":: "['a, 'a] => lmupdbind"    ("(2_ [:=]/ _)")
   "" :: "lmupdbind => lmupdbinds"    ("_")
   "_lmupdbinds" :: "[lmupdbind, lmupdbinds] => lmupdbinds"    ("_,/ _")
   "_LMUpdate" :: "['a, lmupdbinds] => 'a"    ("_/[(_)]" [900,0] 900)
 
 translations
   "_LMUpdate xs (_lmupdbinds b bs)" == "_LMUpdate (_LMUpdate xs b) bs"
   "xs[is[:=]ys]" == "CONST list_multupd xs is ys"
 
 
 subsection \<open>Some Fancy Syntax\<close>
 
 
 (* priority guidline:
  * If command should be atomic for the guard it must have at least priority 21.
  *)
 
 text \<open>reverse application\<close>
 definition rapp:: "'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b" (infixr "|>" 60)
   where "rapp x f = f x"
 
 
 nonterminal
   newinit and
   newinits and
   locinit and
   locinits and
   switchcase and
   switchcases and
   grds and
   grd and
   bdy and
   basics and
   basic and
   basicblock
 
 notation
   Skip  ("SKIP") and
   Throw  ("THROW")
 
 syntax
   "_raise":: "'c \<Rightarrow> 'c \<Rightarrow> ('a,'b,'f) com"       ("(RAISE _ :==/ _)" [30, 30] 23)
   "_seq"::"('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com" ("_;;/ _" [20, 21] 20)
   "_guarantee"     :: "'s set \<Rightarrow> grd"       ("_\<surd>" [1000] 1000)
   "_guaranteeStrip":: "'s set \<Rightarrow> grd"       ("_#" [1000] 1000)
   "_grd"           :: "'s set \<Rightarrow> grd"       ("_" [1000] 1000)
   "_last_grd"      :: "grd \<Rightarrow> grds"         ("_" 1000)
   "_grds"          :: "[grd, grds] \<Rightarrow> grds" ("_,/ _" [999,1000] 1000)
   "_guards"        :: "grds \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
                                             ("(_/\<longmapsto> _)" [60, 21] 23)
   "_quote"       :: "'b => ('a => 'b)"
   "_antiquoteCur0"  :: "('a => 'b) => 'b"       ("\<acute>_" [1000] 1000)
   "_antiquoteCur"  :: "('a => 'b) => 'b"
   "_antiquoteOld0"  :: "('a => 'b) => 'a => 'b"       ("\<^bsup>_\<^esup>_" [1000,1000] 1000)
   "_antiquoteOld"  :: "('a => 'b) => 'a => 'b"
   "_Assert"      :: "'a => 'a set"            ("(\<lbrace>_\<rbrace>)" [0] 1000)
   "_AssertState" :: "idt \<Rightarrow> 'a => 'a set"     ("(\<lbrace>_. _\<rbrace>)" [1000,0] 1000)
   "_Assign"      :: "'b => 'b => ('a,'p,'f) com"    ("(_ :==/ _)" [30, 30] 23)
   "_Init"        :: "ident \<Rightarrow> 'c \<Rightarrow> 'b \<Rightarrow> ('a,'p,'f) com"
                                              ("(\<acute>_ :==\<^bsub>_\<^esub>/ _)" [30,1000, 30] 23)
   "_GuardedAssign":: "'b => 'b => ('a,'p,'f) com"    ("(_ :==\<^sub>g/ _)" [30, 30] 23)
   "_newinit"      :: "[ident,'a] \<Rightarrow> newinit" ("(2\<acute>_ :==/ _)")
   ""             :: "newinit \<Rightarrow> newinits"    ("_")
   "_newinits"    :: "[newinit, newinits] \<Rightarrow> newinits" ("_,/ _")
   "_New"         :: "['a, 'b, newinits] \<Rightarrow> ('a,'b,'f) com"
                                             ("(_ :==/(2 NEW _/ [_]))" [30, 65, 0] 23)
   "_GuardedNew"  :: "['a, 'b, newinits] \<Rightarrow> ('a,'b,'f) com"
                                             ("(_ :==\<^sub>g/(2 NEW _/ [_]))" [30, 65, 0] 23)
   "_NNew"         :: "['a, 'b, newinits] \<Rightarrow> ('a,'b,'f) com"
                                             ("(_ :==/(2 NNEW _/ [_]))" [30, 65, 0] 23)
   "_GuardedNNew"  :: "['a, 'b, newinits] \<Rightarrow> ('a,'b,'f) com"
                                             ("(_ :==\<^sub>g/(2 NNEW _/ [_]))" [30, 65, 0] 23)
 
   "_Cond"        :: "'a bexp => ('a,'p,'f) com => ('a,'p,'f) com => ('a,'p,'f) com"
         ("(0IF (_)/ (2THEN/ _)/ (2ELSE _)/ FI)" [0, 0, 0] 71)
   "_Cond_no_else":: "'a bexp => ('a,'p,'f) com => ('a,'p,'f) com"
         ("(0IF (_)/ (2THEN/ _)/ FI)" [0, 0] 71)
   "_GuardedCond" :: "'a bexp => ('a,'p,'f) com => ('a,'p,'f) com => ('a,'p,'f) com"
         ("(0IF\<^sub>g (_)/ (2THEN _)/ (2ELSE _)/ FI)" [0, 0, 0] 71)
   "_GuardedCond_no_else":: "'a bexp => ('a,'p,'f) com => ('a,'p,'f) com"
         ("(0IF\<^sub>g (_)/ (2THEN _)/ FI)" [0, 0] 71)
   "_While_inv_var"   :: "'a bexp => 'a assn  \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> bdy
                           \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_)/ INV (_)/ VAR (_) /_)"  [25, 0, 0, 81] 71)
   "_WhileFix_inv_var"   :: "'a bexp => pttrn \<Rightarrow> ('z \<Rightarrow> 'a assn)  \<Rightarrow>
                             ('z \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> bdy
                           \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_)/ FIX _./ INV (_)/ VAR (_) /_)"  [25, 0, 0, 0, 81] 71)
   "_WhileFix_inv"   :: "'a bexp => pttrn \<Rightarrow> ('z \<Rightarrow> 'a assn)  \<Rightarrow> bdy
                           \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_)/ FIX _./ INV (_) /_)"  [25, 0, 0, 81] 71)
   "_GuardedWhileFix_inv_var"   :: "'a bexp => pttrn \<Rightarrow> ('z \<Rightarrow> 'a assn)  \<Rightarrow>
                             ('z \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> bdy
                           \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE\<^sub>g (_)/ FIX _./ INV (_)/ VAR (_) /_)"  [25, 0, 0, 0, 81] 71)
   "_GuardedWhileFix_inv_var_hook"   :: "'a bexp \<Rightarrow> ('z \<Rightarrow> 'a assn)  \<Rightarrow>
                             ('z \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> bdy
                           \<Rightarrow> ('a,'p,'f) com"
   "_GuardedWhileFix_inv"   :: "'a bexp => pttrn \<Rightarrow> ('z \<Rightarrow> 'a assn)  \<Rightarrow> bdy
                           \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE\<^sub>g (_)/ FIX _./ INV (_)/_)"  [25, 0, 0, 81] 71)
 
   "_GuardedWhile_inv_var"::
        "'a bexp => 'a assn  \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE\<^sub>g (_)/ INV (_)/ VAR (_) /_)"  [25, 0, 0, 81] 71)
   "_While_inv"   :: "'a bexp => 'a assn => bdy => ('a,'p,'f) com"
         ("(0WHILE (_)/ INV (_) /_)"  [25, 0, 81] 71)
   "_GuardedWhile_inv"   :: "'a bexp => 'a assn => ('a,'p,'f) com => ('a,'p,'f) com"
         ("(0WHILE\<^sub>g (_)/ INV (_) /_)"  [25, 0, 81] 71)
   "_While"       :: "'a bexp => bdy => ('a,'p,'f) com"
         ("(0WHILE (_) /_)"  [25, 81] 71)
   "_GuardedWhile"       :: "'a bexp => bdy => ('a,'p,'f) com"
         ("(0WHILE\<^sub>g (_) /_)"  [25, 81] 71)
   "_While_guard"       :: "grds => 'a bexp => bdy => ('a,'p,'f) com"
         ("(0WHILE (_/\<longmapsto> (1_)) /_)"  [1000,25,81] 71)
   "_While_guard_inv":: "grds \<Rightarrow>'a bexp\<Rightarrow>'a assn\<Rightarrow>bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_/\<longmapsto> (1_)) INV (_) /_)"  [1000,25,0,81] 71)
   "_While_guard_inv_var":: "grds \<Rightarrow>'a bexp\<Rightarrow>'a assn\<Rightarrow>('a\<times>'a) set
                              \<Rightarrow>bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_/\<longmapsto> (1_)) INV (_)/ VAR (_) /_)"  [1000,25,0,0,81] 71)
   "_WhileFix_guard_inv_var":: "grds \<Rightarrow>'a bexp\<Rightarrow>pttrn\<Rightarrow>('z\<Rightarrow>'a assn)\<Rightarrow>('z\<Rightarrow>('a\<times>'a) set)
                              \<Rightarrow>bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_/\<longmapsto> (1_)) FIX _./ INV (_)/ VAR (_) /_)"  [1000,25,0,0,0,81] 71)
   "_WhileFix_guard_inv":: "grds \<Rightarrow>'a bexp\<Rightarrow>pttrn\<Rightarrow>('z\<Rightarrow>'a assn)
                              \<Rightarrow>bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_/\<longmapsto> (1_)) FIX _./ INV (_)/_)"  [1000,25,0,0,81] 71)
 
   "_Try_Catch":: "('a,'p,'f) com \<Rightarrow>('a,'p,'f) com \<Rightarrow> ('a,'p,'f) com"
         ("(0TRY (_)/ (2CATCH _)/ END)"  [0,0] 71)
 
   "_DoPre" :: "('a,'p,'f) com \<Rightarrow> ('a,'p,'f) com"
   "_Do" :: "('a,'p,'f) com \<Rightarrow> bdy" ("(2DO/ (_)) /OD" [0] 1000)
   "_Lab":: "'a bexp \<Rightarrow> ('a,'p,'f) com \<Rightarrow> bdy"
             ("_\<bullet>/_" [1000,71] 81)
   "":: "bdy \<Rightarrow> ('a,'p,'f) com" ("_")
   "_Spec":: "pttrn \<Rightarrow> 's set \<Rightarrow>  ('s,'p,'f) com \<Rightarrow> 's set \<Rightarrow> 's set \<Rightarrow> ('s,'p,'f) com"
             ("(ANNO _. _/ (_)/ _,/_)" [0,1000,20,1000,1000] 60)
   "_SpecNoAbrupt":: "pttrn \<Rightarrow> 's set \<Rightarrow>  ('s,'p,'f) com \<Rightarrow> 's set \<Rightarrow> ('s,'p,'f) com"
             ("(ANNO _. _/ (_)/ _)" [0,1000,20,1000] 60)
   "_LemAnno":: "'n \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
               ("(0 LEMMA (_)/ _ END)" [1000,0] 71)
   "_locnoinit"    :: "ident \<Rightarrow> locinit"               ("\<acute>_")
   "_locinit"      :: "[ident,'a] \<Rightarrow> locinit"          ("(2\<acute>_ :==/ _)")
   ""             :: "locinit \<Rightarrow> locinits"             ("_")
   "_locinits"    :: "[locinit, locinits] \<Rightarrow> locinits" ("_,/ _")
   "_Loc":: "[locinits,('s,'p,'f) com] \<Rightarrow> ('s,'p,'f) com"
                                          ("(2 LOC _;;/ (_) COL)" [0,0] 71)
   "_Switch":: "('s \<Rightarrow> 'v) \<Rightarrow> switchcases \<Rightarrow> ('s,'p,'f) com"
               ("(0 SWITCH (_)/ _ END)" [22,0] 71)
   "_switchcase":: "'v set \<Rightarrow> ('s,'p,'f) com \<Rightarrow> switchcase" ("_\<Rightarrow>/ _" )
   "_switchcasesSingle"  :: "switchcase \<Rightarrow> switchcases" ("_")
   "_switchcasesCons":: "switchcase \<Rightarrow> switchcases \<Rightarrow> switchcases"
                        ("_/ | _")
   "_Basic":: "basicblock \<Rightarrow> ('s,'p,'f) com" ("(0BASIC/ (_)/ END)" [22] 71)
   "_BasicBlock":: "basics \<Rightarrow> basicblock" ("_")
   "_BAssign"   :: "'b => 'b => basic"    ("(_ :==/ _)" [30, 30] 23)
   ""           :: "basic \<Rightarrow> basics"             ("_")
   "_basics"    :: "[basic, basics] \<Rightarrow> basics" ("_,/ _")
 
 syntax (ASCII)
   "_Assert"      :: "'a => 'a set"           ("({|_|})" [0] 1000)
   "_AssertState" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a set"    ("({|_. _|})" [1000,0] 1000)
   "_While_guard"       :: "grds => 'a bexp => bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_|-> /_) /_)"  [0,0,1000] 71)
   "_While_guard_inv":: "grds\<Rightarrow>'a bexp\<Rightarrow>'a assn\<Rightarrow>bdy \<Rightarrow> ('a,'p,'f) com"
         ("(0WHILE (_|-> /_) INV (_) /_)"  [0,0,0,1000] 71)
   "_guards" :: "grds \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com" ("(_|->_ )" [60, 21] 23)
 
 syntax (output)
   "_hidden_grds"      :: "grds" ("\<dots>")
 
 translations
   "_Do c" => "c"
   "b\<bullet> c" => "CONST condCatch c b SKIP"
   "b\<bullet> (_DoPre c)" <= "CONST condCatch c b SKIP"
   "l\<bullet> (CONST whileAnnoG gs b I V c)" <= "l\<bullet> (_DoPre (CONST whileAnnoG gs b I V c))"
   "l\<bullet> (CONST whileAnno b I V c)" <= "l\<bullet> (_DoPre (CONST whileAnno b I V c))"
   "CONST condCatch c b SKIP" <= "(_DoPre (CONST condCatch c b SKIP))"
   "_Do c" <= "_DoPre c"
   "c;; d" == "CONST Seq c d"
   "_guarantee g" => "(CONST True, g)"
   "_guaranteeStrip g" == "CONST guaranteeStripPair (CONST True) g"
   "_grd g" => "(CONST False, g)"
   "_grds g gs" => "g#gs"
   "_last_grd g" => "[g]"
   "_guards gs c" == "CONST guards gs c"
 
   "{|s. P|}"                   == "{|_antiquoteCur((=) s) \<and> P |}"
   "{|b|}"                   => "CONST Collect (_quote b)"
   "IF b THEN c1 ELSE c2 FI" => "CONST Cond {|b|} c1 c2"
   "IF b THEN c1 FI"         ==  "IF b THEN c1 ELSE SKIP FI"
   "IF\<^sub>g b THEN c1 FI"        ==  "IF\<^sub>g b THEN c1 ELSE SKIP FI"
 
   "_While_inv_var b I V c"          => "CONST whileAnno {|b|} I V c"
   "_While_inv_var b I V (_DoPre c)" <= "CONST whileAnno {|b|} I V c"
   "_While_inv b I c"                 == "_While_inv_var b I (CONST undefined) c"
   "_While b c"                       == "_While_inv b {|CONST undefined|} c"
 
   "_While_guard_inv_var gs b I V c"          => "CONST whileAnnoG gs {|b|} I V c"
 (*  "_While_guard_inv_var gs b I V (_DoPre c)" <= "CONST whileAnnoG gs {|b|} I V c"*)
   "_While_guard_inv gs b I c"       == "_While_guard_inv_var gs b I (CONST undefined) c"
   "_While_guard gs b c"             == "_While_guard_inv gs b {|CONST undefined|} c"
 
   "_GuardedWhile_inv b I c"  == "_GuardedWhile_inv_var b I (CONST undefined) c"
   "_GuardedWhile b c"        == "_GuardedWhile_inv b {|CONST undefined|} c"
 (*  "\<^bsup>s\<^esup>A"                      => "A s"*)
   "TRY c1 CATCH c2 END"     == "CONST Catch c1 c2"
   "ANNO s. P c Q,A" => "CONST specAnno (\<lambda>s. P) (\<lambda>s. c) (\<lambda>s. Q) (\<lambda>s. A)"
   "ANNO s. P c Q" == "ANNO s. P c Q,{}"
 
   "_WhileFix_inv_var b z I V c" => "CONST whileAnnoFix {|b|} (\<lambda>z. I) (\<lambda>z. V) (\<lambda>z. c)"
   "_WhileFix_inv_var b z I V (_DoPre c)" <= "_WhileFix_inv_var {|b|} z I V c"
   "_WhileFix_inv b z I c" == "_WhileFix_inv_var b z I (CONST undefined) c"
 
   "_GuardedWhileFix_inv b z I c" == "_GuardedWhileFix_inv_var b z I (CONST undefined) c"
 
   "_GuardedWhileFix_inv_var b z I V c" =>
                          "_GuardedWhileFix_inv_var_hook {|b|} (\<lambda>z. I) (\<lambda>z. V) (\<lambda>z. c)"
 
   "_WhileFix_guard_inv_var gs b z I V c" =>
                                       "CONST whileAnnoGFix gs {|b|} (\<lambda>z. I) (\<lambda>z. V) (\<lambda>z. c)"
   "_WhileFix_guard_inv_var gs b z I V (_DoPre c)" <=
                                       "_WhileFix_guard_inv_var gs {|b|} z I V c"
   "_WhileFix_guard_inv gs b z I c" == "_WhileFix_guard_inv_var gs b z I (CONST undefined) c"
   "LEMMA x c END" == "CONST lem x c"
 translations
  "(_switchcase V c)" => "(V,c)"
  "(_switchcasesSingle b)" => "[b]"
  "(_switchcasesCons b bs)" => "CONST Cons b bs"
  "(_Switch v vs)" => "CONST switch (_quote v) vs"
 
 parse_ast_translation \<open>
   let
     fun tr c asts = Ast.mk_appl (Ast.Constant c) (map Ast.strip_positions asts)
   in
    [(@{syntax_const "_antiquoteCur0"}, K (tr @{syntax_const "_antiquoteCur"})),
     (@{syntax_const "_antiquoteOld0"}, K (tr @{syntax_const "_antiquoteOld"}))]
   end
 \<close>
 
 print_ast_translation \<open>
   let
     fun tr c asts = Ast.mk_appl (Ast.Constant c) asts
   in
    [(@{syntax_const "_antiquoteCur"}, K (tr @{syntax_const "_antiquoteCur0"})),
     (@{syntax_const "_antiquoteOld"}, K (tr @{syntax_const "_antiquoteOld0"}))]
   end
 \<close>
 
 print_ast_translation \<open>
   let
     fun dest_abs (Ast.Appl [Ast.Constant @{syntax_const "_abs"}, x, t]) = (x, t)
       | dest_abs _ = raise Match;
     fun spec_tr' [P, c, Q, A] =
       let
         val (x',P') = dest_abs P;
         val (_ ,c') = dest_abs c;
         val (_ ,Q') = dest_abs Q;
         val (_ ,A') = dest_abs A;
       in
         if (A' = Ast.Constant @{const_syntax bot})
         then Ast.mk_appl (Ast.Constant @{syntax_const "_SpecNoAbrupt"}) [x', P', c', Q']
         else Ast.mk_appl (Ast.Constant @{syntax_const "_Spec"}) [x', P', c', Q', A']
       end;
     fun whileAnnoFix_tr' [b, I, V, c] =
       let
         val (x',I') = dest_abs I;
         val (_ ,V') = dest_abs V;
         val (_ ,c') = dest_abs c;
       in
         Ast.mk_appl (Ast.Constant @{syntax_const "_WhileFix_inv_var"}) [b, x', I', V', c']
       end;
   in
    [(@{const_syntax specAnno}, K spec_tr'),
     (@{const_syntax whileAnnoFix}, K whileAnnoFix_tr')]
   end
 \<close>
 
 
 
 syntax
   "_faccess"  :: "'ref \<Rightarrow> ('ref \<Rightarrow> 'v) \<Rightarrow> 'v"
    ("_\<rightarrow>_" [65,1000] 100)
 
 syntax (ASCII)
   "_faccess"  :: "'ref \<Rightarrow> ('ref \<Rightarrow> 'v) \<Rightarrow> 'v"
    ("_->_" [65,1000] 100)
 
 translations
 
  "p\<rightarrow>f"        =>  "f p"
  "g\<rightarrow>(_antiquoteCur f)" <= "_antiquoteCur f g"
 
 
 nonterminal par and pars and actuals
 
 syntax
   "_par" :: "'a \<Rightarrow> par"                                ("_")
   ""    :: "par \<Rightarrow> pars"                               ("_")
   "_pars" :: "[par,pars] \<Rightarrow> pars"                      ("_,/_")
   "_actuals" :: "pars \<Rightarrow> actuals"                      ("'(_')")
   "_actuals_empty" :: "actuals"                        ("'(')")
 
 syntax "_Call" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("CALL __" [1000,1000] 21)
        "_GuardedCall" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("CALL\<^sub>g __" [1000,1000] 21)
        "_CallAss":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
              ("_ :== CALL __" [30,1000,1000] 21)
+       "_Call_exn" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("CALL\<^sub>e __" [1000,1000] 21)
+       "_CallAss_exn":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
+             ("_ :== CALL\<^sub>e __" [30,1000,1000] 21)
        "_Proc" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("PROC __" 21)
        "_ProcAss":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
              ("_ :== PROC __" [30,1000,1000] 21)
        "_GuardedCallAss":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
              ("_ :== CALL\<^sub>g __" [30,1000,1000] 21)
        "_DynCall" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("DYNCALL __" [1000,1000] 21)
        "_GuardedDynCall" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("DYNCALL\<^sub>g __" [1000,1000] 21)
        "_DynCallAss":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
              ("_ :== DYNCALL __" [30,1000,1000] 21)
+       "_DynCall_exn" :: "'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)" ("DYNCALL\<^sub>e __" [1000,1000] 21)
+       "_DynCallAss_exn":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
+             ("_ :== DYNCALL\<^sub>e __" [30,1000,1000] 21)
        "_GuardedDynCallAss":: "'a \<Rightarrow> 'p \<Rightarrow> actuals \<Rightarrow> (('a,string,'f) com)"
              ("_ :== DYNCALL\<^sub>g __" [30,1000,1000] 21)
 
        "_Bind":: "['s \<Rightarrow> 'v, idt, 'v \<Rightarrow> ('s,'p,'f) com] \<Rightarrow> ('s,'p,'f) com"
                       ("_ \<ggreater> _./ _" [22,1000,21] 21)
        "_bseq"::"('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'p,'f) com"
            ("_\<ggreater>/ _" [22, 21] 21)
        "_FCall" :: "['p,actuals,idt,(('a,string,'f) com)]\<Rightarrow> (('a,string,'f) com)"
                       ("CALL __ \<ggreater> _./ _" [1000,1000,1000,21] 21)
 
 
 
 translations
 "_Bind e i c" == "CONST bind (_quote e) (\<lambda>i. c)"
 "_FCall p acts i c" == "_FCall p acts (\<lambda>i. c)"
 "_bseq c d" == "CONST bseq c d"
 
 
 
 nonterminal modifyargs
 
 syntax
   "_may_modify" :: "['a,'a,modifyargs] \<Rightarrow> bool"
         ("_ may'_only'_modify'_globals _ in [_]" [100,100,0] 100)
   "_may_not_modify" :: "['a,'a] \<Rightarrow> bool"
         ("_ may'_not'_modify'_globals _" [100,100] 100)
   "_may_modify_empty" :: "['a,'a] \<Rightarrow> bool"
         ("_ may'_only'_modify'_globals _ in []" [100,100] 100)
   "_modifyargs" :: "[id,modifyargs] \<Rightarrow> modifyargs" ("_,/ _")
   ""            :: "id => modifyargs"              ("_")
 
 translations
 "s may_only_modify_globals Z in []" => "s may_not_modify_globals Z"
 
 
 definition Let':: "['a, 'a => 'b] => 'b"
   where "Let' = Let"
 
 ML_file \<open>hoare_syntax.ML\<close>
 
 
 parse_translation \<open>
   let
     val argsC = @{syntax_const "_modifyargs"};
     val globalsN = "globals";
     val ex = @{const_syntax mex};
     val eq = @{const_syntax meq};
     val varn = Hoare.varname;
 
     fun extract_args (Const (argsC,_)$Free (n,_)$t) = varn n::extract_args t
       | extract_args (Free (n,_)) = [varn n]
       | extract_args t            = raise TERM ("extract_args", [t])
 
     fun idx [] y = error "idx: element not in list"
      |  idx (x::xs) y = if x=y then 0 else (idx xs y)+1
 
     fun gen_update ctxt names (name,t) =
-        Hoare_Syntax.update_comp ctxt [] false true name (Bound (idx names name)) t
+        Hoare_Syntax.update_comp ctxt NONE [] false true name (Bound (idx names name)) t
 
     fun gen_updates ctxt names t = Library.foldr (gen_update ctxt names) (names,t)
 
     fun gen_ex (name,t) = Syntax.const ex $ Abs (name,dummyT,t)
 
     fun gen_exs names t = Library.foldr gen_ex (names,t)
 
 
     fun tr ctxt s Z names =
       let val upds = gen_updates ctxt (rev names) (Syntax.free globalsN$Z);
           val eq   = Syntax.const eq $ (Syntax.free globalsN$s) $ upds;
       in gen_exs names eq end;
 
     fun may_modify_tr ctxt [s,Z,names] = tr ctxt s Z
                                            (sort_strings (extract_args names))
     fun may_not_modify_tr ctxt [s,Z] = tr ctxt s Z []
   in
    [(@{syntax_const "_may_modify"}, may_modify_tr),
     (@{syntax_const "_may_not_modify"}, may_not_modify_tr)]
   end
 \<close>
 
 
 print_translation \<open>
   let
     val argsC = @{syntax_const "_modifyargs"};
     val chop = Hoare.chopsfx Hoare.deco;
 
     fun get_state ( _ $ _ $ t) = get_state t  (* for record-updates*)
       | get_state ( _ $ _ $ _ $ _ $ _ $ t) = get_state t (* for statespace-updates *)
       | get_state (globals$(s as Const (@{syntax_const "_free"},_) $ Free _)) = s
       | get_state (globals$(s as Const (@{syntax_const "_bound"},_) $ Free _)) = s
       | get_state (globals$(s as Const (@{syntax_const "_var"},_) $ Var _)) = s
       | get_state (globals$(s as Const _)) = s
       | get_state (globals$(s as Free _)) = s
       | get_state (globals$(s as Bound _)) = s
       | get_state t              = raise Match;
 
     fun mk_args [n] = Syntax.free (chop n)
       | mk_args (n::ns) = Syntax.const argsC $ Syntax.free (chop n) $ mk_args ns
       | mk_args _      = raise Match;
 
     fun tr' names (Abs (n,_,t)) = tr' (n::names) t
       | tr' names (Const (@{const_syntax mex},_) $ t) = tr' names t
       | tr' names (Const (@{const_syntax meq},_) $ (globals$s) $ upd) =
             let val Z = get_state upd;
 
             in (case names of
                   [] => Syntax.const @{syntax_const "_may_not_modify"} $ s $ Z
                 | xs => Syntax.const @{syntax_const "_may_modify"} $ s $ Z $ mk_args (rev names))
             end;
 
     fun may_modify_tr' [t] = tr' [] t
     fun may_not_modify_tr' [_$s,_$Z] = Syntax.const @{syntax_const "_may_not_modify"} $ s $ Z
   in
     [(@{const_syntax mex}, K may_modify_tr'),
      (@{const_syntax meq}, K may_not_modify_tr')]
   end
 \<close>
 
 
 (* decorate state components with suffix *)
 (*
 parse_ast_translation {*
  [(@{syntax_const "_Free"}, K Hoare_Syntax.free_arg_ast_tr),
   (@{syntax_const "_In"}, K Hoare_Syntax.in_arg_ast_tr),
   (@{syntax_const "_Where"}, K Hoare_Syntax.where_arg_ast_tr @{syntax_const "_Where"}),
   (@{syntax_const "_WhereElse"}, K Hoare_Syntax.where_arg_ast_tr @{syntax_const "_WhereElse"})
 ]
 *}
 *)
 (*
 parse_ast_translation {*
  [(@{syntax_const "_antiquoteOld"},
     Hoare_Syntax.antiquoteOld_varname_tr @{syntax_const "_antiquoteOld"})]
 *}
 *)
 
 
 parse_translation \<open>
  [(@{syntax_const "_antiquoteCur"},
     K (Hoare_Syntax.antiquote_varname_tr @{syntax_const "_antiquoteCur"}))]
 \<close>
 
 
 parse_translation \<open>
  [(@{syntax_const "_antiquoteOld"}, Hoare_Syntax.antiquoteOld_tr),
-  (@{syntax_const "_Call"}, Hoare_Syntax.call_tr false false),
+  (@{syntax_const "_Call"}, Hoare_Syntax.call_tr false false []),
+  (@{syntax_const "_Call_exn"}, Hoare_Syntax.call_tr false true []),
   (@{syntax_const "_FCall"}, Hoare_Syntax.fcall_tr),
-  (@{syntax_const "_CallAss"}, Hoare_Syntax.call_ass_tr false false),
-  (@{syntax_const "_GuardedCall"}, Hoare_Syntax.call_tr false true),
-  (@{syntax_const "_GuardedCallAss"}, Hoare_Syntax.call_ass_tr false true),
+  (@{syntax_const "_CallAss"}, Hoare_Syntax.call_ass_tr false false []),
+  (@{syntax_const "_CallAss_exn"}, Hoare_Syntax.call_ass_tr false true []),
+  (@{syntax_const "_GuardedCall"}, Hoare_Syntax.call_tr false true []),
+  (@{syntax_const "_GuardedCallAss"}, Hoare_Syntax.call_ass_tr false true []),
   (@{syntax_const "_Proc"}, Hoare_Syntax.proc_tr),
   (@{syntax_const "_ProcAss"}, Hoare_Syntax.proc_ass_tr),
-  (@{syntax_const "_DynCall"}, Hoare_Syntax.call_tr true false),
-  (@{syntax_const "_DynCallAss"}, Hoare_Syntax.call_ass_tr true false),
-  (@{syntax_const "_GuardedDynCall"}, Hoare_Syntax.call_tr true true),
-  (@{syntax_const "_GuardedDynCallAss"}, Hoare_Syntax.call_ass_tr true true),
+  (@{syntax_const "_DynCall"}, Hoare_Syntax.call_tr true false []),
+  (@{syntax_const "_DynCall_exn"}, Hoare_Syntax.call_tr true true []),
+  (@{syntax_const "_DynCallAss"}, Hoare_Syntax.call_ass_tr true false []),
+  (@{syntax_const "_DynCallAss_exn"}, Hoare_Syntax.call_ass_tr true true []),
+  (@{syntax_const "_GuardedDynCall"}, Hoare_Syntax.call_tr true true []),
+  (@{syntax_const "_GuardedDynCallAss"}, Hoare_Syntax.call_ass_tr true true []),
   (@{syntax_const "_BasicBlock"}, Hoare_Syntax.basic_assigns_tr)]
 \<close>
 
 (*
   (@{syntax_const "_Call"}, Hoare_Syntax.call_ast_tr),
   (@{syntax_const "_CallAss"}, Hoare_Syntax.call_ass_ast_tr),
   (@{syntax_const "_GuardedCall"}, Hoare_Syntax.guarded_call_ast_tr),
   (@{syntax_const "_GuardedCallAss"}, Hoare_Syntax.guarded_call_ass_ast_tr)
 *)
 
 parse_translation \<open>
   let
     fun quote_tr ctxt [t] = Hoare_Syntax.quote_tr ctxt @{syntax_const "_antiquoteCur"} t
       | quote_tr ctxt ts = raise TERM ("quote_tr", ts);
   in [(@{syntax_const "_quote"}, quote_tr)] end
 \<close>
 
 
 
 parse_translation \<open>
  [(@{syntax_const "_Assign"}, Hoare_Syntax.assign_tr),
   (@{syntax_const "_raise"}, Hoare_Syntax.raise_tr),
   (@{syntax_const "_New"}, Hoare_Syntax.new_tr),
   (@{syntax_const "_NNew"}, Hoare_Syntax.nnew_tr),
   (@{syntax_const "_GuardedAssign"}, Hoare_Syntax.guarded_Assign_tr),
   (@{syntax_const "_GuardedNew"}, Hoare_Syntax.guarded_New_tr),
   (@{syntax_const "_GuardedNNew"}, Hoare_Syntax.guarded_NNew_tr),
   (@{syntax_const "_GuardedWhile_inv_var"}, Hoare_Syntax.guarded_While_tr),
   (@{syntax_const "_GuardedWhileFix_inv_var_hook"}, Hoare_Syntax.guarded_WhileFix_tr),
   (@{syntax_const "_GuardedCond"}, Hoare_Syntax.guarded_Cond_tr),
   (@{syntax_const "_Basic"}, Hoare_Syntax.basic_tr)]
 \<close>
 
 parse_translation \<open>
  [(@{syntax_const "_Init"}, Hoare_Syntax.init_tr),
   (@{syntax_const "_Loc"}, Hoare_Syntax.loc_tr)]
 \<close>
 
 
 print_translation \<open>
  [(@{const_syntax Basic}, Hoare_Syntax.assign_tr'),
   (@{const_syntax raise}, Hoare_Syntax.raise_tr'),
   (@{const_syntax Basic}, Hoare_Syntax.new_tr'),
   (@{const_syntax Basic}, Hoare_Syntax.init_tr'),
   (@{const_syntax Spec}, Hoare_Syntax.nnew_tr'),
   (@{const_syntax block}, Hoare_Syntax.loc_tr'),
   (@{const_syntax Collect}, Hoare_Syntax.assert_tr'),
   (@{const_syntax Cond}, Hoare_Syntax.bexp_tr' "_Cond"),
   (@{const_syntax switch}, Hoare_Syntax.switch_tr'),
   (@{const_syntax Basic}, Hoare_Syntax.basic_tr'),
   (@{const_syntax guards}, Hoare_Syntax.guards_tr'),
   (@{const_syntax whileAnnoG}, Hoare_Syntax.whileAnnoG_tr'),
   (@{const_syntax whileAnnoGFix}, Hoare_Syntax.whileAnnoGFix_tr'),
   (@{const_syntax bind}, Hoare_Syntax.bind_tr')]
 \<close>
 
 
 print_translation \<open>
   let
     fun spec_tr' ctxt ((coll as Const _)$
                    ((splt as Const _) $ (t as (Abs (s,T,p))))::ts) =
           let
             fun selector (Const (c, T)) = Hoare.is_state_var c
               | selector (Const (@{syntax_const "_free"}, _) $ (Free (c, T))) =
                   Hoare.is_state_var c
               | selector _ = false;
           in
             if Hoare_Syntax.antiquote_applied_only_to selector p then
               Syntax.const @{const_syntax Spec} $ coll $
                 (splt $ Hoare_Syntax.quote_mult_tr' ctxt selector
                     Hoare_Syntax.antiquoteCur Hoare_Syntax.antiquoteOld  (Abs (s,T,t)))
              else raise Match
           end
       | spec_tr' _ ts = raise Match
   in [(@{const_syntax Spec}, spec_tr')] end
 \<close>
 
 syntax
 "_Measure":: "('a \<Rightarrow> nat) \<Rightarrow> ('a \<times> 'a) set"
       ("MEASURE _" [22] 1)
 "_Mlex":: "('a \<Rightarrow> nat) \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
       (infixr "<*MLEX*>" 30)
 
 
 translations
  "MEASURE f"       => "(CONST measure) (_quote f)"
  "f <*MLEX*> r"       => "(_quote f) <*mlex*> r"
 
 
 
 print_translation \<open>
   let
     fun selector (Const (c,T)) = Hoare.is_state_var c
       | selector _ = false;
 
     fun measure_tr' ctxt ((t as (Abs (_,_,p)))::ts) =
           if Hoare_Syntax.antiquote_applied_only_to selector p
           then Hoare_Syntax.app_quote_tr' ctxt (Syntax.const @{syntax_const "_Measure"}) (t::ts)
           else raise Match
       | measure_tr' _ _ = raise Match
 
     fun mlex_tr' ctxt ((t as (Abs (_,_,p)))::r::ts) =
           if Hoare_Syntax.antiquote_applied_only_to selector p
           then Hoare_Syntax.app_quote_tr' ctxt (Syntax.const @{syntax_const "_Mlex"}) (t::r::ts)
           else raise Match
       | mlex_tr' _ _ = raise Match
 
   in
    [(@{const_syntax measure}, measure_tr'),
     (@{const_syntax mlex_prod}, mlex_tr')]
   end
 \<close>
 
 
 print_translation \<open>
  [(@{const_syntax call}, Hoare_Syntax.call_tr'),
   (@{const_syntax dynCall}, Hoare_Syntax.dyn_call_tr'),
+  (@{const_syntax call_exn}, Hoare_Syntax.call_exn_tr'),
+  (@{const_syntax dynCall_exn}, Hoare_Syntax.dyn_call_exn_tr'),
   (@{const_syntax fcall}, Hoare_Syntax.fcall_tr'),
   (@{const_syntax Call}, Hoare_Syntax.proc_tr')]
 \<close>
 
 end
diff --git a/thys/Simpl/XVcg.thy b/thys/Simpl/XVcg.thy
--- a/thys/Simpl/XVcg.thy
+++ b/thys/Simpl/XVcg.thy
@@ -1,57 +1,36 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      XVcg.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 theory XVcg
 imports Vcg
 
 begin
 
 
 text \<open>We introduce a syntactic variant of the let-expression so that we can
 safely unfold it during verification condition generation. With the new
 theorem attribute \<open>vcg_simp\<close> we can declare equalities to be used
 by the verification condition generator, while simplifying assertions.
 \<close>
 
 syntax
 "_Let'" :: "[letbinds, basicblock] => basicblock"  ("(LET (_)/ IN (_))" 23)
 
 translations
   "_Let' (_binds b bs) e"  == "_Let' b (_Let' bs e)"
   "_Let' (_bind x a) e"    == "CONST Let' a (%x. e)"
 
 
 lemma Let'_unfold [vcg_simp]: "Let' x f = f x"
   by (simp add: Let'_def Let_def)
 
 lemma Let'_split_conv [vcg_simp]:
   "(Let' x  (\<lambda>p. (case_prod (f p) (g p)))) =
    (Let' x  (\<lambda>p. (f p) (fst (g p)) (snd (g p))))"
   by (simp add: split_def)
 
 end
diff --git a/thys/Simpl/ex/Closure.thy b/thys/Simpl/ex/Closure.thy
--- a/thys/Simpl/ex/Closure.thy
+++ b/thys/Simpl/ex/Closure.thy
@@ -1,352 +1,331 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Closure.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section "Experiments with Closures"
 
 theory Closure
 imports "../Hoare"
 begin
 
 
 definition
 "callClosure upd cl = Seq (Basic (upd (fst cl))) (Call (snd cl))"
 
 
 definition
 "dynCallClosure init upd cl return c =
   DynCom (\<lambda>s. call (upd (fst (cl s)) \<circ> init) (snd (cl s)) return c)"
 
 
 
 
 
 lemma dynCallClosure_sound:
 assumes adapt:
   "P \<subseteq> {s. \<exists>P' Q' A'. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F \<^esub> P' (callClosure upd (cl s)) Q',A' \<and>
                   init s \<in> P' \<and>
                   (\<forall>t \<in> Q'. return s t \<in> R s t) \<and>
                   (\<forall>t \<in> A'. return s t \<in> A)}"
 assumes res: "\<forall>s t n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 shows
 "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F \<^esub>P (dynCallClosure init upd cl return c) Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P Call p Q,A"
   assume exec: "\<Gamma>\<turnstile> \<langle>dynCallClosure init upd cl return c,Normal s\<rangle> =n\<Rightarrow> t"
   from execn.Basic [where f="(upd (fst (cl s)))" and s="(init s)"]
   have exec_upd: "\<Gamma>\<turnstile>\<langle>Basic (upd (fst (cl s))),Normal (init s)\<rangle> =n\<Rightarrow>
              Normal (((upd (fst (cl s))) \<circ> init) s)"
       by auto
   assume P: "s \<in> P"
   from P adapt obtain P' Q' A'
       where
       valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F \<^esub> P' (callClosure upd (cl s)) Q',A'" and
       init_P': "init s \<in> P'"  and
       R: "(\<forall>t \<in> Q'. return s t \<in> R s t)" and
       A: "(\<forall>t \<in> A'. return s t \<in> A)"
       by auto
   assume t_notin_F: "t \<notin> Fault ` F"
   from exec [simplified dynCallClosure_def]
   have exec_call:
       "\<Gamma>\<turnstile>\<langle>call (upd (fst (cl s)) \<circ> init) (snd (cl s)) return c,Normal s\<rangle> =n\<Rightarrow> t"
     by cases
   then
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof (cases rule: execn_call_Normal_elim)
     fix bdy m t'
     assume bdy: "\<Gamma> (snd (cl s)) = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =m\<Rightarrow> Normal t'"
     assume exec_c: "\<Gamma>\<turnstile>\<langle>c s t',Normal (return s t')\<rangle> =Suc m\<Rightarrow> t"
     assume n: "n = Suc m"
     have "\<Gamma>\<turnstile>\<langle>Basic init,Normal s\<rangle> =m\<Rightarrow> Normal (init s)"
       by (rule execn.Basic)
     from bdy exec_body
     have exec_callC:
       "\<Gamma>\<turnstile>\<langle>Call (snd (cl s)),Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =Suc m\<Rightarrow> Normal t'"
       by (rule execn.Call)
     from execn.Seq [OF exec_upd [simplified n]exec_callC]
     have exec_closure: "\<Gamma>\<turnstile> \<langle>callClosure upd (cl s),Normal (init s)\<rangle> =n\<Rightarrow> Normal t'"
       by (simp add: callClosure_def n)
     from cnvalidD [OF valid [rule_format] ctxt exec_closure init_P']
     have "t' \<in> Q'"
       by auto
     with R have "return s t' \<in> R s t'"
       by auto
     from cnvalidD [OF res [rule_format] ctxt exec_c [simplified n[symmetric]] this
          t_notin_F]
     show ?thesis
       by auto
   next
     fix bdy m t'
     assume bdy: "\<Gamma> (snd (cl s)) = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =m\<Rightarrow> Abrupt t'"
     assume t: "t=Abrupt (return s t')"
     assume n: "n = Suc m"
     from bdy exec_body
     have exec_callC:
       "\<Gamma>\<turnstile>\<langle>Call (snd (cl s)),Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =Suc m\<Rightarrow> Abrupt t'"
       by (rule execn.Call)
     from execn.Seq [OF exec_upd [simplified n] exec_callC]
     have exec_closure: "\<Gamma>\<turnstile> \<langle>callClosure upd (cl s),Normal (init s)\<rangle> =n\<Rightarrow> Abrupt t'"
       by (simp add: callClosure_def n)
 
     from cnvalidD [OF valid [rule_format] ctxt exec_closure init_P']
     have "t' \<in> A'"
       by auto
     with A have "return s t' \<in> A"
       by auto
     with t show ?thesis
       by auto
   next
     fix bdy m f
     assume bdy: "\<Gamma> (snd (cl s)) = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =m\<Rightarrow> Fault f"
     assume t: "t=Fault f"
     assume n: "n = Suc m"
     from bdy exec_body
     have exec_callC:
       "\<Gamma>\<turnstile>\<langle>Call (snd (cl s)),Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =Suc m\<Rightarrow> Fault f"
       by (rule execn.Call)
     from execn.Seq [OF exec_upd [simplified n] exec_callC]
     have exec_closure: "\<Gamma>\<turnstile> \<langle>callClosure upd (cl s),Normal (init s)\<rangle> =n\<Rightarrow> Fault f"
       by (simp add: callClosure_def n)
     from cnvalidD [OF valid [rule_format] ctxt exec_closure init_P'] t_notin_F t
     have False
       by auto
     thus ?thesis ..
   next
     fix bdy m
     assume bdy: "\<Gamma> (snd (cl s)) = Some bdy"
     assume exec_body: "\<Gamma>\<turnstile>\<langle>bdy,Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =m\<Rightarrow> Stuck"
     assume t: "t=Stuck"
     assume n: "n = Suc m"
     from execn.Basic [where f="(upd (fst (cl s)))" and s="(init s)"]
     have exec_upd: "\<Gamma>\<turnstile>\<langle>Basic (upd (fst (cl s))),Normal (init s)\<rangle> =Suc m\<Rightarrow>
              Normal (((upd (fst (cl s))) \<circ> init) s)"
       by auto
     from bdy exec_body
     have exec_callC:
       "\<Gamma>\<turnstile>\<langle>Call (snd (cl s)),Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =Suc m\<Rightarrow> Stuck"
       by (rule execn.Call)
     from execn.Seq [OF exec_upd [simplified n] exec_callC]
     have exec_closure: "\<Gamma>\<turnstile> \<langle>callClosure upd (cl s),Normal (init s)\<rangle> =n\<Rightarrow> Stuck"
       by (simp add: callClosure_def n)
     from cnvalidD [OF valid [rule_format] ctxt exec_closure init_P'] t_notin_F t
     have False
       by auto
     thus ?thesis ..
   next
     fix m
     assume no_bdy: "\<Gamma> (snd (cl s)) = None"
     assume t: "t=Stuck"
     assume n: "n = Suc m"
     from no_bdy
     have exec_callC:
       "\<Gamma>\<turnstile>\<langle>Call (snd (cl s)),Normal ((upd (fst (cl s)) \<circ> init) s)\<rangle> =Suc m\<Rightarrow> Stuck"
       by (rule execn.CallUndefined)
     from execn.Seq [OF exec_upd [simplified n]exec_callC]
     have exec_closure: "\<Gamma>\<turnstile> \<langle>callClosure upd (cl s),Normal (init s)\<rangle> =n\<Rightarrow> Stuck"
       by (simp add: callClosure_def n)
     from cnvalidD [OF valid [rule_format] ctxt exec_closure init_P'] t_notin_F t
     have False
       by auto
     thus ?thesis ..
   qed
 qed
 
 
 lemma dynCallClosure:
 assumes adapt: "P \<subseteq> {s. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub> P' (callClosure upd (cl s)) Q',A' \<and>
                   init s \<in> P' \<and>
                   (\<forall>t \<in> Q'. return s t \<in> R s t) \<and>
                   (\<forall>t \<in> A'. return s t \<in> A)}"
 assumes res: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 shows
 "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P (dynCallClosure init upd cl return c) Q,A"
   apply (rule hoare_complete')
   apply (rule allI)
   apply (rule dynCallClosure_sound [where R=R])
   using adapt
   apply (blast intro: hoare_cnvalid)
   using res
   apply (blast intro: hoare_cnvalid)
   done
 
 lemma in_subsetD: "\<lbrakk>P \<subseteq> P'; x \<in> P\<rbrakk> \<Longrightarrow> x \<in> P'"
   by blast
 
 lemma dynCallClosureFix:
 assumes adapt: "P \<subseteq> {s. \<exists>Z. cl'=cl s \<and>
                   init s \<in> P' Z \<and>
                   (\<forall>t \<in> Q' Z. return s t \<in> R s t) \<and>
                   (\<forall>t \<in> A' Z. return s t \<in> A)}"
 assumes res: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (R s t) (c s t) Q,A"
 assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub> (P' Z) (callClosure upd cl') (Q' Z),(A' Z)"
 shows
 "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P (dynCallClosure init upd cl return c) Q,A"
   apply (rule dynCallClosure [OF _ res])
   using adapt spec
   apply clarsimp
   apply (drule (1) in_subsetD)
   apply clarsimp
   apply (rule_tac x="P' Z" in exI)
   apply (rule_tac x="Q' Z" in exI)
   apply (rule_tac x="A' Z" in exI)
   apply blast
   done
 
 
 lemma conseq_extract_pre:
              "\<lbrakk>\<forall>s \<in> P. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> ({s}) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   apply (rule hoarep.Conseq)
   apply clarify
   apply (rule_tac x="{s}" in exI)
   apply (rule_tac x="Q" in exI)
   apply (rule_tac x="A" in exI)
   by simp
 
 
 
 lemma app_closure_sound:
   assumes adapt: "P \<subseteq> {s. \<exists>P' Q' A'. \<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P' (callClosure upd (e',p)) Q',A' \<and>
                            upd x s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A}"
   assumes ap: "upd e = upd e' \<circ> upd x"
   shows "\<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F\<^esub> P (callClosure upd (e,p)) Q,A"
 proof (rule cnvalidI)
   fix s t
   assume ctxt: "\<forall>(P, p, Q, A)\<in>\<Theta>. \<Gamma>\<Turnstile>n:\<^bsub>/F\<^esub> P Call p Q,A"
   assume exec_e: "\<Gamma>\<turnstile> \<langle>callClosure upd (e, p),Normal s\<rangle> =n\<Rightarrow> t"
   assume P: "s \<in> P"
   assume t: "t \<notin> Fault ` F"
   from P adapt obtain P' Q' A'
     where
     valid: "\<forall>n. \<Gamma>,\<Theta>\<Turnstile>n:\<^bsub>/F \<^esub> P' (callClosure upd (e',p)) Q',A'" and
     init_P': "upd x s \<in> P'"  and
     Q: "Q' \<subseteq> Q" and
     A: "A' \<subseteq> A"
     by auto
   from exec_e [simplified callClosure_def] obtain s'
     where
     exec_e: "\<Gamma>\<turnstile> \<langle>Basic (upd (fst (e, p))),Normal s\<rangle> =n\<Rightarrow> s'"and
     exec_p: "\<Gamma>\<turnstile> \<langle>Call (snd (e, p)),s'\<rangle> =n\<Rightarrow> t"
     by cases
   from exec_e [simplified]
   have s': "s'=Normal (upd e s)"
     by cases simp
   from ap obtain s'' where
    s'': "upd x s = s''" and upd_e': "upd e' s''=upd e s"
     by auto
   from ap s' execn.Basic [where f="(upd (fst (e', p)))" and s="upd x s" and \<Gamma>=\<Gamma>]
   have exec_e': "\<Gamma>\<turnstile> \<langle>Basic (upd (fst (e', p))),Normal (upd x s)\<rangle> =n\<Rightarrow> s'"
     by simp
   with exec_p
   have "\<Gamma>\<turnstile> \<langle>callClosure upd (e', p),Normal (upd x s)\<rangle> =n\<Rightarrow> t"
     by (auto simp add: callClosure_def intro: execn.Seq)
   from cnvalidD [OF valid [rule_format] ctxt this init_P'] t Q A
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
     by auto
 qed
 
 lemma app_closure:
   assumes adapt: "P \<subseteq> {s. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (callClosure upd (e',p)) Q',A' \<and>
                            upd x s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A}"
   assumes ap: "upd e = upd e' \<circ> upd x"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (callClosure upd (e,p)) Q,A"
   apply (rule hoare_complete')
   apply (rule allI)
   apply (rule app_closure_sound [where x=x and e'=e', OF _ ap])
   using adapt
   apply (blast intro: hoare_cnvalid)
   done
 
 lemma app_closure_spec:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. upd x s \<in> P' Z \<and> Q' Z \<subseteq> Q \<and> A' Z \<subseteq> A}"
   assumes ap: "upd e = upd e' \<circ> upd x"
   assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) (callClosure upd (e',p)) (Q' Z),(A' Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (callClosure upd (e,p)) Q,A"
   apply (rule app_closure [OF _ ap])
   apply clarsimp
   using adapt spec
   apply -
   apply (drule (1) in_subsetD)
   apply clarsimp
   apply (rule_tac x="P' Z" in exI)
   apply (rule_tac x="Q' Z" in exI)
   apply (rule_tac x="A' Z" in exI)
   apply blast
   done
 
 text \<open>Implementation of closures as association lists.\<close>
 
 definition "gen_upd var es s = foldl (\<lambda>s (x,i). the (var x) i s) s es"
 definition "ap es c \<equiv> (es@fst c,snd c)"
 
 lemma gen_upd_app: "\<And>es'. gen_upd var (es@es') = gen_upd var es' \<circ> gen_upd var es"
   apply (induct es)
   apply  (rule ext)
   apply  (simp add: gen_upd_def)
   apply (rule ext)
   apply (simp add: gen_upd_def)
   done
 
 lemma gen_upd_ap:
   "gen_upd var (fst (ap es (es',p))) = gen_upd var es' \<circ> gen_upd var es"
   by (simp add: gen_upd_app ap_def)
 
 lemma ap_closure:
   assumes adapt: "P \<subseteq> {s. \<exists>P' Q' A'. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P' (callClosure (gen_upd var) c) Q',A' \<and>
                            gen_upd var es s \<in> P' \<and> Q' \<subseteq> Q \<and> A' \<subseteq> A}"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (callClosure (gen_upd var) (ap es c)) Q,A"
 proof -
   obtain es' p where c: "c=(es',p)"
     by (cases c)
   have "gen_upd var (fst (ap es (es',p))) = gen_upd var es' \<circ> gen_upd var es"
     by (simp add: gen_upd_ap)
   from app_closure [OF adapt [simplified c] this]
   show ?thesis
     by (simp add: c ap_def)
 qed
 
 
 lemma ap_closure_spec:
   assumes adapt: "P \<subseteq> {s. \<exists>Z. gen_upd var es s \<in> P' Z \<and> Q' Z \<subseteq> Q \<and> A' Z \<subseteq> A}"
   assumes spec: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> (P' Z) (callClosure (gen_upd var) c) (Q' Z),(A' Z)"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P (callClosure (gen_upd var) (ap es c)) Q,A"
 proof -
   obtain es' p where c: "c=(es',p)"
     by (cases c)
   have "gen_upd var (fst (ap es (es',p))) = gen_upd var es' \<circ> gen_upd var es"
     by (simp add: gen_upd_ap)
   from app_closure_spec [OF adapt [simplified c] this spec [simplified c]]
   show ?thesis
     by (simp add: c ap_def)
 qed
 
 end
diff --git a/thys/Simpl/ex/ClosureEx.thy b/thys/Simpl/ex/ClosureEx.thy
--- a/thys/Simpl/ex/ClosureEx.thy
+++ b/thys/Simpl/ex/ClosureEx.thy
@@ -1,265 +1,249 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      ClosureEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 theory ClosureEx
 imports "../Vcg" "../Simpl_Heap" Closure
 begin
 
 
 record globals =
  cnt_' :: "ref \<Rightarrow> nat"
  alloc_' :: "ref list"
  free_' :: "nat"
 record 'g vars = "'g state" +
  p_':: ref
  r_':: nat
  n_':: nat
  m_':: nat
  c_':: "(string \<times> ref) list \<times> string"
  d_':: "(string \<times> ref) list \<times> string"
  e_':: "(string \<times> nat) list \<times> string"
 
 
 definition "var\<^sub>n = [''n''\<mapsto> (\<lambda>x. n_'_update (\<lambda>_. x)),
                     ''m''\<mapsto> (\<lambda>x. m_'_update (\<lambda>_. x))]"
 definition "upd\<^sub>n = gen_upd var\<^sub>n"
 
 lemma upd\<^sub>n_ap: "upd\<^sub>n (fst (ap es (es',p))) = upd\<^sub>n es' \<circ> upd\<^sub>n es"
   by (simp add: upd\<^sub>n_def gen_upd_ap)
 
 
 lemma
 "\<Gamma>\<turnstile>\<lbrace>\<acute>n=n\<^sub>0 \<and> (\<forall>i j. \<Gamma>\<turnstile> \<lbrace>\<acute>n=i \<and> \<acute>m=j\<rbrace> callClosure upd\<^sub>n \<acute>e \<lbrace>\<acute>r=i + j\<rbrace>)\<rbrace>
       \<acute>e :== (ap [(''n'',\<acute>n)] \<acute>e)
    \<lbrace>\<forall>j. \<Gamma>\<turnstile> \<lbrace>\<acute>m=j\<rbrace> callClosure upd\<^sub>n \<acute>e \<lbrace>\<acute>r=n\<^sub>0 + j\<rbrace>\<rbrace>"
 apply vcg_step
 apply clarify
 apply (rule ap_closure [where var=var\<^sub>n, folded upd\<^sub>n_def])
 apply clarsimp
 apply (rename_tac s s')
 apply (erule_tac x="n_' s" in allE)
 apply (erule_tac x="m_' s'" in allE)
 apply (rule exI)
 apply (rule exI)
 apply (rule conjI)
 apply (assumption)
 apply (simp add: upd\<^sub>n_def gen_upd_def var\<^sub>n_def)
 done
 
 
 definition "var = [''p''\<mapsto> (\<lambda>x. p_'_update (\<lambda>_. x))]"
 definition "upd = gen_upd var"
 
 procedures Inc(p|r) =
  "\<acute>p\<rightarrow>\<acute>cnt :== \<acute>p\<rightarrow>\<acute>cnt + 1;;
   \<acute>r :== \<acute>p\<rightarrow>\<acute>cnt"
 
 lemma (in Inc_impl)
  "\<forall>i p. \<Gamma>\<turnstile> \<lbrace>\<acute>p\<rightarrow>\<acute>cnt = i\<rbrace> \<acute>r :== PROC Inc(\<acute>p) \<lbrace>\<acute>r=i+1 \<and> \<acute>p\<rightarrow>\<acute>cnt = i+1\<rbrace>"
   apply vcg
   apply simp
   done
 
 procedures (imports Inc_signature) NewCounter(|c) =
 "\<acute>p :== NEW 1 [\<acute>cnt :== 0];;
  \<acute>c :== ([(''p'',\<acute>p)],Inc_'proc)"
 
 
 locale NewCounter_impl' = NewCounter_impl + Inc_impl
 lemma (in NewCounter_impl')
 shows
   "\<forall>alloc. \<Gamma>\<turnstile> \<lbrace>1 \<le> \<acute>free\<rbrace> \<acute>c :== PROC NewCounter()
           \<lbrace>\<exists>p. p\<rightarrow>\<acute>cnt = 0 \<and>
                (\<forall>i. \<Gamma>\<turnstile> \<lbrace>p\<rightarrow>\<acute>cnt = i\<rbrace> callClosure upd \<acute>c \<lbrace>\<acute>r=i+1 \<and> p\<rightarrow>\<acute>cnt = i+1\<rbrace>)\<rbrace>"
 apply vcg
 apply simp
 apply (rule_tac x="new (set alloc)" in exI)
 apply simp
 apply (simp add: callClosure_def)
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply (simp add: upd_def var_def gen_upd_def)
 done
 
 lemma (in NewCounter_impl')
 
 shows
   "\<forall>alloc. \<Gamma>\<turnstile> \<lbrace>1 \<le> \<acute>free\<rbrace> \<acute>c :== PROC NewCounter()
           \<lbrace>\<exists>p. p\<rightarrow>\<acute>cnt = 0 \<and>
                (\<forall>i. \<Gamma>\<turnstile> \<lbrace>p\<rightarrow>\<acute>cnt = i\<rbrace> callClosure upd \<acute>c \<lbrace>\<acute>r=i+1 \<and> p\<rightarrow>\<acute>cnt = i+1\<rbrace>)\<rbrace>"
 apply vcg
 apply simp
 apply (rule_tac x="new (set alloc)" in exI)
 apply simp
 apply (simp add: callClosure_def)
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply (simp add: upd_def var_def gen_upd_def)
 done
 
 lemma (in NewCounter_impl')
 shows NewCounter_spec:
   "\<forall>alloc. \<Gamma>\<turnstile> \<lbrace>1 \<le> \<acute>free \<and> \<acute>alloc=alloc\<rbrace> \<acute>c :== PROC NewCounter()
           \<lbrace>\<exists>p. p \<notin> set alloc \<and> p \<in> set \<acute>alloc \<and> p \<noteq> Null \<and> p\<rightarrow>\<acute>cnt = 0 \<and>
                (\<forall>i. \<Gamma>\<turnstile> \<lbrace>p\<rightarrow>\<acute>cnt = i\<rbrace> callClosure upd \<acute>c \<lbrace>\<acute>r=i+1 \<and> p\<rightarrow>\<acute>cnt = i+1\<rbrace>)\<rbrace>"
 apply vcg
 apply clarsimp
 apply (rule_tac x="new (set alloc)" in exI)
 apply simp
 apply (simp add: callClosure_def)
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply (simp add: upd_def var_def gen_upd_def)
 done
 
 
 
 lemma "\<Gamma>\<turnstile>\<lbrace>\<exists>p. p \<noteq> Null \<and> p\<rightarrow>\<acute>cnt = i \<and>
               (\<forall>i. \<Gamma>\<turnstile> \<lbrace>p\<rightarrow>\<acute>cnt = i\<rbrace> callClosure upd \<acute>c \<lbrace>\<acute>r=i+1 \<and> p\<rightarrow>\<acute>cnt = i+1\<rbrace>)\<rbrace>
            dynCallClosure (\<lambda>s. s) upd c_' (\<lambda>s t. s\<lparr>globals := globals t\<rparr>)
                          (\<lambda>s t. Basic (\<lambda>u. u\<lparr>r_' := r_' t\<rparr>))
            \<lbrace>\<acute>r=i+1\<rbrace>"
 apply (rule conseq_extract_pre)
 apply clarify
 apply (rule dynCallClosureFix)
 apply (simp only: Ball_def)
 prefer 3
 apply (assumption)
 prefer 2
 apply vcg_step
 apply vcg_step
 apply (simp only: simp_thms)
 apply clarsimp
 done
 
+declare [[hoare_trace = 1]]
+
+ML \<open>
+val hoare_tacs = #hoare_tacs (Hoare.get_data @{context});
+\<close>
 lemma (in NewCounter_impl')
  shows "\<Gamma>\<turnstile> \<lbrace>1 \<le> \<acute>free\<rbrace>
              \<acute>c :== CALL NewCounter ();;
              dynCallClosure (\<lambda>s. s) upd c_' (\<lambda>s t. s\<lparr>globals := globals t\<rparr>)
                          (\<lambda>s t. Basic (\<lambda>u. u\<lparr>r_' := r_' t\<rparr>))
            \<lbrace>\<acute>r=1\<rbrace>"
-apply vcg_step
+  apply vcg_step
 apply (rule dynCallClosure)
 prefer 2
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply clarsimp
 apply (erule_tac x=0 in allE)
 apply (rule exI)
 apply (rule exI)
 apply (rule conjI)
 apply (assumption)
 apply simp
 done
 
 
 lemma (in NewCounter_impl')
  shows "\<Gamma>\<turnstile> \<lbrace>1 \<le> \<acute>free\<rbrace>
              \<acute>c :== CALL NewCounter ();;
              dynCallClosure (\<lambda>s. s) upd c_' (\<lambda>s t. s\<lparr>globals := globals t\<rparr>)
                          (\<lambda>s t. Basic (\<lambda>u. u\<lparr>r_' := r_' t\<rparr>));;
              dynCallClosure (\<lambda>s. s) upd c_' (\<lambda>s t. s\<lparr>globals := globals t\<rparr>)
                          (\<lambda>s t. Basic (\<lambda>u. u\<lparr>r_' := r_' t\<rparr>))
            \<lbrace>\<acute>r=2\<rbrace>"
 apply vcg_step
 apply (rule dynCallClosure)
 prefer 2
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply (rule dynCallClosure)
 apply vcg_step
 apply vcg_step
 apply vcg_step
 
 apply clarsimp
 apply (subgoal_tac "\<Gamma>\<turnstile> \<lbrace>p\<rightarrow>\<acute>cnt = 0\<rbrace> callClosure upd (c_' t) \<lbrace>\<acute>r = Suc 0 \<and> p\<rightarrow>\<acute>cnt = Suc 0\<rbrace>")
 apply (rule exI)
 apply (rule exI)
 apply (rule conjI)
 apply assumption
 apply clarsimp
 apply (erule_tac x=1 in allE)
 apply (rule exI)
 apply (rule exI)
 apply (rule conjI)
 apply assumption
 apply clarsimp
 apply (erule allE)
 apply assumption
 done
 
 
 lemma (in NewCounter_impl')
  shows "\<Gamma>\<turnstile> \<lbrace>1 \<le> \<acute>free\<rbrace>
              \<acute>c :== CALL NewCounter ();;
              \<acute>d :== \<acute>c;;
              dynCallClosure (\<lambda>s. s) upd c_' (\<lambda>s t. s\<lparr>globals := globals t\<rparr>)
                          (\<lambda>s t. Basic (\<lambda>u. u\<lparr>n_' := r_' t\<rparr>));;
              dynCallClosure (\<lambda>s. s) upd d_' (\<lambda>s t. s\<lparr>globals := globals t\<rparr>)
                          (\<lambda>s t. Basic (\<lambda>u. u\<lparr>m_' := r_' t\<rparr>));;
              \<acute>r :== \<acute>n + \<acute>m
            \<lbrace>\<acute>r=3\<rbrace>"
 
 apply vcg_step
 apply vcg_step
 apply (rule dynCallClosure)
 prefer 2
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply (rule dynCallClosure)
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply vcg_step
 apply clarsimp
 apply (subgoal_tac "\<Gamma>\<turnstile> \<lbrace>p\<rightarrow>\<acute>cnt = 0\<rbrace> callClosure upd (c_' t) \<lbrace>\<acute>r = Suc 0 \<and> p\<rightarrow>\<acute>cnt = Suc 0\<rbrace>")
 apply (rule exI)
 apply (rule exI)
 apply (rule conjI)
 apply assumption
 apply clarsimp
 apply (erule_tac x=1 in allE)
 apply (rule exI)
 apply (rule exI)
 apply (rule conjI)
 apply assumption
 apply clarsimp
 apply (erule allE)
 apply assumption
 done
 
 end
diff --git a/thys/Simpl/ex/Compose.thy b/thys/Simpl/ex/Compose.thy
--- a/thys/Simpl/ex/Compose.thy
+++ b/thys/Simpl/ex/Compose.thy
@@ -1,1306 +1,1287 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Compose.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section "Experiments on State Composition"
 
 
 theory Compose imports "../HoareTotalProps" begin
 
 text \<open>
 We develop some theory to support state-space modular development of programs.
 These experiments aim at the representation of state-spaces with records.
 If we use \<open>statespaces\<close> instead we get this kind of compositionality for free.
 \<close>
 
 
 subsection \<open>Changing the State-Space\<close>
 
 (* Lift a command on statespace 'b to work on statespace 'a *)
 
 definition lift\<^sub>f:: "('S \<Rightarrow> 's) \<Rightarrow> ('S \<Rightarrow> 's \<Rightarrow> 'S) \<Rightarrow> ('s \<Rightarrow> 's) \<Rightarrow> ('S \<Rightarrow> 'S)"
   where "lift\<^sub>f prj inject f = (\<lambda>S. inject S (f (prj S)))"
 
 definition lift\<^sub>s:: "('S \<Rightarrow> 's) \<Rightarrow> 's set \<Rightarrow> 'S set"
   where "lift\<^sub>s prj A = {S. prj S \<in> A}"
 
 definition lift\<^sub>r:: "('S \<Rightarrow> 's) \<Rightarrow> ('S \<Rightarrow> 's \<Rightarrow> 'S) \<Rightarrow> ('s \<times> 's) set
                        \<Rightarrow> ('S \<times> 'S) set"
 where
 "lift\<^sub>r prj inject R = {(S,T). (prj S,prj T) \<in> R \<and> T=inject S (prj T)}"
 
 
 primrec lift\<^sub>c:: "('S \<Rightarrow> 's) \<Rightarrow> ('S \<Rightarrow> 's \<Rightarrow> 'S) \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('S,'p,'f) com"
 where
 "lift\<^sub>c prj inject Skip = Skip" |
 "lift\<^sub>c prj inject (Basic f) = Basic (lift\<^sub>f prj inject f)" |
 "lift\<^sub>c prj inject (Spec r) = Spec (lift\<^sub>r prj inject r)" |
 "lift\<^sub>c prj inject (Seq c\<^sub>1 c\<^sub>2)  =
   (Seq (lift\<^sub>c prj inject c\<^sub>1) (lift\<^sub>c prj inject c\<^sub>2))" |
 "lift\<^sub>c prj inject (Cond b c\<^sub>1 c\<^sub>2) =
   Cond (lift\<^sub>s prj b) (lift\<^sub>c prj inject c\<^sub>1) (lift\<^sub>c prj inject c\<^sub>2)" |
 "lift\<^sub>c prj inject (While b c) =
   While (lift\<^sub>s prj b) (lift\<^sub>c prj inject c)" |
 "lift\<^sub>c prj inject (Call p) = Call p" |
 "lift\<^sub>c prj inject (DynCom c) = DynCom (\<lambda>s. lift\<^sub>c prj inject (c (prj s)))" |
 "lift\<^sub>c prj inject (Guard f g c) = Guard f (lift\<^sub>s prj g) (lift\<^sub>c prj inject c)" |
 "lift\<^sub>c prj inject Throw = Throw" |
 "lift\<^sub>c prj inject (Catch c\<^sub>1 c\<^sub>2) =
   Catch (lift\<^sub>c prj inject c\<^sub>1) (lift\<^sub>c prj inject c\<^sub>2)"
 
 
 
 lemma lift\<^sub>c_Skip: "(lift\<^sub>c prj inject c = Skip) = (c = Skip)"
   by (cases c) auto
 
 lemma lift\<^sub>c_Basic:
   "(lift\<^sub>c prj inject c = Basic lf) = (\<exists>f. c = Basic f \<and> lf = lift\<^sub>f prj inject f)"
   by (cases c) auto
 
 lemma lift\<^sub>c_Spec:
   "(lift\<^sub>c prj inject c = Spec lr) = (\<exists>r. c = Spec r \<and> lr = lift\<^sub>r prj inject r)"
   by (cases c) auto
 
 lemma lift\<^sub>c_Seq:
   "(lift\<^sub>c prj inject c = Seq lc\<^sub>1 lc\<^sub>2) =
      (\<exists> c\<^sub>1 c\<^sub>2. c = Seq c\<^sub>1 c\<^sub>2 \<and>
                lc\<^sub>1 = lift\<^sub>c prj inject c\<^sub>1 \<and> lc\<^sub>2 = lift\<^sub>c prj inject c\<^sub>2 )"
     by (cases c) auto
 
 lemma lift\<^sub>c_Cond:
   "(lift\<^sub>c prj inject c = Cond lb lc\<^sub>1 lc\<^sub>2) =
      (\<exists>b c\<^sub>1 c\<^sub>2. c = Cond b c\<^sub>1 c\<^sub>2 \<and> lb = lift\<^sub>s prj b \<and>
                 lc\<^sub>1 = lift\<^sub>c prj inject c\<^sub>1 \<and> lc\<^sub>2 = lift\<^sub>c prj inject c\<^sub>2 )"
   by (cases c) auto
 
 lemma lift\<^sub>c_While:
   "(lift\<^sub>c prj inject c = While lb lc') =
      (\<exists>b c'. c = While b c' \<and> lb = lift\<^sub>s prj b \<and>
                lc' = lift\<^sub>c prj inject c')"
   by (cases c) auto
 
 lemma lift\<^sub>c_Call:
   "(lift\<^sub>c prj inject c = Call p) = (c = Call p)"
   by (cases c) auto
 
 lemma lift\<^sub>c_DynCom:
   "(lift\<^sub>c prj inject c = DynCom lc) =
      (\<exists>C. c=DynCom C \<and> lc = (\<lambda>s. lift\<^sub>c prj inject (C (prj s))))"
   by (cases c) auto
 
 lemma lift\<^sub>c_Guard:
   "(lift\<^sub>c prj inject c = Guard f lg lc') =
      (\<exists>g c'. c = Guard f g c' \<and> lg = lift\<^sub>s prj g \<and>
              lc' = lift\<^sub>c prj inject c')"
    by (cases c) auto
 
 lemma lift\<^sub>c_Throw:
   "(lift\<^sub>c prj inject c = Throw) = (c = Throw)"
   by (cases c) auto
 
 lemma lift\<^sub>c_Catch:
   "(lift\<^sub>c prj inject c = Catch lc\<^sub>1 lc\<^sub>2) =
      (\<exists> c\<^sub>1 c\<^sub>2. c = Catch c\<^sub>1 c\<^sub>2 \<and>
                lc\<^sub>1 = lift\<^sub>c prj inject c\<^sub>1 \<and> lc\<^sub>2 = lift\<^sub>c prj inject c\<^sub>2 )"
     by (cases c) auto
 
 
 
 definition xstate_map:: "('S \<Rightarrow> 's) \<Rightarrow> ('S,'f) xstate \<Rightarrow> ('s,'f) xstate"
 where
 "xstate_map g x = (case x of
                       Normal s \<Rightarrow> Normal (g s)
                     | Abrupt s \<Rightarrow> Abrupt (g s)
                     | Fault f \<Rightarrow> Fault f
                     | Stuck \<Rightarrow> Stuck)"
 
 lemma xstate_map_simps [simp]:
 "xstate_map g (Normal s) = Normal (g s)"
 "xstate_map g (Abrupt s) = Abrupt (g s)"
 "xstate_map g (Fault f) = (Fault f)"
 "xstate_map g Stuck = Stuck"
   by (auto simp add: xstate_map_def)
 
 lemma xstate_map_Normal_conv:
   "xstate_map g S = Normal s = (\<exists>s'. S=Normal s' \<and> s = g s')"
   by (cases S) auto
 
 lemma xstate_map_Abrupt_conv:
   "xstate_map g S = Abrupt s = (\<exists>s'. S=Abrupt s' \<and> s = g s')"
   by (cases S) auto
 
 lemma xstate_map_Fault_conv:
   "xstate_map g S = Fault f = (S=Fault f)"
   by (cases S) auto
 
 lemma xstate_map_Stuck_conv:
   "xstate_map g S = Stuck = (S=Stuck)"
   by (cases S) auto
 
 lemmas xstate_map_convs = xstate_map_Normal_conv xstate_map_Abrupt_conv
  xstate_map_Fault_conv xstate_map_Stuck_conv
 
 definition state:: "('s,'f) xstate \<Rightarrow> 's"
 where
 "state x = (case x of
                Normal s \<Rightarrow> s
              | Abrupt s \<Rightarrow> s
              | Fault g \<Rightarrow> undefined
              | Stuck \<Rightarrow> undefined)"
 
 lemma state_simps [simp]:
 "state (Normal s) = s"
 "state (Abrupt s) = s"
   by (auto simp add: state_def )
 
 
 locale lift_state_space =
   fixes project::"'S \<Rightarrow> 's"
   fixes "inject"::"'S \<Rightarrow> 's \<Rightarrow> 'S"
   fixes "project\<^sub>x"::"('S,'f) xstate \<Rightarrow> ('s,'f) xstate"
   fixes "lift\<^sub>e"::"('s,'p,'f) body \<Rightarrow> ('S,'p,'f) body"
   fixes lift\<^sub>c:: "('s,'p,'f) com \<Rightarrow> ('S,'p,'f) com"
   fixes lift\<^sub>f:: "('s \<Rightarrow> 's) \<Rightarrow> ('S \<Rightarrow> 'S)"
   fixes lift\<^sub>s:: "'s set \<Rightarrow> 'S set"
   fixes lift\<^sub>r:: "('s \<times> 's) set \<Rightarrow> ('S \<times> 'S) set"
   assumes proj_inj_commute: "\<And>S s.  project (inject S s) = s"
   defines "lift\<^sub>c \<equiv> Compose.lift\<^sub>c project inject"
   defines "project\<^sub>x \<equiv> xstate_map project"
   defines "lift\<^sub>e \<equiv> (\<lambda>\<Gamma> p. map_option lift\<^sub>c (\<Gamma> p))"
   defines "lift\<^sub>f \<equiv> Compose.lift\<^sub>f project inject"
   defines "lift\<^sub>s \<equiv> Compose.lift\<^sub>s project"
   defines "lift\<^sub>r \<equiv> Compose.lift\<^sub>r project inject"
 
 
 lemma (in lift_state_space) lift\<^sub>f_simp:
  "lift\<^sub>f f \<equiv> \<lambda>S. inject S (f (project S))"
   by (simp add: lift\<^sub>f_def Compose.lift\<^sub>f_def)
 
 lemma (in lift_state_space) lift\<^sub>s_simp:
   "lift\<^sub>s A \<equiv> {S. project S \<in> A}"
   by  (simp add: lift\<^sub>s_def Compose.lift\<^sub>s_def)
 
 lemma (in lift_state_space) lift\<^sub>r_simp:
 "lift\<^sub>r R \<equiv> {(S,T). (project S,project T) \<in> R \<and> T=inject S (project T)}"
   by  (simp add: lift\<^sub>r_def Compose.lift\<^sub>r_def)
 
 (* Causes loop when instantiating locale
 lemmas (in lift_state_space) lift\<^sub>f_simp  = Compose.lift\<^sub>f_def
  [of project "inject", folded lift\<^sub>f_def]
 lemmas (in lift_state_space) lift\<^sub>s_simp  = Compose.lift\<^sub>s_def
  [of project, folded lift\<^sub>s_def]
 lemmas (in lift_state_space) lift\<^sub>r_simp  = Compose.lift\<^sub>r_def
  [of project "inject", folded lift\<^sub>r_def]
 *)
 lemma (in lift_state_space) lift\<^sub>c_Skip_simp [simp]:
  "lift\<^sub>c Skip = Skip"
   by (simp add: lift\<^sub>c_def)
 lemma (in lift_state_space) lift\<^sub>c_Basic_simp [simp]:
 "lift\<^sub>c (Basic f) = Basic (lift\<^sub>f f)"
   by (simp add: lift\<^sub>c_def lift\<^sub>f_def)
 lemma (in lift_state_space) lift\<^sub>c_Spec_simp [simp]:
 "lift\<^sub>c (Spec r) = Spec (lift\<^sub>r r)"
   by (simp add: lift\<^sub>c_def lift\<^sub>r_def)
 lemma (in lift_state_space) lift\<^sub>c_Seq_simp [simp]:
 "lift\<^sub>c (Seq c\<^sub>1 c\<^sub>2)  =
   (Seq (lift\<^sub>c c\<^sub>1) (lift\<^sub>c c\<^sub>2))"
   by (simp add: lift\<^sub>c_def)
 lemma (in lift_state_space) lift\<^sub>c_Cond_simp [simp]:
 "lift\<^sub>c (Cond b c\<^sub>1 c\<^sub>2) =
   Cond (lift\<^sub>s b) (lift\<^sub>c c\<^sub>1) (lift\<^sub>c c\<^sub>2)"
   by (simp add: lift\<^sub>c_def lift\<^sub>s_def)
 lemma (in lift_state_space) lift\<^sub>c_While_simp [simp]:
 "lift\<^sub>c (While b c) =
   While (lift\<^sub>s b) (lift\<^sub>c c)"
   by (simp add: lift\<^sub>c_def lift\<^sub>s_def)
 lemma (in lift_state_space) lift\<^sub>c_Call_simp [simp]:
 "lift\<^sub>c (Call p) = Call p"
   by (simp add: lift\<^sub>c_def)
 lemma (in lift_state_space) lift\<^sub>c_DynCom_simp [simp]:
 "lift\<^sub>c (DynCom c) = DynCom (\<lambda>s. lift\<^sub>c (c (project s)))"
   by (simp add: lift\<^sub>c_def)
 lemma (in lift_state_space) lift\<^sub>c_Guard_simp [simp]:
 "lift\<^sub>c (Guard f g c) = Guard f (lift\<^sub>s g) (lift\<^sub>c c)"
   by (simp add: lift\<^sub>c_def lift\<^sub>s_def)
 lemma (in lift_state_space) lift\<^sub>c_Throw_simp [simp]:
 "lift\<^sub>c Throw = Throw"
   by (simp add: lift\<^sub>c_def)
 lemma (in lift_state_space) lift\<^sub>c_Catch_simp [simp]:
 "lift\<^sub>c (Catch c\<^sub>1 c\<^sub>2) =
   Catch (lift\<^sub>c c\<^sub>1) (lift\<^sub>c c\<^sub>2)"
   by (simp add: lift\<^sub>c_def)
 
 lemma (in lift_state_space) project\<^sub>x_def':
 "project\<^sub>x s \<equiv> (case s of
                  Normal s \<Rightarrow> Normal (project s)
                 | Abrupt s \<Rightarrow> Abrupt (project s)
                 | Fault f \<Rightarrow> Fault f
                 | Stuck \<Rightarrow> Stuck)"
   by (simp add: xstate_map_def project\<^sub>x_def)
 
 lemma (in lift_state_space) lift\<^sub>e_def':
   "lift\<^sub>e \<Gamma> p \<equiv> (case \<Gamma> p of Some bdy \<Rightarrow> Some (lift\<^sub>c bdy) | None \<Rightarrow> None)"
   by (simp add: lift\<^sub>e_def map_option_case)
 
 
 
 
 text \<open>
 The problem is that @{term "(lift\<^sub>c project inject \<circ> \<Gamma>)"} is quite
 a strong premise. The problem is that @{term "\<Gamma>"} is a function here.
 A map would be better. We only have to lift those procedures in the domain
 of @{term "\<Gamma>"}:
 \<open>\<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' p = Some lift\<^sub>c project inject bdy\<close>.
 We then can com up with theorems that allow us to extend the domains
 of @{term \<Gamma>} and preserve validity.
 \<close>
 
 
 lemma (in lift_state_space)
 "{(S,T). \<exists>t. (project S,t) \<in> r \<and> T=inject S t}
  \<subseteq> {(S,T). (project S,project T) \<in> r \<and> T=inject S (project T)}"
   apply clarsimp
   apply (rename_tac S t)
   apply (simp add: proj_inj_commute)
   done
 
 lemma (in lift_state_space)
 "{(S,T). (project S,project T) \<in> r \<and> T=inject S (project T)}
  \<subseteq> {(S,T). \<exists>t. (project S,t) \<in> r \<and> T=inject S t}"
   apply clarsimp
   apply (rename_tac S T)
   apply (rule_tac x="project T" in exI)
   apply simp
   done
 
 
 lemma (in lift_state_space) lift_exec:
 assumes exec_lc: "(lift\<^sub>e \<Gamma>)\<turnstile>\<langle>lc,s\<rangle> \<Rightarrow> t"
 shows "\<And>c. \<lbrakk> lift\<^sub>c c = lc\<rbrakk> \<Longrightarrow>
               \<Gamma>\<turnstile>\<langle>c,project\<^sub>x s\<rangle> \<Rightarrow>  project\<^sub>x t"
 using exec_lc
 proof (induct)
   case Skip thus ?case
     by (auto simp add: project\<^sub>x_def lift\<^sub>c_Skip lift\<^sub>c_def intro: exec.Skip)
 next
   case Guard thus ?case
     by (auto simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def lift\<^sub>c_Guard lift\<^sub>c_def
       intro: exec.Guard)
 next
   case GuardFault thus ?case
     by (auto simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def lift\<^sub>c_Guard lift\<^sub>c_def
       intro: exec.GuardFault)
 next
   case FaultProp thus ?case
     by (fastforce simp add: project\<^sub>x_def)
 next
   case Basic
   thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>c_Basic lift\<^sub>f_def Compose.lift\<^sub>f_def
       lift\<^sub>c_def
         proj_inj_commute
         intro: exec.Basic)
 next
   case Spec
   thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>c_Spec lift\<^sub>f_def Compose.lift\<^sub>f_def
         lift\<^sub>r_def Compose.lift\<^sub>r_def lift\<^sub>c_def
         proj_inj_commute
         intro: exec.Spec)
 next
   case (SpecStuck s r)
   thus ?case
     apply (simp add: project\<^sub>x_def)
     apply (clarsimp simp add: lift\<^sub>c_Spec lift\<^sub>c_def)
     apply (unfold lift\<^sub>r_def Compose.lift\<^sub>r_def)
     apply (rule exec.SpecStuck)
     apply (rule allI)
     apply (erule_tac x="inject s t" in allE)
     apply clarsimp
     apply (simp add: proj_inj_commute)
     done
 next
   case Seq
   thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>c_Seq lift\<^sub>c_def intro: exec.intros)
 next
   case CondTrue
   thus ?case
      by (auto simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def lift\<^sub>c_Cond lift\<^sub>c_def
          intro: exec.CondTrue)
 next
   case CondFalse
   thus ?case
      by (auto simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def lift\<^sub>c_Cond lift\<^sub>c_def
          intro: exec.CondFalse)
 next
   case WhileTrue
   thus ?case
      by (fastforce simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def
          lift\<^sub>c_While lift\<^sub>c_def
          intro: exec.WhileTrue)
 next
   case WhileFalse
   thus ?case
      by (fastforce simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def
          lift\<^sub>c_While lift\<^sub>c_def
          intro: exec.WhileFalse)
 next
   case Call
   thus ?case
     by (fastforce simp add:
                project\<^sub>x_def lift\<^sub>c_Call lift\<^sub>f_def Compose.lift\<^sub>f_def lift\<^sub>c_def
                lift\<^sub>e_def
           intro: exec.Call)
 next
   case CallUndefined
   thus ?case
     by (fastforce simp add:
                project\<^sub>x_def lift\<^sub>c_Call lift\<^sub>f_def Compose.lift\<^sub>f_def lift\<^sub>c_def
                lift\<^sub>e_def
           intro: exec.CallUndefined)
 next
   case StuckProp thus ?case
     by (fastforce simp add: project\<^sub>x_def)
 next
   case DynCom
   thus ?case
     by (fastforce simp add:
                project\<^sub>x_def lift\<^sub>c_DynCom lift\<^sub>f_def Compose.lift\<^sub>f_def lift\<^sub>c_def
           intro: exec.DynCom)
 next
   case Throw thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>c_Throw lift\<^sub>c_def intro: exec.Throw)
 next
   case AbruptProp thus ?case
     by (fastforce simp add: project\<^sub>x_def)
 next
   case CatchMatch
   thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>c_Catch lift\<^sub>c_def intro: exec.CatchMatch)
 next
   case (CatchMiss c\<^sub>1 s t c\<^sub>2 c)
   thus ?case
     by (cases t)
        (fastforce simp add: project\<^sub>x_def lift\<^sub>c_Catch lift\<^sub>c_def intro: exec.CatchMiss)+
 qed
 
 lemma (in lift_state_space) lift_exec':
 assumes exec_lc: "(lift\<^sub>e \<Gamma>)\<turnstile>\<langle>lift\<^sub>c c,s\<rangle> \<Rightarrow> t"
 shows "\<Gamma>\<turnstile>\<langle>c,project\<^sub>x s\<rangle> \<Rightarrow> project\<^sub>x t"
   using lift_exec [OF exec_lc]
   by simp
 
 
 
 lemma (in lift_state_space) lift_valid:
   assumes valid: "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows
    "(lift\<^sub>e \<Gamma>)\<Turnstile>\<^bsub>/F\<^esub> (lift\<^sub>s P) (lift\<^sub>c c) (lift\<^sub>s Q),(lift\<^sub>s A)"
 proof (rule validI)
   fix s t
   assume lexec:
     "(lift\<^sub>e \<Gamma>)\<turnstile>\<langle>lift\<^sub>c c,Normal s\<rangle> \<Rightarrow> t"
   assume lP: "s \<in> lift\<^sub>s P"
   assume noFault: "t \<notin> Fault ` F"
   show "t \<in> Normal ` lift\<^sub>s Q \<union> Abrupt ` lift\<^sub>s A"
   proof -
     from lexec
     have "\<Gamma>\<turnstile> \<langle>c,project\<^sub>x (Normal s)\<rangle> \<Rightarrow> (project\<^sub>x t)"
       by (rule lift_exec) (simp_all)
     moreover
     from lP have "project s \<in> P"
       by (simp add: lift\<^sub>s_def Compose.lift\<^sub>s_def project\<^sub>x_def)
     ultimately
     have "project\<^sub>x t \<in> Normal ` Q \<union> Abrupt ` A"
       using valid noFault
       apply (clarsimp simp add: valid_def project\<^sub>x_def)
       apply (cases t)
       apply auto
       done
     thus ?thesis
       apply (simp add: lift\<^sub>s_def Compose.lift\<^sub>s_def)
       apply (cases t)
       apply (auto simp add: project\<^sub>x_def)
       done
   qed
 qed
 
 lemma (in lift_state_space) lift_hoarep:
   assumes deriv: "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows
    "(lift\<^sub>e \<Gamma>),{}\<turnstile>\<^bsub>/F\<^esub> (lift\<^sub>s P) (lift\<^sub>c c) (lift\<^sub>s Q),(lift\<^sub>s A)"
 apply (rule hoare_complete)
 apply (insert hoare_sound [OF deriv])
 apply (rule lift_valid)
 apply (simp add: cvalid_def)
 done
 
 lemma (in lift_state_space) lift_hoarep':
   "\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) c (Q Z),(A Z) \<Longrightarrow>
     \<forall>Z. (lift\<^sub>e \<Gamma>),{}\<turnstile>\<^bsub>/F\<^esub> (lift\<^sub>s (P Z)) (lift\<^sub>c c)
                                   (lift\<^sub>s (Q Z)),(lift\<^sub>s (A Z))"
 apply (iprover intro: lift_hoarep)
 done
 
 
 
 lemma (in lift_state_space) lift_termination:
 assumes termi: "\<Gamma>\<turnstile>c\<down>s"
 shows "\<And>S. project\<^sub>x S = s \<Longrightarrow>
   lift\<^sub>e \<Gamma> \<turnstile>(lift\<^sub>c c)\<down>S"
   using termi
 proof (induct)
   case Skip thus ?case
     by (clarsimp simp add: terminates.Skip project\<^sub>x_def xstate_map_convs)
 next
   case Basic thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs intro: terminates.intros)
 next
   case Spec thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs intro: terminates.intros)
 next
   case Guard thus ?case
     by (auto simp add: project\<^sub>x_def xstate_map_convs intro: terminates.intros)
 next
   case GuardFault thus ?case
     by (auto simp add: project\<^sub>x_def xstate_map_convs lift\<^sub>s_def Compose.lift\<^sub>s_def
            intro: terminates.intros)
 next
   case Fault thus ?case by (clarsimp simp add: project\<^sub>x_def xstate_map_convs)
 next
   case (Seq c1 s c2)
   have "project\<^sub>x S = Normal s" by fact
   then obtain s' where S: "S=Normal s'" and s: "s = project s'"
     by (auto simp add: project\<^sub>x_def xstate_map_convs)
   from Seq have "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c1 \<down> S"
     by simp
   moreover
   {
     fix w
     assume exec_lc1: "lift\<^sub>e \<Gamma>\<turnstile>\<langle>lift\<^sub>c c1,Normal s'\<rangle> \<Rightarrow> w"
     have "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c2 \<down> w"
     proof (cases w)
       case (Normal w')
       with lift_exec [where c=c1, OF exec_lc1] s
       have "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> Normal (project w')"
         by (simp add: project\<^sub>x_def)
       from Seq.hyps (3) [rule_format, OF this] Normal
       show "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c2 \<down> w"
         by (auto simp add: project\<^sub>x_def xstate_map_convs)
     qed (auto)
   }
   ultimately show ?case
     using S s
     by (auto intro: terminates.intros)
 next
   case CondTrue thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def xstate_map_convs
       intro: terminates.intros)
 next
   case CondFalse thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def xstate_map_convs
       intro: terminates.intros)
 next
   case (WhileTrue s b c)
   have "project\<^sub>x S = Normal s" by fact
   then obtain s' where S: "S=Normal s'" and s: "s = project s'"
     by (auto simp add: project\<^sub>x_def xstate_map_convs)
   from WhileTrue have "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c \<down> S"
     by simp
   moreover
   {
     fix w
     assume exec_lc: "lift\<^sub>e \<Gamma>\<turnstile>\<langle>lift\<^sub>c c,Normal s'\<rangle> \<Rightarrow> w"
     have "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c (While b c) \<down> w"
     proof (cases w)
       case (Normal w')
       with lift_exec [where c=c, OF exec_lc] s
       have "\<Gamma>\<turnstile>\<langle>c,Normal s\<rangle> \<Rightarrow> Normal (project w')"
         by (simp add: project\<^sub>x_def)
       from WhileTrue.hyps (4) [rule_format, OF this] Normal
       show "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c (While b c) \<down> w"
         by (auto simp add: project\<^sub>x_def xstate_map_convs)
     qed (auto)
   }
   ultimately show ?case
     using S s
     by (auto intro: terminates.intros)
 next
   case WhileFalse thus ?case
     by (fastforce simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def xstate_map_convs
       intro: terminates.intros)
 next
   case Call thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs lift\<^sub>e_def
       intro: terminates.intros)
 next
   case CallUndefined thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs lift\<^sub>e_def
       intro: terminates.intros)
 next
   case Stuck thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs)
 next
   case DynCom thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs
       intro: terminates.intros)
 next
   case Throw thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs
       intro: terminates.intros)
 next
   case Abrupt thus ?case
     by (fastforce simp add: project\<^sub>x_def xstate_map_convs
       intro: terminates.intros)
 next
   case (Catch c1 s c2)
   have "project\<^sub>x S = Normal s" by fact
   then obtain s' where S: "S=Normal s'" and s: "s = project s'"
     by (auto simp add: project\<^sub>x_def xstate_map_convs)
   from Catch have "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c1 \<down> S"
     by simp
   moreover
   {
     fix w
     assume exec_lc1: "lift\<^sub>e \<Gamma>\<turnstile>\<langle>lift\<^sub>c c1,Normal s'\<rangle> \<Rightarrow> Abrupt w"
     have "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c2 \<down> Normal w"
     proof -
       from lift_exec [where c=c1, OF exec_lc1] s
       have "\<Gamma>\<turnstile>\<langle>c1,Normal s\<rangle> \<Rightarrow> Abrupt (project w)"
         by (simp add: project\<^sub>x_def)
       from Catch.hyps (3) [rule_format, OF this]
       show "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c2 \<down> Normal w"
         by (auto simp add: project\<^sub>x_def xstate_map_convs)
     qed
   }
   ultimately show ?case
     using S s
     by (auto intro: terminates.intros)
 qed
 
 lemma (in lift_state_space) lift_termination':
 assumes termi: "\<Gamma>\<turnstile>c\<down>project\<^sub>x S"
 shows "lift\<^sub>e \<Gamma> \<turnstile>(lift\<^sub>c c)\<down>S"
   using lift_termination [OF termi]
   by iprover
 
 
 lemma (in lift_state_space) lift_validt:
   assumes valid: "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "(lift\<^sub>e \<Gamma>)\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> (lift\<^sub>s P) (lift\<^sub>c c) (lift\<^sub>s Q),(lift\<^sub>s A)"
 proof -
   from valid
   have "(lift\<^sub>e \<Gamma>)\<Turnstile>\<^bsub>/F\<^esub> (lift\<^sub>s P) (lift\<^sub>c c) (lift\<^sub>s Q),(lift\<^sub>s A)"
     by (auto intro: lift_valid simp add: validt_def)
   moreover
   {
     fix S
     assume "S \<in> lift\<^sub>s P"
     hence "project S \<in> P"
       by (simp add: lift\<^sub>s_def Compose.lift\<^sub>s_def)
     with valid have "\<Gamma>\<turnstile>c \<down> project\<^sub>x (Normal S)"
       by (simp add: validt_def project\<^sub>x_def)
     hence "lift\<^sub>e \<Gamma>\<turnstile>lift\<^sub>c c \<down> Normal S"
       by (rule lift_termination')
   }
   ultimately show ?thesis
     by (simp add: validt_def)
 qed
 
 lemma (in lift_state_space) lift_hoaret:
   assumes deriv: "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows
    "(lift\<^sub>e \<Gamma>),{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (lift\<^sub>s P) (lift\<^sub>c c) (lift\<^sub>s Q),(lift\<^sub>s A)"
 apply (rule hoaret_complete)
 apply (insert hoaret_sound [OF deriv])
 apply (rule lift_validt)
 apply (simp add: cvalidt_def)
 done
 
 
 locale lift_state_space_ext = lift_state_space +
   assumes inj_proj_commute: "\<And>S. inject S (project S) = S"
   assumes inject_last: "\<And>S s t. inject (inject S s) t = inject S t"
 
 
 (* \<exists>x. state t = inject (state s) x *)
 lemma (in lift_state_space_ext) lift_exec_inject_same:
 assumes exec_lc: "(lift\<^sub>e \<Gamma>)\<turnstile>\<langle>lc,s\<rangle> \<Rightarrow> t"
 shows "\<And>c. \<lbrakk>lift\<^sub>c c = lc; t \<notin> (Fault ` UNIV) \<union> {Stuck}\<rbrakk> \<Longrightarrow>
               state t = inject (state s) (project (state t))"
 using exec_lc
 proof (induct)
   case Skip thus ?case
     by (clarsimp simp add: inj_proj_commute)
 next
   case Guard thus ?case
     by (clarsimp simp add: lift\<^sub>c_Guard lift\<^sub>c_def)
 next
   case GuardFault thus ?case
     by simp
 next
   case FaultProp thus ?case by simp
 next
   case Basic thus ?case
     by (clarsimp simp add: lift\<^sub>f_def Compose.lift\<^sub>f_def
         proj_inj_commute lift\<^sub>c_Basic lift\<^sub>c_def)
 next
   case (Spec r) thus ?case
     by (clarsimp simp add: Compose.lift\<^sub>r_def lift\<^sub>c_Spec lift\<^sub>c_def)
 next
   case SpecStuck
   thus ?case by simp
 next
   case (Seq lc1 s s' lc2 t c)
   have t: "t \<notin> Fault ` UNIV \<union> {Stuck}" by fact
   have "lift\<^sub>c c = Seq lc1 lc2" by fact
   then obtain c1 c2 where
     c: "c = Seq c1 c2" and
     lc1: "lc1 = lift\<^sub>c c1" and
     lc2: "lc2 = lift\<^sub>c c2"
     by (auto simp add: lift\<^sub>c_Seq lift\<^sub>c_def)
   show ?case
   proof (cases s')
     case (Normal s'')
     from Seq.hyps (2) [OF lc1 [symmetric]] this
     have "s'' = inject s (project s'')"
       by auto
     moreover from Seq.hyps (4) [OF lc2 [symmetric]] Normal t
     have "state t = inject s'' (project (state t))"
       by auto
     ultimately have "state t = inject (inject s (project s'')) (project (state t))"
       by simp
     then show ?thesis
       by (simp add: inject_last)
   next
     case (Abrupt s'')
     from Seq.hyps (2) [OF lc1 [symmetric]] this
     have "s'' = inject s (project s'')"
       by auto
     moreover from Seq.hyps (4) [OF lc2 [symmetric]] Abrupt t
     have "state t = inject s'' (project (state t))"
       by auto
     ultimately have "state t = inject (inject s (project s'')) (project (state t))"
       by simp
     then show ?thesis
       by (simp add: inject_last)
   next
     case (Fault f)
     with Seq
     have "t = Fault f"
       by (auto dest: Fault_end)
     with t have False by simp
     thus ?thesis ..
   next
     case Stuck
     with Seq
     have "t = Stuck"
       by (auto dest: Stuck_end)
     with t have False by simp
     thus ?thesis ..
   qed
 next
   case CondTrue thus ?case
     by (clarsimp simp add: lift\<^sub>c_Cond lift\<^sub>c_def)
 next
   case CondFalse thus ?case
     by (clarsimp simp add: lift\<^sub>c_Cond lift\<^sub>c_def)
 next
   case (WhileTrue s lb lc' s' t c)
   have t: "t \<notin> Fault ` UNIV \<union> {Stuck}" by fact
   have lw: "lift\<^sub>c c = While lb lc'" by fact
   then obtain b c' where
     c: "c = While b c'" and
     lb: "lb = lift\<^sub>s b" and
     lc: "lc' = lift\<^sub>c c'"
     by (auto simp add: lift\<^sub>c_While lift\<^sub>s_def lift\<^sub>c_def)
   show ?case
   proof (cases s')
     case (Normal s'')
     from WhileTrue.hyps (3) [OF lc [symmetric]] this
     have "s'' = inject s (project s'')"
       by auto
     moreover from WhileTrue.hyps (5) [OF lw] Normal t
     have "state t = inject s'' (project (state t))"
       by auto
     ultimately have "state t = inject (inject s (project s'')) (project (state t))"
       by simp
     then show ?thesis
       by (simp add: inject_last)
   next
     case (Abrupt s'')
     from WhileTrue.hyps (3) [OF lc [symmetric]] this
     have "s'' = inject s (project s'')"
       by auto
     moreover from WhileTrue.hyps (5) [OF lw] Abrupt t
     have "state t = inject s'' (project (state t))"
       by auto
     ultimately have "state t = inject (inject s (project s'')) (project (state t))"
       by simp
     then show ?thesis
       by (simp add: inject_last)
   next
     case (Fault f)
     with WhileTrue
     have "t = Fault f"
       by (auto dest: Fault_end)
     with t have False by simp
     thus ?thesis ..
   next
     case Stuck
     with WhileTrue
     have "t = Stuck"
       by (auto dest: Stuck_end)
     with t have False by simp
     thus ?thesis ..
   qed
 next
   case WhileFalse thus ?case
     by (clarsimp simp add: lift\<^sub>c_While inj_proj_commute)
 next
   case Call thus ?case
     by (clarsimp simp add: inject_last lift\<^sub>c_Call lift\<^sub>e_def lift\<^sub>c_def)
 next
   case CallUndefined thus ?case by simp
 next
   case StuckProp thus ?case by simp
 next
   case DynCom
   thus ?case
     by (clarsimp simp add: lift\<^sub>c_DynCom lift\<^sub>c_def)
 next
   case Throw thus ?case
     by (simp add: inj_proj_commute)
 next
   case AbruptProp thus ?case by (simp add: inj_proj_commute)
 next
   case (CatchMatch lc1 s s' lc2 t c)
   have t: "t \<notin> Fault ` UNIV \<union> {Stuck}" by fact
   have "lift\<^sub>c c = Catch lc1 lc2" by fact
   then obtain c1 c2 where
     c: "c = Catch c1 c2" and
     lc1: "lc1 = lift\<^sub>c c1" and
     lc2: "lc2 = lift\<^sub>c c2"
     by (auto simp add: lift\<^sub>c_Catch lift\<^sub>c_def)
   from CatchMatch.hyps (2) [OF lc1 [symmetric]] this
   have "s' = inject s (project s')"
     by auto
   moreover
   from CatchMatch.hyps (4) [OF lc2 [symmetric]] t
   have "state t = inject s' (project (state t))"
     by auto
   ultimately have "state t = inject (inject s (project s')) (project (state t))"
     by simp
   then show ?case
     by (simp add: inject_last)
 next
   case CatchMiss
   thus ?case
     by (clarsimp simp add: lift\<^sub>c_Catch lift\<^sub>c_def)
 qed
 
 lemma (in lift_state_space_ext) valid_inject_project:
  assumes noFaultStuck:
   "\<Gamma>\<turnstile>\<langle>c,Normal (project \<sigma>)\<rangle> \<Rightarrow>\<notin>(Fault ` UNIV \<union> {Stuck})"
  shows "lift\<^sub>e \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> {\<sigma>} lift\<^sub>c c
                 {t. t=inject \<sigma> (project t)}, {t. t=inject \<sigma> (project t)}"
 proof (rule validI)
   fix s t
   assume exec: "lift\<^sub>e \<Gamma>\<turnstile>\<langle>lift\<^sub>c c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> {\<sigma>}"
   assume noFault: "t \<notin> Fault ` F"
   show "t \<in> Normal ` {t. t = inject \<sigma> (project t)} \<union>
         Abrupt ` {t. t = inject \<sigma> (project t)}"
   proof -
     from lift_exec [OF exec]
     have "\<Gamma>\<turnstile>\<langle>c,project\<^sub>x (Normal s)\<rangle> \<Rightarrow> project\<^sub>x t"
       by simp
     with noFaultStuck P have t: "t \<notin> Fault ` UNIV \<union> {Stuck}"
       by (auto simp add: final_notin_def project\<^sub>x_def)
     from lift_exec_inject_same [OF exec refl this] P
     have "state t = inject \<sigma> (project (state t))"
       by simp
     with t show ?thesis
       by (cases t) auto
   qed
 qed
 
 lemma (in lift_state_space_ext) lift_exec_inject_same':
 assumes exec_lc: "(lift\<^sub>e \<Gamma>)\<turnstile>\<langle>lift\<^sub>c c,S\<rangle> \<Rightarrow> T"
 shows "\<And>c. \<lbrakk>T \<notin> (Fault ` UNIV) \<union> {Stuck}\<rbrakk> \<Longrightarrow>
               state T = inject (state S) (project (state T))"
   using lift_exec_inject_same [OF exec_lc]
   by simp
 
 lemma (in lift_state_space_ext) valid_lift_modifies:
   assumes valid: "\<forall>s. \<Gamma>\<Turnstile>\<^bsub>/F\<^esub> {s} c (Modif s),(ModifAbr s)"
   shows "(lift\<^sub>e \<Gamma>)\<Turnstile>\<^bsub>/F\<^esub> {S} (lift\<^sub>c c)
            {T. T \<in> lift\<^sub>s (Modif (project S)) \<and> T=inject S (project T)},
            {T. T \<in> lift\<^sub>s (ModifAbr (project S)) \<and> T=inject S (project T)}"
 proof (rule validI)
   fix s t
   assume exec: "lift\<^sub>e \<Gamma>\<turnstile>\<langle>lift\<^sub>c c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> {S}"
   assume noFault: "t \<notin> Fault ` F"
   show "t \<in> Normal `
                  {t \<in> lift\<^sub>s (Modif (project S)).
                   t = inject S (project t)} \<union>
                  Abrupt `
                  {t \<in> lift\<^sub>s (ModifAbr (project S)).
                   t = inject S (project t)}"
   proof -
     from lift_exec [OF exec]
     have "\<Gamma>\<turnstile> \<langle>c,project\<^sub>x (Normal s)\<rangle> \<Rightarrow> project\<^sub>x t"
       by auto
     moreover
     from noFault have "project\<^sub>x t \<notin> Fault ` F"
       by (cases "t") (auto simp add: project\<^sub>x_def)
     ultimately
     have "project\<^sub>x t \<in>
             Normal ` (Modif (project s)) \<union> Abrupt ` (ModifAbr (project s))"
       using valid [rule_format, of "(project s)"]
       by (auto simp add: valid_def project\<^sub>x_def)
     hence t: "t \<in> Normal ` lift\<^sub>s (Modif (project s)) \<union>
                Abrupt ` lift\<^sub>s (ModifAbr (project s))"
       by (cases t) (auto simp add: project\<^sub>x_def lift\<^sub>s_def Compose.lift\<^sub>s_def)
     then have "t \<notin> Fault ` UNIV \<union> {Stuck}"
       by (cases t) auto
     from lift_exec_inject_same [OF exec _ this]
     have "state t = inject (state (Normal s)) (project (state t))"
       by simp
     with t show ?thesis
       using P by auto
   qed
 qed
 
 lemma (in lift_state_space_ext) hoare_lift_modifies:
   assumes deriv: "\<forall>\<sigma>. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (Modif \<sigma>),(ModifAbr \<sigma>)"
   shows "\<forall>\<sigma>. (lift\<^sub>e \<Gamma>),{}\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (lift\<^sub>c c)
            {T. T \<in> lift\<^sub>s (Modif (project \<sigma>)) \<and> T=inject \<sigma> (project T)},
            {T. T \<in> lift\<^sub>s (ModifAbr (project \<sigma>)) \<and> T=inject \<sigma> (project T)}"
 apply (rule allI)
 apply (rule hoare_complete)
 apply (rule valid_lift_modifies)
 apply (rule allI)
 apply (insert hoare_sound [OF deriv [rule_format]])
 apply (simp add: cvalid_def)
 done
 
 lemma (in lift_state_space_ext) hoare_lift_modifies':
   assumes deriv: "\<forall>\<sigma>. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (Modif \<sigma>),(ModifAbr \<sigma>)"
   shows "\<forall>\<sigma>. (lift\<^sub>e \<Gamma>),{}\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} (lift\<^sub>c c)
            {T. T \<in> lift\<^sub>s (Modif (project \<sigma>)) \<and>
                    (\<exists>T'. T=inject \<sigma> T')},
            {T. T \<in> lift\<^sub>s (ModifAbr (project \<sigma>)) \<and>
                    (\<exists>T'. T=inject \<sigma> T')}"
 apply (rule allI)
 apply (rule HoarePartialDef.conseq [OF hoare_lift_modifies [OF deriv]])
 apply blast
 done
 
 subsection \<open>Renaming Procedures\<close>
 
 primrec rename:: "('p \<Rightarrow> 'q) \<Rightarrow> ('s,'p,'f) com \<Rightarrow> ('s,'q,'f) com"
 where
 "rename N Skip = Skip" |
 "rename N (Basic f) = Basic f" |
 "rename N (Spec r) = Spec r" |
 "rename N (Seq c\<^sub>1 c\<^sub>2)  = (Seq (rename N c\<^sub>1) (rename N c\<^sub>2))" |
 "rename N (Cond b c\<^sub>1 c\<^sub>2) = Cond b (rename N c\<^sub>1) (rename N c\<^sub>2)" |
 "rename N (While b c) = While b (rename N c)" |
 "rename N (Call p) = Call (N p)" |
 "rename N (DynCom c) = DynCom (\<lambda>s. rename N (c s))" |
 "rename N (Guard f g c) = Guard f g (rename N c)" |
 "rename N Throw = Throw" |
 "rename N (Catch c\<^sub>1 c\<^sub>2) = Catch (rename N c\<^sub>1) (rename N c\<^sub>2)"
 
 lemma rename_Skip: "rename h c = Skip = (c=Skip)"
   by (cases c) auto
 
 lemma rename_Basic:
   "(rename h c = Basic f) = (c=Basic f)"
   by (cases c) auto
 
 lemma rename_Spec:
   "(rename h c = Spec r) = (c=Spec r)"
   by (cases c) auto
 
 lemma rename_Seq:
   "(rename h c = Seq rc\<^sub>1 rc\<^sub>2) =
      (\<exists> c\<^sub>1 c\<^sub>2. c = Seq c\<^sub>1 c\<^sub>2 \<and>
                rc\<^sub>1 = rename h c\<^sub>1 \<and> rc\<^sub>2 = rename h c\<^sub>2 )"
     by (cases c) auto
 
 lemma rename_Cond:
   "(rename h c = Cond b rc\<^sub>1 rc\<^sub>2) =
      (\<exists>c\<^sub>1 c\<^sub>2. c = Cond b c\<^sub>1 c\<^sub>2  \<and> rc\<^sub>1 = rename h c\<^sub>1 \<and> rc\<^sub>2 = rename h c\<^sub>2 )"
   by (cases c) auto
 
 lemma rename_While:
   "(rename h c = While b rc') = (\<exists>c'. c = While b c' \<and> rc' = rename h c')"
   by (cases c) auto
 
 lemma rename_Call:
   "(rename h c = Call q) = (\<exists>p. c = Call p \<and> q=h p)"
   by (cases c) auto
 
 lemma rename_DynCom:
   "(rename h c = DynCom rc) = (\<exists>C. c=DynCom C \<and> rc = (\<lambda>s. rename h (C s)))"
   by (cases c) auto
 
 lemma rename_Guard:
   "(rename h c = Guard f g rc') =
      (\<exists>c'. c = Guard f g c' \<and> rc' = rename h c')"
    by (cases c) auto
 
 lemma rename_Throw:
   "(rename h c = Throw) = (c = Throw)"
   by (cases c) auto
 
 lemma rename_Catch:
   "(rename h c = Catch rc\<^sub>1 rc\<^sub>2) =
      (\<exists>c\<^sub>1 c\<^sub>2. c = Catch c\<^sub>1 c\<^sub>2 \<and> rc\<^sub>1 = rename h c\<^sub>1 \<and> rc\<^sub>2 = rename h c\<^sub>2 )"
     by (cases c) auto
 
 lemma exec_rename_to_exec:
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (h p) = Some (rename h bdy)"
   assumes exec: "\<Gamma>'\<turnstile>\<langle>rc,s\<rangle> \<Rightarrow> t"
   shows "\<And>c. rename h c = rc\<Longrightarrow>  \<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t' \<and> (t'=Stuck \<or> t'=t)"
 using exec
 proof (induct)
   case Skip thus ?case by (fastforce intro: exec.intros simp add: rename_Skip)
 next
   case Guard thus ?case by (fastforce intro: exec.intros simp add: rename_Guard)
 next
   case GuardFault thus ?case by (fastforce intro: exec.intros simp add: rename_Guard)
 next
   case FaultProp thus ?case by (fastforce intro: exec.intros)
 next
   case Basic thus ?case by (fastforce intro: exec.intros simp add: rename_Basic)
 next
   case Spec thus ?case by (fastforce intro: exec.intros simp add: rename_Spec)
 next
   case SpecStuck thus ?case by (fastforce intro: exec.intros simp add: rename_Spec)
 next
   case Seq thus ?case by (fastforce intro: exec.intros simp add: rename_Seq)
 next
   case CondTrue thus ?case by (fastforce intro: exec.intros simp add: rename_Cond)
 next
   case CondFalse thus ?case by (fastforce intro: exec.intros simp add: rename_Cond)
 next
   case WhileTrue thus ?case by (fastforce intro: exec.intros simp add: rename_While)
 next
   case WhileFalse thus ?case by (fastforce intro: exec.intros simp add: rename_While)
 next
   case (Call p rbdy s t)
   have rbdy: "\<Gamma>' p = Some rbdy" by fact
   have "rename h c = Call p" by fact
   then obtain q where c: "c=Call q" and p: "p=h q"
     by (auto simp add: rename_Call)
   show ?case
   proof (cases "\<Gamma> q")
     case None
     with c show ?thesis by (auto intro: exec.CallUndefined)
   next
     case (Some bdy)
     from \<Gamma> [rule_format, OF this] p rbdy
     have "rename h bdy = rbdy" by simp
     with Call.hyps c Some
     show ?thesis
       by (fastforce intro: exec.intros)
   qed
 next
   case (CallUndefined p s)
   have undef: "\<Gamma>' p = None" by fact
   have "rename h c = Call p" by fact
   then obtain q where c: "c=Call q" and p: "p=h q"
     by (auto simp add: rename_Call)
   from undef p \<Gamma> have "\<Gamma> q = None"
     by (cases "\<Gamma> q") auto
   with p c show ?case
     by (auto intro: exec.intros)
 next
   case StuckProp thus ?case by (fastforce intro: exec.intros)
 next
   case DynCom thus ?case by (fastforce intro: exec.intros simp add: rename_DynCom)
 next
   case Throw thus ?case by (fastforce intro: exec.intros simp add: rename_Throw)
 next
   case AbruptProp thus ?case by (fastforce intro: exec.intros)
 next
   case CatchMatch thus ?case by (fastforce intro: exec.intros simp add: rename_Catch)
 next
   case CatchMiss thus ?case by (fastforce intro: exec.intros simp add: rename_Catch)
 qed
 
 
 
 lemma exec_rename_to_exec':
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes exec: "\<Gamma>'\<turnstile>\<langle>rename N c,s\<rangle> \<Rightarrow> t"
   shows "\<exists>t'. \<Gamma>\<turnstile>\<langle>c,s\<rangle> \<Rightarrow> t' \<and> (t'=Stuck \<or> t'=t)"
   using exec_rename_to_exec [OF \<Gamma> exec]
   by  auto
 
 
 
 lemma valid_to_valid_rename:
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes valid: "\<Gamma>\<Turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>'\<Turnstile>\<^bsub>/F\<^esub> P (rename N c) Q,A"
 proof (rule validI)
   fix s t
   assume execr: "\<Gamma>'\<turnstile> \<langle>rename N c,Normal s\<rangle> \<Rightarrow> t"
   assume P: "s \<in> P"
   assume noFault: "t \<notin> Fault ` F"
   show "t \<in> Normal ` Q \<union> Abrupt ` A"
   proof -
     from exec_rename_to_exec [OF \<Gamma> execr]
     obtain t' where
       exec: "\<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow> t'"  and t': "(t' = Stuck \<or> t' = t)"
       by auto
     with valid noFault P show ?thesis
       by (auto simp add: valid_def)
   qed
 qed
 
 lemma hoare_to_hoare_rename:
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes deriv: "\<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>',{}\<turnstile>\<^bsub>/F\<^esub> P (rename N c) Q,A"
 apply (rule hoare_complete)
 apply (insert hoare_sound [OF deriv])
 apply (rule valid_to_valid_rename)
 apply  (rule \<Gamma>)
 apply (simp add: cvalid_def)
 done
 
 lemma hoare_to_hoare_rename':
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes deriv: "\<forall>Z. \<Gamma>,{}\<turnstile>\<^bsub>/F\<^esub> (P Z) c (Q Z),(A Z)"
   shows "\<forall>Z. \<Gamma>',{}\<turnstile>\<^bsub>/F\<^esub> (P Z) (rename N c) (Q Z),(A Z)"
 apply rule
 apply (rule hoare_to_hoare_rename [OF \<Gamma>])
 apply (rule deriv[rule_format])
 done
 
 lemma terminates_to_terminates_rename:
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes termi: "\<Gamma>\<turnstile> c \<down> s"
   assumes noStuck: "\<Gamma>\<turnstile> \<langle>c,s\<rangle> \<Rightarrow>\<notin>{Stuck}"
   shows "\<Gamma>'\<turnstile> rename N c \<down> s"
 using termi noStuck
 proof (induct)
   case Skip thus ?case by (fastforce intro: terminates.intros)
 next
   case Basic thus ?case by (fastforce intro: terminates.intros)
 next
   case Spec thus ?case by (fastforce intro: terminates.intros)
 next
   case Guard thus ?case by (fastforce intro: terminates.intros
     simp add: final_notin_def exec.intros)
 next
   case GuardFault thus ?case by (fastforce intro: terminates.intros)
 next
   case Fault thus ?case by (fastforce intro: terminates.intros)
 next
   case Seq
   thus ?case
     by (force intro!: terminates.intros exec.intros dest: exec_rename_to_exec [OF \<Gamma>]
          simp add: final_notin_def)
 next
   case CondTrue thus ?case by (fastforce intro: terminates.intros
     simp add: final_notin_def exec.intros)
 next
   case CondFalse thus ?case by (fastforce intro: terminates.intros
     simp add: final_notin_def exec.intros)
 next
   case (WhileTrue s b c)
   have s_in_b: "s \<in> b" by fact
   have noStuck: "\<Gamma>\<turnstile> \<langle>While b c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}" by fact
   with s_in_b have "\<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
     by (auto simp add: final_notin_def intro: exec.intros)
   with WhileTrue.hyps have "\<Gamma>'\<turnstile>rename N c \<down> Normal s"
     by simp
   moreover
   {
     fix t
     assume exec_rc: "\<Gamma>'\<turnstile> \<langle>rename N c,Normal s\<rangle> \<Rightarrow> t"
     have "\<Gamma>'\<turnstile> While b (rename N c) \<down> t"
     proof -
       from exec_rename_to_exec [OF \<Gamma> exec_rc] obtain t'
         where exec_c: "\<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow> t'" and t': "(t' = Stuck \<or> t' = t)"
         by auto
       with s_in_b noStuck obtain "t'=t" and "\<Gamma>\<turnstile> \<langle>While b c,t\<rangle> \<Rightarrow>\<notin>{Stuck}"
         by (auto simp add: final_notin_def intro: exec.intros)
       with exec_c WhileTrue.hyps
       show ?thesis
         by auto
     qed
   }
   ultimately show ?case
     using s_in_b
     by (auto intro: terminates.intros)
 next
   case WhileFalse thus ?case by (fastforce intro: terminates.intros)
 next
   case (Call p bdy s)
   have "\<Gamma> p = Some bdy" by fact
   from \<Gamma> [rule_format, OF this]
   have bdy': "\<Gamma>' (N p) = Some (rename N bdy)".
   from Call have "\<Gamma>'\<turnstile>rename N bdy \<down> Normal s"
     by (auto simp add: final_notin_def intro: exec.intros)
   with bdy' have "\<Gamma>'\<turnstile>Call (N p) \<down> Normal s"
     by (auto intro: terminates.intros)
   thus ?case by simp
 next
   case (CallUndefined p s)
   have "\<Gamma> p = None" "\<Gamma>\<turnstile> \<langle>Call p,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}" by fact+
   hence False by (auto simp add: final_notin_def intro: exec.intros)
   thus ?case ..
 next
   case Stuck thus ?case by (fastforce intro: terminates.intros)
 next
   case DynCom thus ?case by (fastforce intro: terminates.intros
     simp add: final_notin_def exec.intros)
 next
   case Throw thus ?case by (fastforce intro: terminates.intros)
 next
   case Abrupt thus ?case by (fastforce intro: terminates.intros)
 next
   case (Catch c1 s c2)
   have noStuck: "\<Gamma>\<turnstile> \<langle>Catch c1 c2,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}" by fact
   hence "\<Gamma>\<turnstile> \<langle>c1,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
     by (fastforce simp add: final_notin_def intro: exec.intros)
   with Catch.hyps have "\<Gamma>'\<turnstile>rename N c1 \<down> Normal s"
     by auto
   moreover
   {
     fix t
     assume exec_rc1:"\<Gamma>'\<turnstile> \<langle>rename N c1,Normal s\<rangle> \<Rightarrow> Abrupt t"
     have "\<Gamma>'\<turnstile>rename N c2 \<down> Normal t"
     proof -
       from exec_rename_to_exec [OF \<Gamma> exec_rc1] obtain t'
         where exec_c: "\<Gamma>\<turnstile> \<langle>c1,Normal s\<rangle> \<Rightarrow> t'" and "(t' = Stuck \<or> t' = Abrupt t)"
         by auto
       with noStuck have t': "t'=Abrupt t"
         by (fastforce simp add: final_notin_def intro: exec.intros)
       with exec_c noStuck have "\<Gamma>\<turnstile> \<langle>c2,Normal t\<rangle> \<Rightarrow>\<notin>{Stuck}"
         by (auto simp add: final_notin_def intro: exec.intros)
       with exec_c t' Catch.hyps
       show ?thesis
         by auto
     qed
   }
   ultimately show ?case
     by (auto intro: terminates.intros)
 qed
 
 lemma validt_to_validt_rename:
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes valid: "\<Gamma>\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>'\<Turnstile>\<^sub>t\<^bsub>/F\<^esub> P (rename N c) Q,A"
 proof -
   from valid
   have "\<Gamma>'\<Turnstile>\<^bsub>/F\<^esub> P (rename N c) Q,A"
     by (auto intro: valid_to_valid_rename [OF \<Gamma>] simp add: validt_def)
   moreover
   {
     fix s
     assume "s \<in> P"
     with valid obtain "\<Gamma>\<turnstile>c \<down> (Normal s)" "\<Gamma>\<turnstile> \<langle>c,Normal s\<rangle> \<Rightarrow>\<notin>{Stuck}"
       by (auto simp add: validt_def valid_def final_notin_def)
     from terminates_to_terminates_rename [OF \<Gamma> this]
     have "\<Gamma>'\<turnstile>rename N c \<down> Normal s"
       .
   }
   ultimately show ?thesis
     by (simp add: validt_def)
 qed
 
 lemma hoaret_to_hoaret_rename:
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes deriv: "\<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P c Q,A"
   shows "\<Gamma>',{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> P (rename N c) Q,A"
 apply (rule hoaret_complete)
 apply (insert hoaret_sound [OF deriv])
 apply (rule validt_to_validt_rename)
 apply  (rule \<Gamma>)
 apply (simp add: cvalidt_def)
 done
 
 lemma hoaret_to_hoaret_rename':
   assumes \<Gamma>: "\<forall>p bdy. \<Gamma> p = Some bdy \<longrightarrow> \<Gamma>' (N p) = Some (rename N bdy)"
   assumes deriv: "\<forall>Z. \<Gamma>,{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) c (Q Z),(A Z)"
   shows "\<forall>Z. \<Gamma>',{}\<turnstile>\<^sub>t\<^bsub>/F\<^esub> (P Z) (rename N c) (Q Z),(A Z)"
 apply rule
 apply (rule hoaret_to_hoaret_rename [OF \<Gamma>])
 apply (rule deriv[rule_format])
 done
 
 lemma lift\<^sub>c_whileAnno [simp]: "lift\<^sub>c prj inject (whileAnno b I V c) =
     whileAnno (lift\<^sub>s prj b)
               (lift\<^sub>s prj I) (lift\<^sub>r prj inject V) (lift\<^sub>c prj inject c)"
   by (simp add: whileAnno_def)
 
 lemma lift\<^sub>c_block [simp]: "lift\<^sub>c prj inject (block init bdy return c) =
   block (lift\<^sub>f prj inject init) (lift\<^sub>c prj inject bdy)
         (\<lambda>s. (lift\<^sub>f prj inject (return (prj s))))
         (\<lambda>s t. lift\<^sub>c prj inject (c (prj s) (prj t)))"
-  by (simp add: block_def)
+  by (simp add: block_def block_exn_def)
 
 (*
 lemma lift\<^sub>c_block [simp]: "lift\<^sub>c prj inject (block init bdy return c) =
   block (lift\<^sub>f prj inject init) (lift\<^sub>c prj inject bdy)
         (\<lambda>s t. inject s (return (prj s) (prj t)))
         (\<lambda>s t. lift\<^sub>c prj inject (c (prj s) (prj t)))"
   apply (simp add: block_def)
   apply (simp add: lift\<^sub>f_def)
 *)
 lemma lift\<^sub>c_call [simp]: "lift\<^sub>c prj inject (call init p return c) =
   call (lift\<^sub>f prj inject init) p
         (\<lambda>s. (lift\<^sub>f prj inject (return (prj s))))
         (\<lambda>s t. lift\<^sub>c prj inject (c (prj s) (prj t)))"
   by (simp add: call_def lift\<^sub>c_block)
 
 lemma rename_whileAnno [simp]: "rename h (whileAnno b I V c) =
    whileAnno b I V (rename h c)"
   by (simp add: whileAnno_def)
 
 lemma rename_block [simp]: "rename h (block init bdy return c) =
   block init (rename h bdy) return (\<lambda>s t. rename h (c s t))"
-  by (simp add: block_def)
+  by (simp add: block_def block_exn_def)
 
 lemma rename_call [simp]: "rename h (call init p return c) =
   call init (h p) return (\<lambda>s t. rename h (c s t))"
   by (simp add: call_def)
 
 
 end
 
 
diff --git a/thys/Simpl/ex/ComposeEx.thy b/thys/Simpl/ex/ComposeEx.thy
--- a/thys/Simpl/ex/ComposeEx.thy
+++ b/thys/Simpl/ex/ComposeEx.thy
@@ -1,248 +1,227 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      ComposeEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 theory ComposeEx imports Compose "../Vcg" "../HeapList" begin
 
 
 record globals_list =
   next_' :: "ref \<Rightarrow> ref"
 
 record state_list = "globals_list state" +
   p_'    :: "ref"
   sl_q_'    :: "ref"
   r_'    :: "ref"
 
 
 procedures Rev(p|sl_q) =
       "\<acute>sl_q :== Null;;
        WHILE \<acute>p \<noteq> Null
        DO
          \<acute>r :== \<acute>p;; \<lbrace>\<acute>p \<noteq> Null\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
          \<lbrace>\<acute>r \<noteq> Null\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>sl_q;; \<acute>sl_q :== \<acute>r
        OD"
 print_theorems
 
 
 
 lemma (in Rev_impl)
  Rev_modifies:
   "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV \<^esub>{\<sigma>} \<acute>sl_q :== PROC Rev(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (vcg spec=modifies)
 done
 
 lemma (in Rev_impl) shows
  Rev_spec:
   "\<forall>Ps. \<Gamma>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps\<rbrace> \<acute>sl_q :== PROC Rev(\<acute>p) \<lbrace>List \<acute>sl_q \<acute>next (rev Ps)\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (hoare_rule anno =
        "\<acute>sl_q :== Null;;
        WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>sl_q \<acute>next Qs' \<and>
                              set Ps' \<inter> set Qs' = {} \<and>
                              rev Ps' @ Qs' = rev Ps\<rbrace>
         DO
          \<acute>r :== \<acute>p;; \<lbrace>\<acute>p \<noteq> Null\<rbrace>\<longmapsto>\<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
          \<lbrace>\<acute>r \<noteq> Null\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>sl_q;; \<acute>sl_q :== \<acute>r
        OD" in HoarePartial.annotateI)
 apply vcg
 apply   clarsimp
 apply  fastforce
 apply clarsimp
 done
 
 declare [[names_unique = false]]
 
 record globals =
   strnext_'   :: "ref \<Rightarrow> ref"
   chr_'    :: "ref \<Rightarrow> char"
 
   qnext_' :: "ref \<Rightarrow> ref"
   cont_'   :: "ref \<Rightarrow> int"
 record state = "globals state" +
   str_'  :: "ref"
   queue_':: "ref"
   q_'    :: "ref"
   r_'    :: "ref"
 
 
 definition project_globals_str:: "globals \<Rightarrow> globals_list"
   where "project_globals_str g = \<lparr>next_' = strnext_' g\<rparr>"
 
 definition project_str:: "state \<Rightarrow> state_list"
 where
 "project_str s =
   \<lparr>globals = project_globals_str (globals s),
    state_list.p_' = str_' s, sl_q_' = q_' s, state_list.r_' = r_' s\<rparr>"
 
 definition inject_globals_str::
   "globals \<Rightarrow> globals_list \<Rightarrow> globals"
 where
   "inject_globals_str G g =
    G\<lparr>strnext_' := next_' g\<rparr>"
 
 definition "inject_str"::"state \<Rightarrow> state_list \<Rightarrow> state" where
 "inject_str S s = S\<lparr>globals := inject_globals_str (globals S) (globals s),
                 str_' := state_list.p_' s, q_' := sl_q_' s,
                 r_' := state_list.r_' s\<rparr>"
 
 lemma globals_inject_project_str_commutes:
   "inject_globals_str G (project_globals_str G) = G"
   by (simp add: inject_globals_str_def project_globals_str_def)
 
 lemma inject_project_str_commutes: "inject_str S (project_str S) = S"
   by (simp add: inject_str_def project_str_def globals_inject_project_str_commutes)
 
 lemma globals_project_inject_str_commutes:
   "project_globals_str (inject_globals_str G g) = g"
   by (simp add: inject_globals_str_def project_globals_str_def)
 
 lemma project_inject_str_commutes: "project_str (inject_str S s) = s"
   by (simp add: inject_str_def project_str_def globals_project_inject_str_commutes)
 
 lemma globals_inject_str_last:
   "inject_globals_str (inject_globals_str G g) g' = inject_globals_str G g'"
   by (simp add: inject_globals_str_def)
 
 lemma inject_str_last:
   "inject_str (inject_str S s) s' = inject_str S s'"
   by (simp add: inject_str_def globals_inject_str_last)
 
 definition
   "lift\<^sub>e = (\<lambda>\<Gamma> p. map_option (lift\<^sub>c project_str inject_str) (\<Gamma> p))"
 print_locale lift_state_space
 interpretation ex: lift_state_space project_str inject_str
   "xstate_map project_str" lift\<^sub>e "lift\<^sub>c project_str inject_str"
   "lift\<^sub>f project_str inject_str" "lift\<^sub>s project_str"
   "lift\<^sub>r project_str inject_str"
   apply -
   apply       (rule lift_state_space.intro)
   apply       (rule project_inject_str_commutes)
   apply      simp
   apply     simp
   apply    (simp add: lift\<^sub>e_def)
   apply   simp
   apply  simp
   apply simp
   done
 
 interpretation ex: lift_state_space_ext project_str inject_str
   "xstate_map project_str" lift\<^sub>e "lift\<^sub>c project_str inject_str"
   "lift\<^sub>f project_str inject_str" "lift\<^sub>s project_str"
   "lift\<^sub>r project_str inject_str"
 
 (*  project_str "inject_str" _ lift\<^sub>e *)
 apply -
 apply intro_locales [1]
   apply (rule lift_state_space_ext_axioms.intro)
   apply  (rule inject_project_str_commutes)
   apply (rule inject_str_last)
 apply (simp_all add: lift\<^sub>e_def)
   done
 
 (*
   apply (intro_locales)
   apply (rule lift_state_space_ext_axioms.intro)
   apply  (rule inject_project_str_commutes)
   apply (rule inject_str_last)
   done
 *)
 
 (*
 declare lift_set_def [simp] project_def [simp] project_globals_def [simp]
 *)
 lemmas Rev_lift_spec = ex.lift_hoarep' [OF Rev_impl.Rev_spec,simplified lift\<^sub>s_def
  project_str_def project_globals_str_def,simplified, of _ "''Rev''"]
 print_theorems
 
 
 definition "\<N> p' p = (if p=''Rev'' then p' else '''')"
 
 
 procedures RevStr(str|q) = "rename (\<N> RevStr_'proc)
                 (lift\<^sub>c project_str inject_str (Rev_body.Rev_body))"
 
 
 lemmas Rev_lift_spec' =
   Rev_lift_spec [of "[''Rev''\<mapsto>Rev_body.Rev_body]" ,
      simplified Rev_impl_def Rev_clique_def,simplified]
 thm Rev_lift_spec'
 
 
 lemma Rev_lift_spec'':
   "\<forall>Ps. lift\<^sub>e [''Rev'' \<mapsto> Rev_body.Rev_body]
        \<turnstile> \<lbrace>List \<acute>str \<acute>strnext Ps\<rbrace> Call ''Rev'' \<lbrace>List \<acute>q \<acute>strnext (rev Ps)\<rbrace>"
   by (rule Rev_lift_spec')
 
 lemma (in RevStr_impl) \<N>_ok:
 "\<forall>p bdy. (lift\<^sub>e [''Rev'' \<mapsto> Rev_body.Rev_body]) p = Some bdy \<longrightarrow>
      \<Gamma> (\<N> RevStr_'proc p) = Some (rename (\<N> RevStr_'proc) bdy)"
 apply (insert RevStr_impl)
 apply (auto simp add: RevStr_body_def lift\<^sub>e_def \<N>_def)
 done
 
 context RevStr_impl
 begin
  thm hoare_to_hoare_rename'[OF _ Rev_lift_spec'', OF \<N>_ok,
   simplified \<N>_def, simplified ]
 end
 
 lemmas (in RevStr_impl) RevStr_spec =
   hoare_to_hoare_rename' [OF _ Rev_lift_spec'', OF \<N>_ok,
   simplified \<N>_def, simplified ]
 
 
 lemma (in RevStr_impl) RevStr_spec':
 "\<forall>Ps. \<Gamma>\<turnstile> \<lbrace>List \<acute>str \<acute>strnext Ps\<rbrace> \<acute>q :== PROC RevStr(\<acute>str)
           \<lbrace>List \<acute>q \<acute>strnext (rev Ps)\<rbrace>"
   by (rule RevStr_spec)
 
 lemmas Rev_modifies' =
   Rev_impl.Rev_modifies [of "[''Rev''\<mapsto>Rev_body.Rev_body]", simplified Rev_impl_def,
    simplified]
 thm Rev_modifies'
 
 context RevStr_impl
 begin
 lemmas RevStr_modifies' =
   hoare_to_hoare_rename' [OF _ ex.hoare_lift_modifies' [OF Rev_modifies'],
          OF \<N>_ok, of "''Rev''", simplified \<N>_def Rev_clique_def,simplified]
 end
 
 
 lemma (in RevStr_impl) RevStr_modifies:
 "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV \<^esub>{\<sigma>} \<acute>str :== PROC RevStr(\<acute>str)
   {t. t may_only_modify_globals \<sigma> in [strnext]}"
 apply (rule allI)
 apply (rule HoarePartialProps.ConseqMGT [OF RevStr_modifies'])
 apply (clarsimp simp add:
   lift\<^sub>s_def mex_def meq_def
   project_str_def inject_str_def project_globals_str_def inject_globals_str_def)
 apply blast
 done
 
 end
 
diff --git a/thys/Simpl/ex/ProcParEx.thy b/thys/Simpl/ex/ProcParEx.thy
--- a/thys/Simpl/ex/ProcParEx.thy
+++ b/thys/Simpl/ex/ProcParEx.thy
@@ -1,255 +1,234 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      ProcParEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section "Examples for Procedures as Parameters"
 
 theory ProcParEx imports "../Vcg" begin
 
 
 lemma DynProcProcPar':
  assumes adapt: "P \<subseteq> {s. p s = q \<and>
          (\<exists>Z. init s \<in> P' Z \<and>
               (\<forall>t \<in> Q' Z. return s t \<in> R s t) \<and>
               (\<forall>t \<in> A' Z. return s t \<in> A))}"
  assumes result: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>(R s t) result s t Q,A"
  assumes q: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>(P' Z) Call q (Q' Z),(A' Z)"
  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P dynCall init p return result Q,A"
 apply (rule HoarePartial.DynProcProcPar [OF _ result q])
 apply (insert adapt)
 apply fast
 done
 
 
 lemma conseq_exploit_pre':
              "\<lbrakk>\<forall>s \<in> S. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile> (P \<inter> S)c Q,A"
   apply (rule HoarePartialDef.Conseq)
   apply clarify
   by (metis IntI insertI1 subset_refl)
 
 
 lemma conseq_exploit_pre'':
              "\<lbrakk>\<forall>Z. \<forall>s \<in> S Z.  \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
               \<Longrightarrow>
               \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S Z)c (Q Z),(A Z)"
   apply (rule allI)
   apply (rule conseq_exploit_pre')
   apply blast
   done
 
 lemma conseq_exploit_pre''':
              "\<lbrakk>\<forall>s \<in> S. \<forall>Z. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
               \<Longrightarrow>
               \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S)c (Q Z),(A Z)"
   apply (rule allI)
   apply (rule conseq_exploit_pre')
   apply blast
   done
 
 
 
 record 'g vars = "'g state" +
   compare_' :: string
   n_'   :: nat
   m_'   :: nat
   b_'   :: bool
   k_'  :: nat
 
 
 
 procedures compare(n,m|b) = "NoBody"
 print_locale! compare_signature
 
 
 context compare_signature
 begin
 declare [[hoare_use_call_tr' = false]]
 term "\<acute>b :== CALL compare(\<acute>n,\<acute>m)"
 term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
 declare [[hoare_use_call_tr' = true]]
 term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
 end
 
 
 procedures
   LEQ (n,m | b) = "\<acute>b :== \<acute>n \<le> \<acute>m"
   LEQ_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>}  PROC LEQ(\<acute>n,\<acute>m,\<acute>b) \<lbrace>\<acute>b = (\<^bsup>\<sigma>\<^esup>n \<le> \<^bsup>\<sigma>\<^esup>m)\<rbrace>"
   LEQ_modifies: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} PROC LEQ(\<acute>n,\<acute>m,\<acute>b) {t. t may_only_modify_globals \<sigma> in []}"
 
 
 
 definition mx:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"
   where "mx leq a b = (if leq a b then a else b)"
 
 procedures
   Max (compare, n, m | k) =
   "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m);;
    IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI"
 
   Max_spec: "\<And>leq. \<forall>\<sigma>. \<Gamma>\<turnstile>
   ({\<sigma>} \<inter> {s. (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
               (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})})
     PROC Max(\<acute>compare,\<acute>n,\<acute>m,\<acute>k)
   \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 
 
 lemma (in Max_impl ) Max_spec1:
 shows
 "\<forall>\<sigma> leq. \<Gamma>\<turnstile>
   ({\<sigma>} \<inter> \<lbrace> (\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
       (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 proof -
   fix \<sigma>:: "('a,'b) vars_scheme" and s::"('a,'b) vars_scheme" and leq
    assume compare_spec:
        "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m\<rbrace>"
 
   assume compare_modifies:
         "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m)
                 {t. t may_only_modify_globals \<tau> in []}"
 
    show "\<Gamma>\<turnstile>({s} \<inter> {\<sigma>})
             \<acute>b :== DYNCALL \<acute>compare (\<acute>n,\<acute>m);;
             IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI
             \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
      apply vcg
      apply (clarsimp simp add: mx_def)
      done
  qed
 
 
 lemma (in Max_impl) Max_spec2:
 shows
 "\<forall>\<sigma> leq. \<Gamma>\<turnstile>
   ({\<sigma>} \<inter> \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
       (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply (clarsimp simp add: mx_def)
 done
 
 lemma (in Max_impl) Max_spec3:
 shows
 "\<forall>n m leq. \<Gamma>\<turnstile>
   (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace>  \<inter>
    \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
      (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq n m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply (clarsimp simp add: mx_def)
 done
 
 lemma (in Max_impl) Max_spec4:
 shows
 "\<forall>n m leq. \<Gamma>\<turnstile>
   (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<inter> \<lbrace>\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq n m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply (clarsimp simp add: mx_def)
 done
 
 locale Max_test = Max_spec + LEQ_spec + LEQ_modifies
 lemma (in Max_test)
 
   shows
   "\<Gamma>\<turnstile> {\<sigma>} \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (\<le>) \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 proof -
   note Max_spec = Max_spec [where leq="(\<le>)"]
   show ?thesis
     apply vcg
     apply (clarsimp)
     apply (rule conjI)
     apply (rule LEQ_spec [simplified])
     apply (rule LEQ_modifies [simplified])
     done
 qed
 
 
 lemma (in Max_impl) Max_spec5:
 shows
 "\<forall>n m leq. \<Gamma>\<turnstile>
   (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<inter> \<lbrace>\<forall>n' m'. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n' \<and> \<acute>m=m'\<rbrace> \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq n' m')\<rbrace>\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq n m\<rbrace>"
 term "\<lbrace>{s. \<^bsup>s\<^esup>n = n' \<and> \<^bsup>s\<^esup>m = m'} = X\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply clarsimp
 apply (clarsimp simp add: mx_def)
 done
 
 lemma (in LEQ_impl)
  LEQ_spec: "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace>  PROC LEQ(\<acute>n,\<acute>m,\<acute>b) \<lbrace>\<acute>b = (n \<le> m)\<rbrace>"
   apply vcg
   done
 
 
 locale Max_test' = Max_impl + LEQ_impl
 lemma (in Max_test')
   shows
   "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (\<le>) n m\<rbrace>"
 proof -
   note Max_spec = Max_spec5
   show ?thesis
     apply vcg
     apply (rule_tac x="(\<le>)" in exI)
     apply clarsimp
     apply (rule LEQ_spec [rule_format])
     done
 qed
 
 end
diff --git a/thys/Simpl/ex/ProcParExSP.thy b/thys/Simpl/ex/ProcParExSP.thy
--- a/thys/Simpl/ex/ProcParExSP.thy
+++ b/thys/Simpl/ex/ProcParExSP.thy
@@ -1,278 +1,259 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      ProcParEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2007-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
+Copyright (c) 2022 Apple Inc. All rights reserved.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section "Examples for Procedures as Parameters using Statespaces"
 theory ProcParExSP imports "../Vcg" begin
 
 
 lemma DynProcProcPar':
  assumes adapt: "P \<subseteq> {s. p s = q \<and>
          (\<exists>Z. init s \<in> P' Z \<and>
               (\<forall>t \<in> Q' Z. return s t \<in> R s t) \<and>
               (\<forall>t \<in> A' Z. return s t \<in> A))}"
  assumes result: "\<forall>s t. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>(R s t) result s t Q,A"
  assumes q: "\<forall>Z. \<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>(P' Z) Call q (Q' Z),(A' Z)"
  shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F \<^esub>P dynCall init p return result Q,A"
 apply (rule HoarePartial.DynProcProcPar [OF _ result q])
 apply (insert adapt)
 apply fast
 done
 
 
 
 
 lemma conseq_exploit_pre':
              "\<lbrakk>\<forall>s \<in> S. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P) c Q,A\<rbrakk>
               \<Longrightarrow>
               \<Gamma>,\<Theta>\<turnstile> (P \<inter> S)c Q,A"
   apply (rule HoarePartialDef.Conseq)
   apply clarify
   by (metis IntI insertI1 subset_refl)
 
 lemma conseq_exploit_pre'':
              "\<lbrakk>\<forall>Z. \<forall>s \<in> S Z.  \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
               \<Longrightarrow>
               \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S Z)c (Q Z),(A Z)"
   apply (rule allI)
   apply (rule conseq_exploit_pre')
   apply blast
   done
 
 lemma conseq_exploit_pre''':
              "\<lbrakk>\<forall>s \<in> S. \<forall>Z. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
               \<Longrightarrow>
               \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S)c (Q Z),(A Z)"
   apply (rule allI)
   apply (rule conseq_exploit_pre')
   apply blast
   done
 
 
 procedures compare(i::nat,j::nat|r::bool) "NoBody"
 
 
 print_locale! compare_signature
 
 
 context compare_impl
 begin
 declare [[hoare_use_call_tr' = false]]
 term "\<acute>r :== CALL compare(\<acute>i,\<acute>j)"
 declare [[hoare_use_call_tr' = true]]
 end
 
 
-(* FIXME: typing issue with modifies locale*)
+(* fixme: typing issue with modifies locale*)
 procedures
   LEQ (i::nat,j::nat | r::bool) "\<acute>r :== \<acute>i \<le> \<acute>j"
   LEQ_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>}  PROC LEQ(\<acute>i,\<acute>j,\<acute>r) \<lbrace>\<acute>r = (\<^bsup>\<sigma>\<^esup>i \<le> \<^bsup>\<sigma>\<^esup>j)\<rbrace>"
 
   LEQ_modifies: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} PROC LEQ(\<acute>i,\<acute>j,\<acute>r) {t. t may_only_modify_globals \<sigma> in []}"
 
 
 
 definition mx:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"
   where "mx leq a b = (if leq a b then a else b)"
 
 procedures (imports compare_signature)
   Max (compare::string, n::nat, m::nat | k::nat)
   where b::bool
   in
   "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m);;
    IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI"
 
   Max_spec: "\<And>leq. \<forall>\<sigma>. \<Gamma>\<turnstile>
   ({\<sigma>} \<inter> {s. (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
               (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})})
     PROC Max(\<acute>compare,\<acute>n,\<acute>m,\<acute>k)
   \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 
 context Max_spec
 begin
 thm Max_spec
 end
 context Max_impl
 begin
 term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
 declare [[hoare_use_call_tr' = false]]
 term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
 declare [[hoare_use_call_tr' = true]]
 end
 
 
 
 lemma (in Max_impl ) Max_spec1:
 shows
 "\<forall>\<sigma> leq. \<Gamma>\<turnstile>
   ({\<sigma>} \<inter> \<lbrace> (\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
       (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 proof -
   fix \<sigma>:: "('a, 'b, 'c, 'd) stateSP_scheme" and s::"('a, 'b, 'c, 'd) stateSP_scheme" and leq
    assume compare_spec:
        "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j\<rbrace>"
 
   assume compare_modifies:
         "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>r :== PROC \<^bsup>s\<^esup>compare(\<acute>i,\<acute>j)
                 {t. t may_only_modify_globals \<tau> in []}"
 
    show "\<Gamma>\<turnstile>({s} \<inter> {\<sigma>})
             \<acute>b :== DYNCALL \<acute>compare (\<acute>n,\<acute>m);;
             IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI
             \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
      apply vcg
      apply (clarsimp simp add: mx_def)
      done
  qed
 
 
 lemma (in Max_impl) Max_spec2:
 shows
 "\<forall>\<sigma> leq. \<Gamma>\<turnstile>
   ({\<sigma>} \<inter> \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
       (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply (clarsimp simp add: mx_def)
 done
 
 lemma (in Max_impl) Max_spec3:
 shows
 "\<forall>n m leq. \<Gamma>\<turnstile>
   (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace>  \<inter>
    \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>) \<and>
      (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq n m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply (clarsimp simp add: mx_def)
 done
 
 lemma (in Max_impl) Max_spec4:
 shows
 "\<forall>n m leq. \<Gamma>\<turnstile>
   (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<inter> \<lbrace>\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq \<^bsup>\<tau>\<^esup>i \<^bsup>\<tau>\<^esup>j)\<rbrace>\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq n m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply (clarsimp simp add: mx_def)
 done
 
 print_locale Max_spec
 
 (* We have to rename the parameters of the compare procedure to match the LEQ procedure *)
 locale Max_test = Max_spec where
         i_'compare_' = i_'LEQ_' and
         j_'compare_' = j_'LEQ_' and
         r_'compare_' = r_'LEQ_'
        + LEQ_spec + LEQ_modifies
 
 lemma (in Max_test)
   shows
   "\<Gamma>\<turnstile> {\<sigma>} \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (\<le>) \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
 proof -
   note Max_spec = Max_spec [where leq="(\<le>)"]
   show ?thesis
     apply vcg
     apply (clarsimp)
     apply (rule conjI)
     apply (rule LEQ_spec)
     apply (rule LEQ_modifies)
     done
 qed
 
 
 
 
 
 
 lemma (in Max_impl) Max_spec5:
 shows
 "\<forall>n m leq. \<Gamma>\<turnstile>
   (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<inter> \<lbrace>\<forall>n' m'. \<Gamma>\<turnstile> \<lbrace>\<acute>i=n' \<and> \<acute>j=m'\<rbrace> \<acute>r :== PROC \<acute>compare(\<acute>i,\<acute>j) \<lbrace>\<acute>r = (leq n' m')\<rbrace>\<rbrace>)
     \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
   \<lbrace>\<acute>k = mx leq n m\<rbrace>"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (intro allI)
 apply (rule conseq_exploit_pre')
 apply (rule)
 apply clarify
 apply vcg
 apply clarsimp
 apply (clarsimp simp add: mx_def)
 done
 
 lemma (in LEQ_impl)
  LEQ_spec: "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>i=n \<and> \<acute>j=m\<rbrace>  PROC LEQ(\<acute>i,\<acute>j,\<acute>r) \<lbrace>\<acute>r = (n \<le> m)\<rbrace>"
   apply vcg
   apply simp
   done
 
 
 print_locale Max_impl
 locale Max_test' = Max_impl where
         i_'compare_' = i_'LEQ_' and
         j_'compare_' = j_'LEQ_' and
         r_'compare_' = r_'LEQ_'
         + LEQ_impl
 lemma (in Max_test')
   shows
   "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (\<le>) n m\<rbrace>"
 proof -
   note Max_spec = Max_spec5
   show ?thesis
     apply vcg
     apply (rule_tac x="(\<le>)" in exI)
     apply clarsimp
     apply (rule LEQ_spec [rule_format])
     done
 qed
 
 end
diff --git a/thys/Simpl/ex/Quicksort.thy b/thys/Simpl/ex/Quicksort.thy
--- a/thys/Simpl/ex/Quicksort.thy
+++ b/thys/Simpl/ex/Quicksort.thy
@@ -1,221 +1,200 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      Quicksort.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section "Example: Quicksort on Heap Lists"
 
 theory Quicksort
 imports "../Vcg" "../HeapList" "HOL-Library.Multiset"
 begin
 
 record globals_heap =
   next_' :: "ref \<Rightarrow> ref"
   cont_' :: "ref \<Rightarrow> nat"
 
 record 'g vars = "'g state" +
   p_'    :: "ref"
   q_'    :: "ref"
   le_'   :: "ref"
   gt_'   :: "ref"
   hd_'   :: "ref"
   tl_'   :: "ref"
 
 procedures
   append(p,q|p) =
     "IF \<acute>p=Null THEN \<acute>p :== \<acute>q ELSE \<acute>p\<rightarrow>\<acute>next :== CALL append(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"
 
   append_spec:
    "\<forall>\<sigma> Ps Qs.
      \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
            \<acute>p :== PROC append(\<acute>p,\<acute>q)
          \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 
   append_modifies:
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC append(\<acute>p,\<acute>q){t. t may_only_modify_globals \<sigma> in [next]}"
 
 
 lemma (in append_impl) append_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC append(\<acute>p,\<acute>q){t. t may_only_modify_globals \<sigma> in [next]}"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (vcg spec=modifies)
   done
 
 
 lemma (in append_impl) append_spec:
   shows "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>
             \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
                 \<acute>p :== PROC append(\<acute>p,\<acute>q)
             \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply fastforce
   done
 
 primrec sorted:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list  \<Rightarrow> bool"
 where
 "sorted le [] = True" |
 "sorted le (x#xs) = ((\<forall>y\<in>set xs. le x y) \<and> sorted le xs)"
 
 lemma sorted_append[simp]:
  "sorted le (xs@ys) = (sorted le xs \<and> sorted le ys \<and>
                        (\<forall>x \<in> set xs. \<forall>y \<in> set ys. le x y))"
 by (induct xs, auto)
 
 procedures quickSort(p|p) =
  "IF \<acute>p=Null THEN SKIP
   ELSE \<acute>tl :== \<acute>p\<rightarrow>\<acute>next;;
        \<acute>le :== Null;;
        \<acute>gt :== Null;;
        WHILE \<acute>tl\<noteq>Null DO
          \<acute>hd :== \<acute>tl;;
          \<acute>tl :== \<acute>tl\<rightarrow>\<acute>next;;
          IF \<acute>hd\<rightarrow>\<acute>cont \<le> \<acute>p\<rightarrow>\<acute>cont
          THEN \<acute>hd\<rightarrow>\<acute>next :== \<acute>le;;
               \<acute>le :== \<acute>hd
          ELSE \<acute>hd\<rightarrow>\<acute>next :== \<acute>gt;;
               \<acute>gt :== \<acute>hd
          FI
        OD;;
        \<acute>le :== CALL quickSort(\<acute>le);;
        \<acute>gt :== CALL quickSort(\<acute>gt);;
        \<acute>p\<rightarrow>\<acute>next :== \<acute>gt;;
        \<acute>le :== CALL append(\<acute>le,\<acute>p);;
        \<acute>p :== \<acute>le
   FI"
 
   quickSort_spec:
   "\<forall>\<sigma> Ps. \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps\<rbrace> \<acute>p :== PROC quickSort(\<acute>p)
        \<lbrace>(\<exists>sortedPs. List \<acute>p \<acute>next sortedPs \<and>
         sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont sortedPs) \<and>
         mset Ps = mset sortedPs) \<and>
         (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 
   quickSort_modifies:
   "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC quickSort(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"
 
 
 lemma (in quickSort_impl) quickSort_modifies:
   shows
   "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC quickSort(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (vcg spec=modifies)
 done
 
 lemma (in quickSort_impl) quickSort_spec:
 shows
   "\<forall>\<sigma> Ps. \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps\<rbrace>
                   \<acute>p :== PROC quickSort(\<acute>p)
                 \<lbrace>(\<exists>sortedPs. List \<acute>p \<acute>next sortedPs \<and>
                  sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont sortedPs) \<and>
                  mset Ps = mset sortedPs) \<and>
                  (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (hoare_rule anno =
  "IF \<acute>p=Null THEN SKIP
   ELSE \<acute>tl :== \<acute>p\<rightarrow>\<acute>next;;
        \<acute>le :== Null;;
        \<acute>gt :== Null;;
        WHILE \<acute>tl\<noteq>Null
        INV \<lbrace> (\<exists>les grs tls. List \<acute>le \<acute>next les \<and> List \<acute>gt \<acute>next grs \<and>
                List \<acute>tl \<acute>next tls \<and>
                mset Ps = mset (\<acute>p#tls@les@grs) \<and>
                distinct(\<acute>p#tls@les@grs) \<and>
                (\<forall>x\<in>set les. x\<rightarrow>\<acute>cont \<le> \<acute>p\<rightarrow>\<acute>cont) \<and>
                (\<forall>x\<in>set grs. \<acute>p\<rightarrow>\<acute>cont < x\<rightarrow>\<acute>cont)) \<and>
                \<acute>p=\<^bsup>\<sigma>\<^esup>p \<and>
                \<acute>cont=\<^bsup>\<sigma>\<^esup>cont \<and>
                List \<^bsup>\<sigma>\<^esup>p \<^bsup>\<sigma>\<^esup>next Ps \<and>
                (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>
        DO
          \<acute>hd :== \<acute>tl;;
          \<acute>tl :== \<acute>tl\<rightarrow>\<acute>next;;
          IF \<acute>hd\<rightarrow>\<acute>cont \<le> \<acute>p\<rightarrow>\<acute>cont
          THEN \<acute>hd\<rightarrow>\<acute>next :== \<acute>le;;
               \<acute>le :== \<acute>hd
          ELSE \<acute>hd\<rightarrow>\<acute>next :== \<acute>gt;;
               \<acute>gt :== \<acute>hd
          FI
        OD;;
        \<acute>le :== CALL quickSort(\<acute>le);;
        \<acute>gt :== CALL quickSort(\<acute>gt);;
        \<acute>p\<rightarrow>\<acute>next :== \<acute>gt;;
        \<acute>le :== CALL append(\<acute>le,\<acute>p);;
        \<acute>p :== \<acute>le
   FI" in HoarePartial.annotateI)
   apply vcg
     apply fastforce
    apply clarsimp
    apply (rule conjI)
     apply clarify
     apply (rule conjI)
      apply (rule_tac x="tl#les" in exI)
      apply simp
      apply (rule_tac x="grs" in exI)
      apply simp
      apply (rule_tac x="ps" in exI)
      apply simp
     apply (metis insertCI set_mset_add_mset_insert set_mset_mset)
    apply clarify
    apply (rule conjI)
     apply (rule_tac x="les" in exI)
     apply simp
     apply (rule_tac x="tl#grs" in exI)
     apply simp
     apply (rule_tac x="ps" in exI)
     apply simp
    apply (metis insertCI set_mset_add_mset_insert set_mset_mset)
   apply clarsimp
   apply (rule_tac ?x=grs in exI)
   apply (rule conjI)
   apply (erule heap_eq_ListI1)
    apply clarify
    apply (erule_tac x=x in allE) back
    apply blast
   apply clarsimp
   apply (rule_tac x="sortedPs" in exI)
   apply (rule conjI)
    apply (erule heap_eq_ListI1)
    apply (clarsimp)
    apply (erule_tac x=x in allE) back back
    apply (metis IntI empty_iff set_mset_mset)
   apply (rule_tac x="p#sortedPsa" in exI)
   apply (rule conjI)
    apply (metis List_cons List_updateI Null_notin_List fun_upd_same insert_iff set_mset_add_mset_insert set_mset_mset)
   apply (rule conjI)
    apply (metis disjoint_iff mset_eq_setD set_ConsD)
   apply clarsimp
   apply (rule conjI)
    apply (metis less_or_eq_imp_le mset_eq_setD)
   apply (rule conjI)
    apply (metis leD less_le_trans mset_eq_setD nat_le_linear)
   apply clarsimp
   apply (erule_tac x=x in allE)+
   apply (metis Un_iff insert_iff list.set(2) mset.simps(2) mset_append set_append set_mset_mset)
   done
 
 end
diff --git a/thys/Simpl/ex/VcgEx.thy b/thys/Simpl/ex/VcgEx.thy
--- a/thys/Simpl/ex/VcgEx.thy
+++ b/thys/Simpl/ex/VcgEx.thy
@@ -1,1511 +1,1490 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      VcgEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>Examples using the Verification Environment\<close>
 
 theory VcgEx imports "../HeapList" "../Vcg" begin
 
 text \<open>Some examples, especially the single-step Isar proofs are taken from
 \texttt{HOL/Isar\_examples/HoareEx.thy}.
 \<close>
 
 subsection \<open>State Spaces\<close>
 
 text \<open>
  First of all we provide a store of program variables that
  occur in the programs considered later.  Slightly unexpected
  things may happen when attempting to work with undeclared variables.
 \<close>
 
 record 'g vars = "'g state" +
   A_' :: nat
   I_' :: nat
   M_' :: nat
   N_' :: nat
   R_' :: nat
   S_' :: nat
   B_' :: bool
   Arr_' :: "nat list"
   Abr_':: string
 
 
 
 text \<open>We decorate the state components in the record with the suffix \<open>_'\<close>,
 to avoid cluttering the namespace with the simple names that could no longer
 be used for logical variables otherwise.
 \<close>
 
 text \<open>We will first consider programs without procedures, later on
 we will regard procedures without global variables and finally we
 will get the full pictures: mutually recursive procedures with global
 variables (including heap).
 \<close>
 
 subsection \<open>Basic Examples\<close>
 
 text \<open>
  We look at few trivialities involving assignment and sequential
  composition, in order to get an idea of how to work with our
  formulation of Hoare Logic.
 \<close>
 
 text \<open>
  Using the basic rule directly is a bit cumbersome.
 \<close>
 
 lemma "\<Gamma>\<turnstile> {|\<acute>N = 5|} \<acute>N :== 2 * \<acute>N {|\<acute>N = 10|}"
   apply (rule HoarePartial.Basic)  apply simp
   done
 
 text \<open>
  If we refer to components (variables) of the state-space of the program
  we always mark these with \<open>\<acute>\<close>. It is the acute-symbol and is present on
  most keyboards. So all program variables are marked with the acute and all
  logical variables are not.
  The assertions of the Hoare tuple are
  ordinary Isabelle sets. As we usually want to refer to the state space
  in the assertions, we provide special brackets for them. They can be written
  as {\verb+{| |}+} in ASCII or \<open>\<lbrace> \<rbrace>\<close> with symbols. Internally
  marking variables has two effects. First of all we refer to the implicit
  state and secondary we get rid of the suffix \<open>_'\<close>.
  So the assertion @{term "{|\<acute>N = 5|}"} internally gets expanded to
  \<open>{s. N_' s = 5}\<close> written in ordinary set comprehension notation of
  Isabelle. It describes the set of states where the \<open>N_'\<close> component
  is equal to \<open>5\<close>.
 \<close>
 
 
 text \<open>
  Certainly we want the state modification already done, e.g.\ by
  simplification.  The \<open>vcg\<close> method performs the basic state
  update for us; we may apply the Simplifier afterwards to achieve
  ``obvious'' consequences as well.
 \<close>
 
 
 lemma "\<Gamma>\<turnstile> \<lbrace>True\<rbrace> \<acute>N :== 10 \<lbrace>\<acute>N = 10\<rbrace>"
   by vcg
 
 lemma "\<Gamma>\<turnstile> \<lbrace>2 * \<acute>N = 10\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   by vcg
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N + 1 = a + 1\<rbrace> \<acute>N :== \<acute>N + 1 \<lbrace>\<acute>N = a + 1\<rbrace>"
   by vcg
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = a\<rbrace> \<acute>N :== \<acute>N + 1 \<lbrace>\<acute>N = a + 1\<rbrace>"
   by vcg
 
 
 lemma "\<Gamma>\<turnstile> \<lbrace>a = a \<and> b = b\<rbrace> \<acute>M :== a;; \<acute>N :== b \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>"
   by vcg
 
 
 lemma "\<Gamma>\<turnstile> \<lbrace>True\<rbrace> \<acute>M :== a;; \<acute>N :== b \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>"
   by vcg
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>
                 \<acute>I :== \<acute>M;; \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
               \<lbrace>\<acute>M = b \<and> \<acute>N = a\<rbrace>"
   by vcg
 
 text \<open>
 We can also perform verification conditions generation step by step by using
 the \<open>vcg_step\<close> method.
 \<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>
                \<acute>I :== \<acute>M;; \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
               \<lbrace>\<acute>M = b \<and> \<acute>N = a\<rbrace>"
   apply vcg_step
   apply vcg_step
   apply vcg_step
   apply vcg_step
   done
 
 text \<open>
  It is important to note that statements like the following one can
  only be proven for each individual program variable.  Due to the
  extra-logical nature of record fields, we cannot formulate a theorem
  relating record selectors and updates schematically.
 \<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = a\<rbrace> \<acute>N :== \<acute>N \<lbrace>\<acute>N = a\<rbrace>"
   by vcg
 
 
 (*
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>x = a\<rbrace> \<acute>x :== \<acute>x \<lbrace>\<acute>x = a\<rbrace>"
   apply (rule HoarePartial.Basic)
   -- {* We can't proof this since we don't know what @{text "x_'_update"} is. *}
   oops
  *)
 lemma "\<Gamma>\<turnstile>{s. x_' s = a} (Basic (\<lambda>s. x_'_update (x_' s) s)) {s. x_' s = a}"
   oops
 
 
 text \<open>
  In the following assignments we make use of the consequence rule in
  order to achieve the intended precondition.  Certainly, the
  \<open>vcg\<close> method is able to handle this case, too.
 \<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
 proof -
   have "\<lbrace>\<acute>M = \<acute>N\<rbrace> \<subseteq> \<lbrace>\<acute>M + 1 \<noteq> \<acute>N\<rbrace>"
     by auto
   also have "\<Gamma>\<turnstile> \<dots> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
     by vcg
   finally show ?thesis .
 qed
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
 proof -
   have "\<And>m n::nat. m = n \<longrightarrow> m + 1 \<noteq> n"
       \<comment> \<open>inclusion of assertions expressed in ``pure'' logic,\<close>
       \<comment> \<open>without mentioning the state space\<close>
     by simp
   also have "\<Gamma>\<turnstile> \<lbrace>\<acute>M + 1 \<noteq> \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
     by vcg
   finally show ?thesis .
 qed
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
   apply vcg
   apply simp
   done
 
 subsection \<open>Multiplication by Addition\<close>
 
 text \<open>
  We now do some basic examples of actual \texttt{WHILE} programs.
  This one is a loop for calculating the product of two natural
  numbers, by iterated addition.  We first give detailed structured
  proof based on single-step Hoare rules.
 \<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
       WHILE \<acute>M \<noteq> a
       DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
       \<lbrace>\<acute>S = a * b\<rbrace>"
 proof -
   let "\<Gamma>\<turnstile> _ ?while _" = ?thesis
   let "\<lbrace>\<acute>?inv\<rbrace>" = "\<lbrace>\<acute>S = \<acute>M * b\<rbrace>"
 
   have "\<lbrace>\<acute>M = 0 & \<acute>S = 0\<rbrace> \<subseteq> \<lbrace>\<acute>?inv\<rbrace>" by auto
   also have "\<Gamma>\<turnstile> \<dots> ?while \<lbrace>\<acute>?inv \<and> \<not> (\<acute>M \<noteq> a)\<rbrace>"
   proof
     let ?c = "\<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1"
     have "\<lbrace>\<acute>?inv \<and> \<acute>M \<noteq> a\<rbrace> \<subseteq> \<lbrace>\<acute>S + b = (\<acute>M + 1) * b\<rbrace>"
       by auto
     also have "\<Gamma>\<turnstile> \<dots> ?c \<lbrace>\<acute>?inv\<rbrace>" by vcg
     finally show "\<Gamma>\<turnstile> \<lbrace>\<acute>?inv \<and> \<acute>M \<noteq> a\<rbrace> ?c \<lbrace>\<acute>?inv\<rbrace>" .
   qed
   also have "\<lbrace>\<acute>?inv \<and> \<not> (\<acute>M \<noteq> a)\<rbrace> \<subseteq> \<lbrace>\<acute>S = a * b\<rbrace>" by auto
   finally show ?thesis by blast
 qed
 
 
 text \<open>
  The subsequent version of the proof applies the \<open>vcg\<close> method
  to reduce the Hoare statement to a purely logical problem that can be
  solved fully automatically.  Note that we have to specify the
  \texttt{WHILE} loop invariant in the original statement.
 \<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           WHILE \<acute>M \<noteq> a
           INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
           DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
   apply vcg
   apply auto
   done
 
 text \<open>Here some examples of ``breaking'' out of a loop\<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           TRY
             WHILE True
             INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
             DO IF \<acute>M = a THEN THROW ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 FI OD
           CATCH
             SKIP
           END
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           TRY
             WHILE True
             INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
             DO IF \<acute>M = a THEN \<acute>Abr :== ''Break'';;THROW
                ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
                FI
             OD
           CATCH
             IF \<acute>Abr = ''Break'' THEN SKIP ELSE Throw FI
           END
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 
 text \<open>Some more syntactic sugar, the label statement \<open>\<dots> \<bullet> \<dots>\<close> as shorthand
 for the \<open>TRY-CATCH\<close> above, and the \<open>RAISE\<close> for an state-update followed
 by a \<open>THROW\<close>.
 \<close>
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           \<lbrace>\<acute>Abr = ''Break''\<rbrace>\<bullet> WHILE True INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
            DO IF \<acute>M = a THEN RAISE \<acute>Abr :== ''Break''
               ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
               FI
            OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           TRY
             WHILE True
             INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
             DO IF \<acute>M = a THEN RAISE \<acute>Abr :== ''Break''
                ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
                FI
             OD
           CATCH
             IF \<acute>Abr = ''Break'' THEN SKIP ELSE Throw FI
           END
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           \<lbrace>\<acute>Abr = ''Break''\<rbrace> \<bullet> WHILE True
           INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
           DO IF \<acute>M = a THEN RAISE \<acute>Abr :== ''Break''
                ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
                FI
           OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 text \<open>Blocks\<close>
 
 lemma  "\<Gamma>\<turnstile>\<lbrace>\<acute>I = i\<rbrace> LOC \<acute>I;; \<acute>I :== 2  COL \<lbrace>\<acute>I \<le> i\<rbrace>"
   apply vcg
   by simp
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n\<rbrace> LOC \<acute>N :== 10;; \<acute>N :== \<acute>N + 2 COL \<lbrace>\<acute>N = n\<rbrace>"
   by vcg
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n\<rbrace> LOC \<acute>N :== 10, \<acute>M;; \<acute>N :== \<acute>N + 2 COL \<lbrace>\<acute>N = n\<rbrace>"
   by vcg
 
 
 subsection \<open>Summing Natural Numbers\<close>
 
 text \<open>
  We verify an imperative program to sum natural numbers up to a given
  limit.  First some functional definition for proper specification of
  the problem.
 \<close>
 
 primrec
   sum :: "(nat => nat) => nat => nat"
 where
   "sum f 0 = 0"
 | "sum f (Suc n) = f n + sum f n"
 
 syntax
   "_sum" :: "idt => nat => nat => nat"
     ("SUMM _<_. _" [0, 0, 10] 10)
 translations
   "SUMM j<k. b" == "CONST sum (\<lambda>j. b) k"
 
 text \<open>
  The following proof is quite explicit in the individual steps taken,
  with the \<open>vcg\<close> method only applied locally to take care of
  assignment and sequential composition.  Note that we express
  intermediate proof obligation in pure logic, without referring to the
  state space.
 \<close>
 
 theorem "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
            \<acute>S :== 0;; \<acute>I :== 1;;
            WHILE \<acute>I \<noteq> n
            DO
              \<acute>S :== \<acute>S + \<acute>I;;
              \<acute>I :== \<acute>I + 1
            OD
            \<lbrace>\<acute>S = (SUMM j<n. j)\<rbrace>"
   (is "\<Gamma>\<turnstile> _ (_;; ?while) _")
 proof -
   let ?sum = "\<lambda>k. SUMM j<k. j"
   let ?inv = "\<lambda>s i. s = ?sum i"
 
   have "\<Gamma>\<turnstile> \<lbrace>True\<rbrace> \<acute>S :== 0;; \<acute>I :== 1 \<lbrace>?inv \<acute>S \<acute>I\<rbrace>"
   proof -
     have "True \<longrightarrow> 0 = ?sum 1"
       by simp
     also have "\<Gamma>\<turnstile> \<lbrace>\<dots>\<rbrace> \<acute>S :== 0;; \<acute>I :== 1 \<lbrace>?inv \<acute>S \<acute>I\<rbrace>"
       by vcg
     finally show ?thesis .
   qed
   also have "\<Gamma>\<turnstile> \<lbrace>?inv \<acute>S \<acute>I\<rbrace> ?while \<lbrace>?inv \<acute>S \<acute>I \<and> \<not> \<acute>I \<noteq> n\<rbrace>"
   proof
     let ?body = "\<acute>S :== \<acute>S + \<acute>I;; \<acute>I :== \<acute>I + 1"
     have "\<And>s i. ?inv s i \<and> i \<noteq> n \<longrightarrow>  ?inv (s + i) (i + 1)"
       by simp
     also have "\<Gamma>\<turnstile> \<lbrace>\<acute>S + \<acute>I = ?sum (\<acute>I + 1)\<rbrace> ?body \<lbrace>?inv \<acute>S \<acute>I\<rbrace>"
       by vcg
     finally show "\<Gamma>\<turnstile> \<lbrace>?inv \<acute>S \<acute>I \<and> \<acute>I \<noteq> n\<rbrace> ?body \<lbrace>?inv \<acute>S \<acute>I\<rbrace>" .
   qed
   also have "\<And>s i. s = ?sum i \<and> \<not> i \<noteq> n \<longrightarrow> s = ?sum n"
     by simp
   finally show ?thesis .
 qed
 
 text \<open>
  The next version uses the \<open>vcg\<close> method, while still explaining
  the resulting proof obligations in an abstract, structured manner.
 \<close>
 
 theorem "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
            \<acute>S :== 0;; \<acute>I :== 1;;
            WHILE \<acute>I \<noteq> n
            INV \<lbrace>\<acute>S = (SUMM j<\<acute>I. j)\<rbrace>
            DO
              \<acute>S :== \<acute>S + \<acute>I;;
              \<acute>I :== \<acute>I + 1
            OD
           \<lbrace>\<acute>S = (SUMM j<n. j)\<rbrace>"
 proof -
   let ?sum = "\<lambda>k. SUMM j<k. j"
   let ?inv = "\<lambda>s i. s = ?sum i"
 
   show ?thesis
   proof vcg
     show "?inv 0 1" by simp
   next
     fix i s assume "?inv s i" "i \<noteq> n"
     thus "?inv (s + i) (i + 1)" by simp
   next
     fix i s assume x: "?inv s i" "\<not> i \<noteq> n"
     thus "s = ?sum n" by simp
   qed
 qed
 
 text \<open>
  Certainly, this proof may be done fully automatically as well, provided
  that the invariant is given beforehand.
 \<close>
 
 theorem "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
            \<acute>S :== 0;; \<acute>I :== 1;;
            WHILE \<acute>I \<noteq> n
            INV \<lbrace>\<acute>S = (SUMM j<\<acute>I. j)\<rbrace>
            DO
              \<acute>S :== \<acute>S + \<acute>I;;
              \<acute>I :== \<acute>I + 1
            OD
            \<lbrace>\<acute>S = (SUMM j<n. j)\<rbrace>"
   apply vcg
   apply auto
   done
 
 subsection \<open>SWITCH\<close>
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> SWITCH \<acute>B
                         {True} \<Rightarrow> \<acute>N :== 6
                       | {False} \<Rightarrow> \<acute>N :== 7
                      END
           \<lbrace>\<acute>N > 5\<rbrace>"
 apply vcg
 apply simp
 done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> SWITCH \<acute>N
                         {v. v < 5} \<Rightarrow> \<acute>N :== 6
                       | {v. v \<ge> 5} \<Rightarrow> \<acute>N :== 7
                      END
           \<lbrace>\<acute>N > 5\<rbrace>"
 apply vcg
 apply simp
 done
 
 subsection \<open>(Mutually) Recursive Procedures\<close>
 
 subsubsection \<open>Factorial\<close>
 
 text \<open>We want to define a procedure for the factorial. We first
 define a HOL functions that calculates it to specify the procedure later on.
 \<close>
 
 primrec fac:: "nat \<Rightarrow> nat"
 where
 "fac 0 = 1" |
 "fac (Suc n) = (Suc n) * fac n"
 
 lemma fac_simp [simp]: "0 < i \<Longrightarrow>  fac i = i * fac (i - 1)"
   by (cases i) simp_all
 
 text \<open>Now we define the procedure\<close>
 
 procedures
   Fac (N|R) = "IF \<acute>N = 0 THEN \<acute>R :== 1
                        ELSE \<acute>R :== CALL Fac(\<acute>N - 1);;
                             \<acute>R :== \<acute>N * \<acute>R
                        FI"
 
 
 
 text \<open>A procedure is given by the signature of the procedure
 followed by the procedure body.
 The signature consists of the name of the procedure and a list of
 parameters. The parameters in front of the pipe \<open>|\<close> are value parameters
 and behind the pipe are the result parameters. Value parameters model call by value
 semantics. The value of a result parameter at the end of the procedure is passed back
 to the caller.
 \<close>
 
 
 
 text \<open>
 Behind the scenes the \<open>procedures\<close> command provides us convenient syntax
 for procedure calls, defines a constant for the procedure body
 (named @{term "Fac_body"}) and creates some locales. The purpose of locales
 is to set up logical contexts to support modular reasoning.
 A locale is named \<open>Fac_impl\<close> and extends the \<open>hoare\<close> locale
 with a theorem @{term "\<Gamma> ''Fac'' = Fac_body"} that simply states how the
 procedure is defined in the procedure context. Check out the locales.
 The purpose of the locales is to give us easy means to setup the context
 in which we will prove programs correct.
 In these locales the procedure context @{term "\<Gamma>"} is fixed.
 So always use this letter in procedure
 specifications. This is crucial, if we later on prove some tuples under the
 assumption of some procedure specifications.
 \<close>
 
 thm Fac_body.Fac_body_def
 print_locale Fac_impl
 
 text \<open>
 To see how a call is syntactically translated you can switch off the
 printing translation via the configuration option \<open>hoare_use_call_tr'\<close>
 \<close>
 
 context Fac_impl
 begin
 text \<open>
 @{term "CALL Fac(\<acute>N,\<acute>M)"} is internally:
 \<close>
 declare [[hoare_use_call_tr' = false]]
 text \<open>
 @{term "CALL Fac(\<acute>N,\<acute>M)"}
 \<close>
 term "CALL Fac(\<acute>N,\<acute>M)"
 declare [[hoare_use_call_tr' = true]]
 end
 
 text \<open>
 Now let us prove that @{term "Fac"} meets its specification.
 \<close>
 
 text \<open>
 Procedure specifications are ordinary Hoare tuples. We use the parameterless
 call for the specification; \<open>\<acute>R :== PROC Fac(\<acute>N)\<close> is syntactic sugar
 for \<open>Call ''Fac''\<close>. This emphasises that the specification
 describes the internal behaviour of the procedure, whereas parameter passing
 corresponds to the procedure call.
 \<close>
 
 
 lemma (in Fac_impl)
   shows "\<forall>n. \<Gamma>,\<Theta>\<turnstile>\<lbrace>\<acute>N=n\<rbrace>  PROC Fac(\<acute>N,\<acute>R) \<lbrace>\<acute>R = fac n\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply simp
   done
 
 
 text \<open>
 Since the factorial was implemented recursively,
 the main ingredient of this proof is, to assume that the specification holds for
 the recursive call of @{term Fac} and prove the body correct.
 The assumption for recursive calls is added to the context by
 the rule @{thm [source] HoarePartial.ProcRec1}
 (also derived from general rule for mutually recursive procedures):
 @{thm [display] HoarePartial.ProcRec1 [no_vars]}
 The verification condition generator will infer the specification out of the
 context when it encounters a recursive call of the factorial.
 \<close>
 
 text \<open>We can also step through verification condition generation. When
 the verification condition generator encounters a procedure call it tries to
 use the rule \<open>ProcSpec\<close>. To be successful there must be a specification
 of the procedure in the context.
 \<close>
 
 lemma (in Fac_impl)
   shows "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg_step
   apply   vcg_step
   apply  vcg_step
   apply vcg_step
   apply vcg_step
   apply simp
   done
 
 
 text \<open>Here some Isar style version of the proof\<close>
 lemma (in Fac_impl)
   shows "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
 proof (hoare_rule HoarePartial.ProcRec1)
   have Fac_spec: "\<forall>n. \<Gamma>,(\<Union>n. {(\<lbrace>\<acute>N=n\<rbrace>, Fac_'proc, \<lbrace>\<acute>R = fac n\<rbrace>,{})})
                        \<turnstile> \<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
     apply (rule allI)
     apply (rule hoarep.Asm)
     by auto
   show "\<forall>n. \<Gamma>,(\<Union>n. {(\<lbrace>\<acute>N=n\<rbrace>, Fac_'proc, \<lbrace>\<acute>R = fac n\<rbrace>,{})})
             \<turnstile> \<lbrace>\<acute>N=n\<rbrace> IF \<acute>N = 0 THEN \<acute>R :== 1
             ELSE \<acute>R :== CALL Fac(\<acute>N - 1);; \<acute>R :== \<acute>N * \<acute>R FI \<lbrace>\<acute>R = fac n\<rbrace>"
     apply vcg
     apply simp
     done
 qed
 
 text \<open>To avoid retyping of potentially large pre and postconditions in
 the previous proof we can use the casual term abbreviations of the Isar
 language.
 \<close>
 
 lemma (in Fac_impl)
   shows "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
   (is "\<forall>n. \<Gamma>\<turnstile>(?Pre n) ?Fac (?Post n)")
 proof (hoare_rule HoarePartial.ProcRec1)
   have Fac_spec: "\<forall>n. \<Gamma>,(\<Union>n. {(?Pre n, Fac_'proc, ?Post n,{})})
                        \<turnstile>(?Pre n) ?Fac (?Post n)"
     apply (rule allI)
     apply (rule hoarep.Asm)
     by auto
   show "\<forall>n. \<Gamma>,(\<Union>n. {(?Pre n, Fac_'proc, ?Post n,{})})
             \<turnstile> (?Pre n) IF \<acute>N = 0 THEN \<acute>R :== 1
             ELSE \<acute>R :== CALL Fac(\<acute>N - 1);; \<acute>R :== \<acute>N * \<acute>R FI (?Post n)"
     apply vcg
     apply simp
     done
 qed
 
 text \<open>The previous proof pattern has still some kind of inconvenience.
 The augmented context is always printed in the proof state. That can
 mess up the state, especially if we have large specifications. This may
 be annoying if we want to develop single step or structured proofs. In this
 case it can be a good idea to introduce a new variable for the augmented
 context.
 \<close>
 
 lemma (in Fac_impl) Fac_spec:
   shows "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
   (is "\<forall>n. \<Gamma>\<turnstile>(?Pre n) ?Fac (?Post n)")
 proof (hoare_rule HoarePartial.ProcRec1)
   define \<Theta>' where "\<Theta>' = (\<Union>n. {(?Pre n, Fac_'proc, ?Post n,{}::('a, 'b) vars_scheme set)})"
   have Fac_spec: "\<forall>n. \<Gamma>,\<Theta>'\<turnstile>(?Pre n) ?Fac (?Post n)"
     by (unfold \<Theta>'_def, rule allI, rule hoarep.Asm) auto
   txt \<open>We have to name the fact \<open>Fac_spec\<close>, so that the vcg can
    use the specification for the recursive call, since it cannot infer it
    from the opaque @{term "\<Theta>'"}.\<close>
   show "\<forall>\<sigma>. \<Gamma>,\<Theta>'\<turnstile> (?Pre \<sigma>) IF \<acute>N = 0 THEN \<acute>R :== 1
             ELSE \<acute>R :== CALL Fac(\<acute>N - 1);; \<acute>R :== \<acute>N * \<acute>R FI (?Post \<sigma>)"
     apply vcg
     apply simp
     done
 qed
 
 text \<open>There are different rules available to prove procedure calls,
 depending on the kind of postcondition and whether or not the
 procedure is recursive or even mutually recursive.
 See for example @{thm [source] HoarePartial.ProcRec1},
 @{thm [source] HoarePartial.ProcNoRec1}.
 They are all derived from the most general rule
 @{thm [source] HoarePartial.ProcRec}.
 All of them have some side-condition concerning definedness of the procedure.
 They can be
 solved in a uniform fashion. Thats why we have created the method
 \<open>hoare_rule\<close>, which behaves like the method \<open>rule\<close> but automatically
 tries to solve the side-conditions.
 \<close>
 
 subsubsection \<open>Odd and Even\<close>
 
 text \<open>Odd and even are defined mutually recursive here. In the
 \<open>procedures\<close> command we conjoin both definitions with \<open>and\<close>.
 \<close>
 
 procedures
  odd(N | A) = "IF \<acute>N=0 THEN \<acute>A:==0
                      ELSE IF \<acute>N=1 THEN CALL even (\<acute>N - 1,\<acute>A)
                           ELSE CALL odd (\<acute>N - 2,\<acute>A)
                           FI
                      FI"
 
 
 and
   even(N | A) = "IF \<acute>N=0 THEN \<acute>A:==1
                         ELSE IF \<acute>N=1 THEN CALL odd (\<acute>N - 1,\<acute>A)
                              ELSE CALL even (\<acute>N - 2,\<acute>A)
                              FI
                         FI"
 
 print_theorems
 thm odd_body.odd_body_def
 thm even_body.even_body_def
 print_locale odd_even_clique
 
 
 text \<open>To prove the procedure calls to @{term "odd"} respectively
 @{term "even"} correct we first derive a rule to justify that we
 can assume both specifications to verify the bodies. This rule can
 be derived from the general @{thm [source] HoarePartial.ProcRec} rule. An ML function does
 this work:
 \<close>
 
 ML \<open>ML_Thms.bind_thm ("ProcRec2", Hoare.gen_proc_rec @{context} Hoare.Partial 2)\<close>
 
 
 lemma (in odd_even_clique)
   shows odd_spec: "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N=n\<rbrace> \<acute>A :== PROC odd(\<acute>N)
                   \<lbrace>(\<exists>b. n = 2 * b + \<acute>A) \<and> \<acute>A < 2 \<rbrace>" (is ?P1)
    and even_spec: "\<forall>n. \<Gamma>\<turnstile>\<lbrace>\<acute>N=n\<rbrace> \<acute>A :== PROC even(\<acute>N)
                   \<lbrace>(\<exists>b. n + 1 = 2 * b + \<acute>A) \<and> \<acute>A < 2 \<rbrace>" (is ?P2)
 proof -
   have "?P1 \<and> ?P2"
     apply (hoare_rule ProcRec2)
     apply  vcg
     apply  clarsimp
     apply  (rule_tac x="b + 1" in exI)
     apply  arith
     apply vcg
     apply clarsimp
     apply arith
     done
   thus "?P1" "?P2"
     by iprover+
 qed
 
 subsection \<open>Expressions With Side Effects\<close>
 
 
 text \<open>\texttt{R := N++ + M++}\<close>
 lemma "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
   \<acute>N \<ggreater> n. \<acute>N :== \<acute>N + 1 \<ggreater>
   \<acute>M \<ggreater> m. \<acute>M :== \<acute>M + 1 \<ggreater>
   \<acute>R :== n + m
   \<lbrace>\<acute>R = \<acute>N + \<acute>M - 2\<rbrace>"
 apply vcg
 apply simp
 done
 
 text \<open>\texttt{R := Fac (N) + Fac (M)}\<close>
 lemma (in Fac_impl) shows
   "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
   CALL Fac(\<acute>N) \<ggreater> n. CALL Fac(\<acute>M) \<ggreater> m.
   \<acute>R :== n + m
   \<lbrace>\<acute>R = fac \<acute>N + fac \<acute>M\<rbrace>"
 apply vcg
 done
 
 
 text \<open>\texttt{ R := (Fac(Fac (N)))}\<close>
 lemma (in Fac_impl) shows
   "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
   CALL Fac(\<acute>N) \<ggreater> n. CALL Fac(n) \<ggreater> m.
   \<acute>R :== m
   \<lbrace>\<acute>R = fac (fac \<acute>N)\<rbrace>"
 apply vcg
 done
 
 
 subsection \<open>Global Variables and Heap\<close>
 
 
 text \<open>
 Now we define and verify some procedures on heap-lists. We consider
 list structures consisting of two fields, a content element @{term "cont"} and
 a reference to the next list element @{term "next"}. We model this by the
 following state space where every field has its own heap.
 \<close>
 
 record globals_list =
   next_' :: "ref \<Rightarrow> ref"
   cont_' :: "ref \<Rightarrow> nat"
 
 record 'g list_vars = "'g state" +
   p_'    :: "ref"
   q_'    :: "ref"
   r_'    :: "ref"
   root_' :: "ref"
   tmp_'  :: "ref"
 
 text \<open>Updates to global components inside a procedure will
 always be propagated to the caller. This is implicitly done by the
 parameter passing syntax translations. The record containing the global variables must begin with the prefix "globals".
 \<close>
 
 text \<open>We first define an append function on lists. It takes two
 references as parameters. It appends the list referred to by the first
 parameter with the list referred to by the second parameter, and returns
 the result right into the first parameter.
 \<close>
 
 procedures
   append(p,q|p) =
     "IF \<acute>p=Null THEN \<acute>p :== \<acute>q ELSE \<acute>p \<rightarrow>\<acute>next:== CALL append(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"
 
 (*
   append_spec:
    "\<forall>\<sigma> Ps Qs.
      \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
            \<acute>p :== PROC append(\<acute>p,\<acute>q)
          \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 
   append_modifies:
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC append(\<acute>p,\<acute>q){t. t may_only_modify_globals \<sigma> in [next]}"
 *)
 
 context append_impl
 begin
 declare [[hoare_use_call_tr' = false]]
 term "CALL append(\<acute>p,\<acute>q,\<acute>p\<rightarrow>\<acute>next)"
 declare [[hoare_use_call_tr' = true]]
 end
 text \<open>Below we give two specifications this time.
 One captures the functional behaviour and focuses on the
 entities that are potentially modified by the procedure, the other one
 is a pure frame condition.
 The list in the modifies clause has to list all global state components that
 may be changed by the procedure. Note that we know from the modifies clause
 that the @{term cont} parts of the lists will not be changed. Also a small
 side note on the syntax. We use ordinary brackets in the postcondition
 of the modifies clause, and also the state components do not carry the
 acute, because we explicitly note the state @{term t} here.
 
 The functional specification now introduces two logical variables besides the
 state space variable @{term "\<sigma>"}, namely @{term "Ps"} and @{term "Qs"}.
 They are universally quantified and range over both the pre and the postcondition, so
 that we are able to properly instantiate the specification
 during the proofs. The syntax \<open>\<lbrace>\<sigma>. \<dots>\<rbrace>\<close> is a shorthand to fix the current
 state: \<open>{s. \<sigma> = s \<dots>}\<close>.
 \<close>
 
 lemma (in append_impl) append_spec:
   shows "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>
             \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
                 \<acute>p :== PROC append(\<acute>p,\<acute>q)
             \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply fastforce
   done
 
 
 text \<open>The modifies clause is equal to a proper record update specification
 of the following form.
 \<close>
 
 
 lemma "{t. t may_only_modify_globals Z in [next]}
        =
        {t. \<exists>next. globals t=next_'_update (\<lambda>_. next) (globals Z)}"
   apply (unfold mex_def meq_def)
   apply (simp)
   done
 
 text \<open>If the verification condition generator works on a procedure call
 it checks whether it can find a modified clause in the context. If one
 is present the procedure call is simplified before the Hoare rule
 @{thm [source] HoarePartial.ProcSpec} is applied. Simplification of the procedure call means,
 that the ``copy back'' of the global components is simplified. Only those
 components that occur in the modifies clause will actually be copied back.
 This simplification is justified by the rule @{thm [source] HoarePartial.ProcModifyReturn}.
 So after this simplification all global components that do not appear in
 the modifies clause will be treated as local variables.
 \<close>
 
 text \<open>You can study the effect of the modifies clause on the following two
 examples, where we want to prove that @{term "append"} does not change
 the @{term "cont"} part of the heap.
 \<close>
 
 lemma (in append_impl)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>p=Null \<and> \<acute>cont=c\<rbrace> \<acute>p :== CALL append(\<acute>p,Null) \<lbrace>\<acute>cont=c\<rbrace>"
   apply vcg
   oops
 
 text \<open>To prove the frame condition,
 we have to tell the verification condition generator to use only the
 modifies clauses and not to search for functional specifications by
 the parameter \<open>spec=modifies\<close> It will also try to solve the
 verification conditions automatically.
 \<close>
 
 lemma (in append_impl) append_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC append(\<acute>p,\<acute>q){t. t may_only_modify_globals \<sigma> in [next]}"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (vcg spec=modifies)
   done
 
 
 lemma (in append_impl)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>p=Null \<and> \<acute>cont=c\<rbrace> \<acute>p\<rightarrow>\<acute>next :== CALL append(\<acute>p,Null) \<lbrace>\<acute>cont=c\<rbrace>"
   apply vcg
   apply simp
   done
 
 text \<open>
 Of course we could add the modifies clause to the functional specification as
 well. But separating both has the advantage that we split up the verification
 work. We can make use of the modifies clause before we apply the
 functional specification in a fully automatic fashion.
 \<close>
 
 
 text \<open>To verify the body of @{term "append"} we do not need the modifies
 clause, since the specification does not talk about @{term "cont"} at all, and
 we don't access @{term "cont"} inside the body. This may be different for
 more complex procedures.
 \<close>
 
 text \<open>
 To prove that a procedure respects the modifies clause, we only need
 the modifies clauses of the procedures called in the body. We do not need
 the functional specifications. So we can always prove the modifies
 clause without functional specifications, but me may need the modifies
 clause to prove the functional specifications.
 \<close>
 
 
 
 
 
 
 
 
 subsubsection \<open>Insertion Sort\<close>
 
 primrec sorted:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list  \<Rightarrow> bool"
 where
 "sorted le [] = True" |
 "sorted le (x#xs) = ((\<forall>y\<in>set xs. le x y) \<and> sorted le xs)"
 
 
 
 procedures
   insert(r,p | p) =
     "IF \<acute>r=Null THEN SKIP
      ELSE IF \<acute>p=Null THEN \<acute>p :== \<acute>r;; \<acute>p\<rightarrow>\<acute>next :== Null
           ELSE IF \<acute>r\<rightarrow>\<acute>cont \<le> \<acute>p\<rightarrow>\<acute>cont
                THEN \<acute>r\<rightarrow>\<acute>next :== \<acute>p;; \<acute>p:==\<acute>r
                ELSE \<acute>p\<rightarrow>\<acute>next :== CALL insert(\<acute>r,\<acute>p\<rightarrow>\<acute>next)
                FI
           FI
      FI"
 
 
 text \<open>
 In the postcondition of the functional specification there is a small but
 important subtlety. Whenever we talk about the @{term "cont"} part we refer to
 the one of the pre-state, even in the conclusion of the implication.
 The reason is, that we have separated out, that @{term "cont"} is not modified
 by the procedure, to the modifies clause. So whenever we talk about unmodified
 parts in the postcondition we have to use the pre-state part, or explicitly
 state an equality in the postcondition.
 The reason is simple. If the postcondition would talk about \<open>\<acute>cont\<close>
 instead of \<open>\<^bsup>\<sigma>\<^esup>cont\<close>, we get a new instance of \<open>cont\<close> during
 verification and the postcondition would only state something about this
 new instance. But as the verification condition generator uses the
 modifies clause the caller of \<open>insert\<close> instead still has the
 old \<open>cont\<close> after the call. Thats the very reason for the modifies clause.
 So the caller and the specification will simply talk about two different things,
 without being able to relate them (unless an explicit equality is added to
 the specification).
 \<close>
 
 lemma (in insert_impl) insert_modifies:
   "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC insert(\<acute>r,\<acute>p){t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (vcg spec=modifies)
 done
 
 
 lemma (in insert_impl) insert_spec:
     "\<forall>\<sigma> Ps . \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and> sorted (\<le>) (map \<acute>cont Ps) \<and>
                   \<acute>r \<noteq> Null \<and> \<acute>r \<notin> set Ps\<rbrace>
          \<acute>p :== PROC insert(\<acute>r,\<acute>p)
    \<lbrace>\<exists>Qs. List \<acute>p \<acute>next Qs \<and> sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont  Qs) \<and>
            set Qs = insert \<^bsup>\<sigma>\<^esup>r (set Ps) \<and>
            (\<forall>x. x \<notin> set Qs \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 
 apply (hoare_rule HoarePartial.ProcRec1)
 apply vcg
 apply (intro conjI impI)
 apply    fastforce
 apply   fastforce
 apply  fastforce
 apply (clarsimp)
 apply force
 done
 
 procedures
   insertSort(p | p) =
     "\<acute>r:==Null;;
      WHILE (\<acute>p \<noteq> Null) DO
        \<acute>q :== \<acute>p;;
        \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
        \<acute>r :== CALL insert(\<acute>q,\<acute>r)
      OD;;
      \<acute>p:==\<acute>r"
 
 
 
 
 lemma (in insertSort_impl) insertSort_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC insertSort(\<acute>p)
               {t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (vcg spec=modifies)
 done
 
 
 text \<open>Insertion sort is not implemented recursively here but with a while
 loop. Note that the while loop is not annotated with an invariant in the
 procedure definition. The invariant only comes into play during verification.
 Therefore we will annotate the body during the proof with the
 rule @{thm [source] HoarePartial.annotateI}.
 \<close>
 
 
 lemma (in insertSort_impl) insertSort_body_spec:
   shows "\<forall>\<sigma> Ps. \<Gamma>,\<Theta>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<rbrace>
               \<acute>p :== PROC insertSort(\<acute>p)
           \<lbrace>\<exists>Qs. List \<acute>p \<acute>next Qs \<and> sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont Qs) \<and>
            set Qs = set Ps\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (hoare_rule anno=
          "\<acute>r :== Null;;
          WHILE \<acute>p \<noteq> Null
          INV \<lbrace>\<exists>Qs Rs. List \<acute>p \<acute>next Qs \<and> List \<acute>r \<acute>next Rs \<and>
                   set Qs \<inter> set Rs = {} \<and>
                   sorted (\<le>) (map \<acute>cont Rs) \<and> set Qs \<union> set Rs = set Ps \<and>
                   \<acute>cont = \<^bsup>\<sigma>\<^esup>cont \<rbrace>
           DO \<acute>q :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;; \<acute>r :== CALL insert(\<acute>q,\<acute>r) OD;;
           \<acute>p :== \<acute>r" in HoarePartial.annotateI)
   apply vcg
   apply   fastforce
   prefer 2
   apply  fastforce
   apply (clarsimp)
   apply (rule_tac x=ps in exI)
   apply (intro conjI)
   apply    (rule heap_eq_ListI1)
   apply     assumption
   apply    clarsimp
   apply    (subgoal_tac "x\<noteq>p \<and> x \<notin> set Rs")
   apply     auto
   done
 
 subsubsection "Memory Allocation and Deallocation"
 
 text \<open>The basic idea of memory management is to keep a list of allocated
 references in the state space. Allocation of a new reference adds a
 new reference to the list deallocation removes a reference. Moreover
 we keep a counter "free" for the free memory.
 \<close>
 
 record globals_list_alloc = globals_list +
   alloc_'::"ref list"
   free_'::nat
 
 record 'g list_vars' = "'g list_vars" +
   i_'::nat
   first_'::ref
 
 
 definition "sz = (2::nat)"
 
 text \<open>Restrict locale \<open>hoare\<close> to the required type.\<close>
 
 locale hoare_ex =
   hoare \<Gamma> for \<Gamma> :: "'c \<rightharpoonup> (('a globals_list_alloc_scheme, 'b) list_vars'_scheme, 'c, 'd) com"
 
 lemma (in hoare_ex)
   "\<Gamma>\<turnstile> \<lbrace>\<acute>i = 0 \<and> \<acute>first = Null \<and> n*sz \<le> \<acute>free\<rbrace>
        WHILE \<acute>i < n
        INV \<lbrace>\<exists>Ps. List \<acute>first \<acute>next Ps \<and> length Ps = \<acute>i \<and> \<acute>i \<le> n \<and>
              set Ps \<subseteq> set \<acute>alloc \<and> (n - \<acute>i)*sz \<le> \<acute>free\<rbrace>
        DO
          \<acute>p :== NEW sz [\<acute>cont:==0,\<acute>next:== Null];;
          \<acute>p\<rightarrow>\<acute>next :== \<acute>first;;
          \<acute>first :== \<acute>p;;
          \<acute>i :== \<acute>i+ 1
        OD
        \<lbrace>\<exists>Ps. List \<acute>first \<acute>next  Ps \<and> length Ps = n \<and> set Ps \<subseteq> set \<acute>alloc\<rbrace>"
 
 apply (vcg)
 apply   simp
 apply  clarsimp
 apply  (rule conjI)
 apply   clarsimp
 apply   (rule_tac x="new (set alloc)#Ps" in exI)
 apply   clarsimp
 apply   (rule conjI)
 apply    fastforce
 apply   (simp add: sz_def)
 apply  (simp add: sz_def)
 apply fastforce
 done
 
 
 lemma (in hoare_ex)
   "\<Gamma>\<turnstile> \<lbrace>\<acute>i = 0 \<and> \<acute>first = Null \<and> n*sz \<le> \<acute>free\<rbrace>
        WHILE \<acute>i < n
        INV \<lbrace>\<exists>Ps. List \<acute>first \<acute>next Ps \<and> length Ps = \<acute>i \<and> \<acute>i \<le> n \<and>
              set Ps \<subseteq> set \<acute>alloc \<and> (n - \<acute>i)*sz \<le> \<acute>free\<rbrace>
        DO
          \<acute>p :== NNEW sz [\<acute>cont:==0,\<acute>next:== Null];;
          \<acute>p\<rightarrow>\<acute>next :== \<acute>first;;
          \<acute>first :== \<acute>p;;
          \<acute>i :== \<acute>i+ 1
        OD
        \<lbrace>\<exists>Ps. List \<acute>first \<acute>next  Ps \<and> length Ps = n \<and> set Ps \<subseteq> set \<acute>alloc\<rbrace>"
 
 apply (vcg)
 apply   simp
 apply  clarsimp
 apply  (rule conjI)
 apply   clarsimp
 apply   (rule_tac x="new (set alloc)#Ps" in exI)
 apply   clarsimp
 apply   (rule conjI)
 apply    fastforce
 apply   (simp add: sz_def)
 apply  (simp add: sz_def)
 apply fastforce
 done
 
 subsection \<open>Fault Avoiding Semantics\<close>
 
 text \<open>
 If we want to ensure that no runtime errors occur we can insert guards into
 the code. We will not be able to prove any nontrivial Hoare triple
 about code with guards, if we cannot show that the guards will never fail.
 A trivial hoare triple is one with an empty precondition.
 \<close>
 
 
 lemma "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>  \<lbrace>\<acute>p\<noteq>Null\<rbrace>\<longmapsto> \<acute>p\<rightarrow>\<acute>next :== \<acute>p \<lbrace>True\<rbrace>"
 apply vcg
 oops
 
 lemma "\<Gamma>\<turnstile> {}  \<lbrace>\<acute>p\<noteq>Null\<rbrace>\<longmapsto> \<acute>p\<rightarrow>\<acute>next :== \<acute>p \<lbrace>True\<rbrace>"
 apply vcg
 done
 
 text \<open>Let us consider this small program that reverts a list. At
 first without guards.
 \<close>
 lemma (in hoare_ex) rev_strip:
   "\<Gamma>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
   \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps\<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 apply (vcg)
 apply fastforce+
 done
 
 text \<open>If we want to ensure that we do not dereference @{term "Null"} or
 access unallocated memory, we have to add some guards.
 \<close>
 
 locale hoare_ex_guard =
   hoare \<Gamma> for \<Gamma> :: "'c \<rightharpoonup> (('a globals_list_alloc_scheme, 'b) list_vars'_scheme, 'c, bool) com"
 
 lemma
   (in hoare_ex_guard)
   "\<Gamma>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
  \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 apply (vcg)
 apply fastforce+
 done
 
 
 text \<open>We can also just prove that no faults will occur, by giving the
 trivial postcondition.
 \<close>
 lemma (in hoare_ex_guard) rev_noFault:
   "\<Gamma>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
   UNIV,UNIV"
 apply (vcg)
 apply fastforce+
 done
 
 lemma (in hoare_ex_guard) rev_moduloGuards:
   "\<Gamma>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<surd> \<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<surd> \<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
  \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 apply vcg
 apply fastforce+
 done
 
 
 
 
 lemma CombineStrip':
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c' Q,A"
   assumes deriv_strip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
   assumes c'': "c''= mark_guards False (strip_guards (-F) c')"
   assumes c: "c = mark_guards False c'"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 proof -
   from deriv_strip [simplified c'']
   have "\<Gamma>,\<Theta>\<turnstile> P (strip_guards (- F) c') UNIV,UNIV"
     by (rule HoarePartialProps.MarkGuardsD)
   with deriv
   have "\<Gamma>,\<Theta>\<turnstile> P c' Q,A"
     by (rule HoarePartialProps.CombineStrip)
   hence "\<Gamma>,\<Theta>\<turnstile> P mark_guards False c' Q,A"
     by (rule HoarePartialProps.MarkGuardsI)
   thus ?thesis
     by (simp add: c)
 qed
 
 
 text \<open>We can then combine the prove that no fault will occur with the
 functional proof of the programme without guards to get the full prove by
 the rule @{thm HoarePartialProps.CombineStrip}
 \<close>
 
 
 lemma
   (in hoare_ex_guard)
   "\<Gamma>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
  \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 
 apply (rule CombineStrip' [OF rev_moduloGuards rev_noFault])
 apply  simp
 apply simp
 done
 
 
 text \<open>In the previous example the effort to split up the prove did not
 really pay off. But when we think of programs with a lot of guards and
 complicated specifications it may be better to first focus on a prove without
 the messy guards. Maybe it is possible to automate the no fault proofs so
 that it suffices to focus on the stripped program.
 \<close>
 
 
 text \<open>
 The purpose of guards is to watch for faults that can occur during
 evaluation of expressions. In the example before we watched for null pointer
 dereferencing or memory faults. We can also look for array index bounds or
 division by zero. As the condition of a while loop is evaluated in each
 iteration we cannot just add a guard before the while loop. Instead we need
 a special guard for the condition.
 Example: @{term "WHILE  \<lbrace>\<acute>p\<noteq>Null\<rbrace>\<longmapsto> \<acute>p\<rightarrow>\<acute>next\<noteq>Null DO SKIP OD"}
 \<close>
 
 subsection \<open>Circular Lists\<close>
 definition
   distPath :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref \<Rightarrow> ref list \<Rightarrow> bool" where
   "distPath x next y as = (Path x next y as  \<and>  distinct as)"
 
 lemma neq_dP: "\<lbrakk>p \<noteq> q; Path p h q Ps; distinct Ps\<rbrakk> \<Longrightarrow>
  \<exists>Qs. p\<noteq>Null \<and> Ps = p#Qs \<and> p \<notin> set Qs"
 by (cases Ps, auto)
 
 lemma circular_list_rev_I:
   "\<Gamma>\<turnstile> \<lbrace>\<acute>root = r \<and>  distPath \<acute>root \<acute>next \<acute>root (r#Ps)\<rbrace>
    \<acute>p :== \<acute>root;; \<acute>q :== \<acute>root\<rightarrow>\<acute>next;;
   WHILE \<acute>q \<noteq> \<acute>root
   INV \<lbrace>\<exists> ps qs. distPath \<acute>p \<acute>next \<acute>root ps  \<and> distPath \<acute>q \<acute>next \<acute>root qs \<and>
              \<acute>root = r \<and> r\<noteq>Null \<and> r \<notin> set Ps  \<and> set ps \<inter> set qs = {} \<and>
              Ps = (rev ps) @ qs \<rbrace>
   DO \<acute>tmp :== \<acute>q;; \<acute>q :== \<acute>q\<rightarrow>\<acute>next;; \<acute>tmp\<rightarrow>\<acute>next :== \<acute>p;; \<acute>p:==\<acute>tmp OD;;
   \<acute>root\<rightarrow>\<acute>next :== \<acute>p
   \<lbrace>\<acute>root = r \<and> distPath \<acute>root \<acute>next \<acute>root (r#rev Ps)\<rbrace>"
 apply (simp only:distPath_def)
 apply vcg
 apply   (rule_tac x="[]" in exI)
 apply   fastforce
 apply  clarsimp
 apply  (drule (2) neq_dP)
 apply  (rule_tac x="q # ps" in exI)
 apply  clarsimp
 apply fastforce
 done
 
 
 
 lemma path_is_list:"\<And>a next b. \<lbrakk>Path b next a Ps ; a \<notin> set Ps; a\<noteq>Null\<rbrakk>
 \<Longrightarrow> List b (next(a := Null)) (Ps @ [a])"
 apply (induct Ps)
 apply (auto simp add:fun_upd_apply)
 done
 
 text \<open>
 The simple algorithm for acyclic list reversal, with modified
 annotations, works for cyclic lists as well.:
 \<close>
 
 lemma circular_list_rev_II:
  "\<Gamma>\<turnstile>
  \<lbrace>\<acute>p = r \<and> distPath \<acute>p \<acute>next \<acute>p (r#Ps)\<rbrace>
 \<acute>q:==Null;;
 WHILE \<acute>p \<noteq> Null
 INV
  \<lbrace> ((\<acute>q = Null) \<longrightarrow> (\<exists>ps. distPath \<acute>p \<acute>next r ps  \<and>  ps = r#Ps)) \<and>
   ((\<acute>q \<noteq> Null) \<longrightarrow> (\<exists>ps qs. distPath \<acute>q \<acute>next r qs  \<and> List \<acute>p \<acute>next ps  \<and>
                    set ps \<inter> set qs = {} \<and> rev qs @ ps = Ps@[r])) \<and>
   \<not> (\<acute>p = Null \<and> \<acute>q = Null \<and> r = Null )
    \<rbrace>
 DO
   \<acute>tmp :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;; \<acute>tmp\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q:==\<acute>tmp
 OD
  \<lbrace>\<acute>q = r \<and> distPath \<acute>q \<acute>next \<acute>q (r # rev Ps)\<rbrace>"
 
 apply (simp only:distPath_def)
 apply vcg
 apply   clarsimp
 apply  clarsimp
 apply  (case_tac "(q = Null)")
 apply   (fastforce intro: path_is_list)
 apply  clarify
 apply  (rule_tac x="psa" in exI)
 apply  (rule_tac x=" p # qs" in exI)
 apply  force
 apply fastforce
 done
 
 text\<open>Although the above algorithm is more succinct, its invariant
 looks more involved. The reason for the case distinction on @{term q}
 is due to the fact that during execution, the pointer variables can
 point to either cyclic or acyclic structures.
 \<close>
 
 text \<open>
 When working on lists, its sometimes better to remove
 @{thm[source] fun_upd_apply} from the simpset, and instead include @{thm[source] fun_upd_same} and @{thm[source] fun_upd_other} to
 the simpset
 \<close>
 
 (*
 declare fun_upd_apply[simp del]fun_upd_same[simp] fun_upd_other[simp]
 *)
 
 
 lemma "\<Gamma>\<turnstile> {\<sigma>}
             \<acute>I :== \<acute>M;;
             ANNO \<tau>. \<lbrace>\<tau>. \<acute>I = \<^bsup>\<sigma>\<^esup>M\<rbrace>
                       \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
                     \<lbrace>\<acute>M = \<^bsup>\<tau>\<^esup>N \<and> \<acute>N = \<^bsup>\<tau>\<^esup>I\<rbrace>
             \<lbrace>\<acute>M = \<^bsup>\<sigma>\<^esup>N \<and> \<acute>N = \<^bsup>\<sigma>\<^esup>M\<rbrace>"
 apply vcg
 apply auto
 done
 
 
 lemma "\<Gamma>\<turnstile> ({\<sigma>} \<inter> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>)
       (ANNO \<tau>. ({\<tau>} \<inter> \<lbrace>\<acute>A=\<^bsup>\<sigma>\<^esup>A \<and> \<acute>I=\<^bsup>\<sigma>\<^esup>I \<and> \<acute>M=0 \<and> \<acute>S=0\<rbrace>)
       WHILE \<acute>M \<noteq> \<acute>A
       INV \<lbrace>\<acute>S = \<acute>M * \<acute>I \<and> \<acute>A=\<^bsup>\<tau>\<^esup>A \<and> \<acute>I=\<^bsup>\<tau>\<^esup>I\<rbrace>
       DO \<acute>S :== \<acute>S + \<acute>I;; \<acute>M :== \<acute>M + 1 OD
       \<lbrace>\<acute>S = \<^bsup>\<tau>\<^esup>A * \<^bsup>\<tau>\<^esup>I\<rbrace>)
       \<lbrace>\<acute>S = \<^bsup>\<sigma>\<^esup>A * \<^bsup>\<sigma>\<^esup>I\<rbrace>"
 apply vcg_step
 apply vcg_step
 apply simp
 apply vcg_step
 apply vcg_step
 apply simp
 apply vcg
 apply simp
 apply simp
 apply vcg_step
 apply auto
 done
 
 text \<open>Instead of annotations one can also directly use previously proven lemmas.\<close>
 lemma foo_lemma: "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace> \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
                      \<lbrace>\<acute>N = n + 1 \<and> \<acute>M = m + 1\<rbrace>"
   by vcg
 
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace> LEMMA foo_lemma
                                \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
                              END;;
                              \<acute>N :== \<acute>N + 1
            \<lbrace>\<acute>N = n + 2 \<and> \<acute>M = m + 1\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace>
            LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END;;
            LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END
            \<lbrace>\<acute>N = n + 2 \<and> \<acute>M = m + 2\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>N = n \<and> \<acute>M = m\<rbrace>
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1;;
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            \<lbrace>\<acute>N = n + 2 \<and> \<acute>M = m + 2\<rbrace>"
   apply (hoare_rule anno=
           "LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END;;
            LEMMA foo_lemma
               \<acute>N :== \<acute>N + 1;; \<acute>M :== \<acute>M + 1
            END"
           in HoarePartial.annotate_normI)
   apply vcg
   apply simp
   done
 
 text \<open>Just some test on marked, guards\<close>
 lemma "\<Gamma>\<turnstile>\<lbrace>True\<rbrace> WHILE \<lbrace>P \<acute>N \<rbrace>\<surd>, \<lbrace>Q \<acute>M\<rbrace>#, \<lbrace>R \<acute>N\<rbrace>\<longmapsto> \<acute>N < \<acute>M
                     INV \<lbrace>\<acute>N < 2\<rbrace> DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 apply vcg
 oops
 
 lemma "\<Gamma>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>True\<rbrace> WHILE \<lbrace>P \<acute>N \<rbrace>\<surd>, \<lbrace>Q \<acute>M\<rbrace>#, \<lbrace>R \<acute>N\<rbrace>\<longmapsto> \<acute>N < \<acute>M
                     INV \<lbrace>\<acute>N < 2\<rbrace> DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 apply vcg
 oops
 
 
 
 term "\<Gamma>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>True\<rbrace> WHILE\<^sub>g  \<acute>N < \<acute>Arr!i
                     FIX Z.
                     INV \<lbrace>\<acute>N < 2\<rbrace>
 
                   DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 
 lemma "\<Gamma>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>True\<rbrace> WHILE\<^sub>g  \<acute>N < \<acute>Arr!i
                     FIX Z.
                     INV \<lbrace>\<acute>N < 2\<rbrace>
                     VAR arbitrary
                   DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 apply vcg
 oops
 
 lemma "\<Gamma>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>True\<rbrace> WHILE \<lbrace>P \<acute>N \<rbrace>\<surd>, \<lbrace>Q \<acute>M\<rbrace>#, \<lbrace>R \<acute>N\<rbrace>\<longmapsto> \<acute>N < \<acute>M
                     FIX Z.
                     INV \<lbrace>\<acute>N < 2\<rbrace>
                     VAR arbitrary
                   DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 apply vcg
 oops
 
 end
diff --git a/thys/Simpl/ex/VcgExSP.thy b/thys/Simpl/ex/VcgExSP.thy
--- a/thys/Simpl/ex/VcgExSP.thy
+++ b/thys/Simpl/ex/VcgExSP.thy
@@ -1,1388 +1,1367 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      VcgEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
-
-Copyright (C) 2004-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
 
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
 *)
 
 section \<open>Examples using Statespaces\<close>
 
 theory VcgExSP imports "../HeapList" "../Vcg" begin
 
 
 subsection \<open>State Spaces\<close>
 
 text \<open>
  First of all we provide a store of program variables that
  occur in the programs considered later.  Slightly unexpected
  things may happen when attempting to work with undeclared variables.
 \<close>
 
 
 hoarestate state_space =
   A :: nat
   I :: nat
   M :: nat
   N :: nat
   R :: nat
   S :: nat
   B :: bool
   Abr:: string
 
 lemma (in state_space)"\<Gamma>\<turnstile> \<lbrace>\<acute>N = n\<rbrace> LOC \<acute>N :== 10;; \<acute>N :== \<acute>N + 2 COL \<lbrace>\<acute>N = n\<rbrace>"
   by vcg
 
 text \<open>Internally we decorate the state components in the statespace with the
 suffix \<open>_'\<close>,
 to avoid cluttering the namespace with the simple names that could no longer
 be used for logical variables otherwise.
 \<close>
 
 text \<open>We will first consider programs without procedures, later on
 we will regard procedures without global variables and finally we
 will get the full pictures: mutually recursive procedures with global
 variables (including heap).
 \<close>
 
 subsection \<open>Basic Examples\<close>
 
 text \<open>
  We look at few trivialities involving assignment and sequential
  composition, in order to get an idea of how to work with our
  formulation of Hoare Logic.
 \<close>
 
 text \<open>
  Using the basic rule directly is a bit cumbersome.
 \<close>
 
 lemma (in state_space) "\<Gamma>\<turnstile> {|\<acute>N = 5|} \<acute>N :== 2 * \<acute>N {|\<acute>N = 10|}"
   apply (rule HoarePartial.Basic)
   apply simp
   done
 
 lemma (in state_space) "\<Gamma>\<turnstile> \<lbrace>True\<rbrace> \<acute>N :== 10 \<lbrace>\<acute>N = 10\<rbrace>"
   by vcg
 
 lemma (in state_space) "\<Gamma>\<turnstile> \<lbrace>2 * \<acute>N = 10\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   by vcg
 
 lemma (in state_space) "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> \<acute>N :== 2 * \<acute>N \<lbrace>\<acute>N = 10\<rbrace>"
   apply vcg
   apply simp
   done
 
 lemma (in state_space) "\<Gamma>\<turnstile> \<lbrace>\<acute>N + 1 = a + 1\<rbrace> \<acute>N :== \<acute>N + 1 \<lbrace>\<acute>N = a + 1\<rbrace>"
   by vcg
 
 lemma (in state_space) "\<Gamma>\<turnstile> \<lbrace>\<acute>N = a\<rbrace> \<acute>N :== \<acute>N + 1 \<lbrace>\<acute>N = a + 1\<rbrace>"
   apply vcg
   apply simp
   done
 
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>a = a \<and> b = b\<rbrace> \<acute>M :== a;; \<acute>N :== b \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>"
   by vcg
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>True\<rbrace> \<acute>M :== a;; \<acute>N :== b \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>"
   by vcg
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>
                 \<acute>I :== \<acute>M;; \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
               \<lbrace>\<acute>M = b \<and> \<acute>N = a\<rbrace>"
   apply vcg
   apply simp
   done
 
 text \<open>
 We can also perform verification conditions generation step by step by using
 the \<open>vcg_step\<close> method.
 \<close>
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = a \<and> \<acute>N = b\<rbrace>
                \<acute>I :== \<acute>M;; \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
               \<lbrace>\<acute>M = b \<and> \<acute>N = a\<rbrace>"
   apply vcg_step
   apply vcg_step
   apply vcg_step
   apply vcg_step
   apply simp
   done
 
 
 text \<open>
  In the following assignments we make use of the consequence rule in
  order to achieve the intended precondition.  Certainly, the
  \<open>vcg\<close> method is able to handle this case, too.
 \<close>
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
 proof -
   have "\<lbrace>\<acute>M = \<acute>N\<rbrace> \<subseteq> \<lbrace>\<acute>M + 1 \<noteq> \<acute>N\<rbrace>"
     by auto
   also have "\<Gamma>\<turnstile> \<dots> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
     by vcg
   finally show ?thesis .
 qed
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
 proof -
   have "\<And>m n::nat. m = n \<longrightarrow> m + 1 \<noteq> n"
       \<comment> \<open>inclusion of assertions expressed in ``pure'' logic,\<close>
       \<comment> \<open>without mentioning the state space\<close>
     by simp
   also have "\<Gamma>\<turnstile> \<lbrace>\<acute>M + 1 \<noteq> \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
     by vcg
   finally show ?thesis .
 qed
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = \<acute>N\<rbrace> \<acute>M :== \<acute>M + 1 \<lbrace>\<acute>M \<noteq> \<acute>N\<rbrace>"
   apply vcg
   apply simp
   done
 
 subsection \<open>Multiplication by Addition\<close>
 
 text \<open>
  We now do some basic examples of actual \texttt{WHILE} programs.
  This one is a loop for calculating the product of two natural
  numbers, by iterated addition.  We first give detailed structured
  proof based on single-step Hoare rules.
 \<close>
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
       WHILE \<acute>M \<noteq> a
       DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
       \<lbrace>\<acute>S = a * b\<rbrace>"
 proof -
   let "\<Gamma>\<turnstile> _ ?while _" = ?thesis
   let "\<lbrace>\<acute>?inv\<rbrace>" = "\<lbrace>\<acute>S = \<acute>M * b\<rbrace>"
 
   have "\<lbrace>\<acute>M = 0 & \<acute>S = 0\<rbrace> \<subseteq> \<lbrace>\<acute>?inv\<rbrace>" by auto
   also have "\<Gamma>\<turnstile> \<dots> ?while \<lbrace>\<acute>?inv \<and> \<not> (\<acute>M \<noteq> a)\<rbrace>"
   proof
     let ?c = "\<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1"
     have "\<lbrace>\<acute>?inv \<and> \<acute>M \<noteq> a\<rbrace> \<subseteq> \<lbrace>\<acute>S + b = (\<acute>M + 1) * b\<rbrace>"
       by auto
     also have "\<Gamma>\<turnstile> \<dots> ?c \<lbrace>\<acute>?inv\<rbrace>" by vcg
     finally show "\<Gamma>\<turnstile> \<lbrace>\<acute>?inv \<and> \<acute>M \<noteq> a\<rbrace> ?c \<lbrace>\<acute>?inv\<rbrace>" .
   qed
   also have "\<lbrace>\<acute>?inv \<and> \<not> (\<acute>M \<noteq> a)\<rbrace> \<subseteq> \<lbrace>\<acute>S = a * b\<rbrace>" by auto
   finally show ?thesis by blast
 qed
 
 
 text \<open>
  The subsequent version of the proof applies the \<open>vcg\<close> method
  to reduce the Hoare statement to a purely logical problem that can be
  solved fully automatically.  Note that we have to specify the
  \texttt{WHILE} loop invariant in the original statement.
 \<close>
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           WHILE \<acute>M \<noteq> a
           INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
           DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
   apply vcg
   apply auto
   done
 
 text \<open>Here some examples of ``breaking'' out of a loop\<close>
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           TRY
             WHILE True
             INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
             DO IF \<acute>M = a THEN THROW ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 FI OD
           CATCH
             SKIP
           END
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           TRY
             WHILE True
             INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
             DO IF \<acute>M = a THEN \<acute>Abr :== ''Break'';;THROW
                ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
                FI
             OD
           CATCH
             IF \<acute>Abr = ''Break'' THEN SKIP ELSE Throw FI
           END
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 
 
 
 
 
 
 text \<open>Some more syntactic sugar, the label statement \<open>\<dots> \<bullet> \<dots>\<close> as shorthand
 for the \<open>TRY-CATCH\<close> above, and the \<open>RAISE\<close> for an state-update followed
 by a \<open>THROW\<close>.
 \<close>
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           \<lbrace>\<acute>Abr = ''Break''\<rbrace>\<bullet> WHILE True INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
            DO IF \<acute>M = a THEN RAISE \<acute>Abr :== ''Break''
               ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
               FI
            OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           TRY
             WHILE True
             INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
             DO IF \<acute>M = a THEN RAISE \<acute>Abr :== ''Break''
                ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
                FI
             OD
           CATCH
             IF \<acute>Abr = ''Break'' THEN SKIP ELSE Throw FI
           END
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           \<lbrace>\<acute>Abr = ''Break''\<rbrace> \<bullet> WHILE True
           INV \<lbrace>\<acute>S = \<acute>M * b\<rbrace>
           DO IF \<acute>M = a THEN RAISE \<acute>Abr :== ''Break''
                ELSE \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1
                FI
           OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply auto
 done
 
 text \<open>Blocks\<close>
 
 lemma  (in state_space)
   shows "\<Gamma>\<turnstile>\<lbrace>\<acute>I = i\<rbrace> LOC \<acute>I;; \<acute>I :== 2  COL \<lbrace>\<acute>I \<le> i\<rbrace>"
   apply vcg
   by simp
 
 
 subsection \<open>Summing Natural Numbers\<close>
 
 text \<open>
  We verify an imperative program to sum natural numbers up to a given
  limit.  First some functional definition for proper specification of
  the problem.
 \<close>
 
 primrec
   sum :: "(nat => nat) => nat => nat"
 where
   "sum f 0 = 0"
 | "sum f (Suc n) = f n + sum f n"
 
 syntax
   "_sum" :: "idt => nat => nat => nat"
     ("SUMM _<_. _" [0, 0, 10] 10)
 translations
   "SUMM j<k. b" == "CONST sum (\<lambda>j. b) k"
 
 text \<open>
  The following proof is quite explicit in the individual steps taken,
  with the \<open>vcg\<close> method only applied locally to take care of
  assignment and sequential composition.  Note that we express
  intermediate proof obligation in pure logic, without referring to the
  state space.
 \<close>
 
 theorem (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
            \<acute>S :== 0;; \<acute>I :== 1;;
            WHILE \<acute>I \<noteq> n
            DO
              \<acute>S :== \<acute>S + \<acute>I;;
              \<acute>I :== \<acute>I + 1
            OD
            \<lbrace>\<acute>S = (SUMM j<n. j)\<rbrace>"
   (is "\<Gamma>\<turnstile> _ (_;; ?while) _")
 proof -
   let ?sum = "\<lambda>k. SUMM j<k. j"
   let ?inv = "\<lambda>s i. s = ?sum i"
 
   have "\<Gamma>\<turnstile> \<lbrace>True\<rbrace> \<acute>S :== 0;; \<acute>I :== 1 \<lbrace>?inv \<acute>S \<acute>I\<rbrace>"
   proof -
     have "True \<longrightarrow> 0 = ?sum 1"
       by simp
     also have "\<Gamma>\<turnstile> \<lbrace>\<dots>\<rbrace> \<acute>S :== 0;; \<acute>I :== 1 \<lbrace>?inv \<acute>S \<acute>I\<rbrace>"
       by vcg
     finally show ?thesis .
   qed
   also have "\<Gamma>\<turnstile> \<lbrace>?inv \<acute>S \<acute>I\<rbrace> ?while \<lbrace>?inv \<acute>S \<acute>I \<and> \<not> \<acute>I \<noteq> n\<rbrace>"
   proof
     let ?body = "\<acute>S :== \<acute>S + \<acute>I;; \<acute>I :== \<acute>I + 1"
     have "\<And>s i. ?inv s i \<and> i \<noteq> n \<longrightarrow>  ?inv (s + i) (i + 1)"
       by simp
     also have "\<Gamma>\<turnstile> \<lbrace>\<acute>S + \<acute>I = ?sum (\<acute>I + 1)\<rbrace> ?body \<lbrace>?inv \<acute>S \<acute>I\<rbrace>"
       by vcg
     finally show "\<Gamma>\<turnstile> \<lbrace>?inv \<acute>S \<acute>I \<and> \<acute>I \<noteq> n\<rbrace> ?body \<lbrace>?inv \<acute>S \<acute>I\<rbrace>" .
   qed
   also have "\<And>s i. s = ?sum i \<and> \<not> i \<noteq> n \<longrightarrow> s = ?sum n"
     by simp
   finally show ?thesis .
 qed
 
 text \<open>
  The next version uses the \<open>vcg\<close> method, while still explaining
  the resulting proof obligations in an abstract, structured manner.
 \<close>
 
 theorem (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
            \<acute>S :== 0;; \<acute>I :== 1;;
            WHILE \<acute>I \<noteq> n
            INV \<lbrace>\<acute>S = (SUMM j<\<acute>I. j)\<rbrace>
            DO
              \<acute>S :== \<acute>S + \<acute>I;;
              \<acute>I :== \<acute>I + 1
            OD
           \<lbrace>\<acute>S = (SUMM j<n. j)\<rbrace>"
 proof -
   let ?sum = "\<lambda>k. SUMM j<k. j"
   let ?inv = "\<lambda>s i. s = ?sum i"
 
   show ?thesis
   proof vcg
     show "?inv 0 1" by simp
   next
     fix i s assume "?inv s i" "i \<noteq> n"
     thus "?inv (s + i) (i + 1)" by simp
   next
     fix i s assume x: "?inv s i" "\<not> i \<noteq> n"
     thus "s = ?sum n" by simp
   qed
 qed
 
 text \<open>
  Certainly, this proof may be done fully automatically as well, provided
  that the invariant is given beforehand.
 \<close>
 
 theorem (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
            \<acute>S :== 0;; \<acute>I :== 1;;
            WHILE \<acute>I \<noteq> n
            INV \<lbrace>\<acute>S = (SUMM j<\<acute>I. j)\<rbrace>
            DO
              \<acute>S :== \<acute>S + \<acute>I;;
              \<acute>I :== \<acute>I + 1
            OD
            \<lbrace>\<acute>S = (SUMM j<n. j)\<rbrace>"
   apply vcg
   apply auto
   done
 
 subsection \<open>SWITCH\<close>
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> SWITCH \<acute>B
                         {True} \<Rightarrow> \<acute>N :== 6
                       | {False} \<Rightarrow> \<acute>N :== 7
                      END
           \<lbrace>\<acute>N > 5\<rbrace>"
 apply vcg
 apply simp
 done
 
 lemma (in state_space)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>N = 5\<rbrace> SWITCH \<acute>N
                         {v. v < 5} \<Rightarrow> \<acute>N :== 6
                       | {v. v \<ge> 5} \<Rightarrow> \<acute>N :== 7
                      END
           \<lbrace>\<acute>N > 5\<rbrace>"
 apply vcg
 apply simp
 done
 
 subsection \<open>(Mutually) Recursive Procedures\<close>
 
 subsubsection \<open>Factorial\<close>
 
 text \<open>We want to define a procedure for the factorial. We first
 define a HOL functions that calculates it to specify the procedure later on.
 \<close>
 
 primrec fac:: "nat \<Rightarrow> nat"
 where
 "fac 0 = 1" |
 "fac (Suc n) = (Suc n) * fac n"
 
 lemma fac_simp [simp]: "0 < i \<Longrightarrow>  fac i = i * fac (i - 1)"
   by (cases i) simp_all
 
 text \<open>Now we define the procedure\<close>
 
 
 procedures
   Fac (N::nat|R::nat)
   "IF \<acute>N = 0 THEN \<acute>R :== 1
    ELSE \<acute>R :== CALL Fac(\<acute>N - 1);;
         \<acute>R :== \<acute>N * \<acute>R
    FI"
 
 print_locale Fac_impl
 
 text \<open>
 To see how a call is syntactically translated you can switch off the
 printing translation via the configuration option \<open>hoare_use_call_tr'\<close>
 \<close>
 
 context Fac_impl
 begin
 text \<open>
 @{term "CALL Fac(\<acute>N,\<acute>R)"} is internally:
 \<close>
 declare [[hoare_use_call_tr' = false]]
 text \<open>
 @{term "CALL Fac(\<acute>N,\<acute>R)"}
 \<close>
 term "CALL Fac(\<acute>N,\<acute>R)"
 declare [[hoare_use_call_tr' = true]]
 
 
 text \<open>
 Now let us prove that @{term "Fac"} meets its specification.
 \<close>
 
 end
 
 
 lemma (in Fac_impl) Fac_spec':
   shows "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>{\<sigma>} PROC Fac(\<acute>N,\<acute>R) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply simp
   done
 
 
 text \<open>
 Since the factorial was implemented recursively,
 the main ingredient of this proof is, to assume that the specification holds for
 the recursive call of @{term Fac} and prove the body correct.
 The assumption for recursive calls is added to the context by
 the rule @{thm [source] HoarePartial.ProcRec1}
 (also derived from general rule for mutually recursive procedures):
 @{thm [display] HoarePartial.ProcRec1 [no_vars]}
 The verification condition generator will infer the specification out of the
 context when it encounters a recursive call of the factorial.
 \<close>
 
 text \<open>We can also step through verification condition generation. When
 the verification condition generator encounters a procedure call it tries to
   use the rule \<open>ProcSpec\<close>. To be successful there must be a specification
 of the procedure in the context.
 \<close>
 
 lemma (in Fac_impl) Fac_spec1:
   shows "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>{\<sigma>} \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg_step
   apply   vcg_step
   apply  vcg_step
   apply vcg_step
   apply vcg_step
   apply simp
   done
 
 
 text \<open>Here some Isar style version of the proof\<close>
 lemma (in Fac_impl) Fac_spec2:
 
   shows "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>{\<sigma>} \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
 proof (hoare_rule HoarePartial.ProcRec1)
   have Fac_spec: "\<forall>\<sigma>. \<Gamma>,(\<Theta>\<union>(\<Union>\<sigma>. {({\<sigma>}, Fac_'proc, \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>,{})}))
                        \<turnstile> {\<sigma>} \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
     apply (rule allI)
     apply (rule hoarep.Asm)
     by simp
   show "\<forall>\<sigma>. \<Gamma>,(\<Theta>\<union>(\<Union>\<sigma>. {({\<sigma>}, Fac_'proc, \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>,{})}))
             \<turnstile> {\<sigma>} IF \<acute>N = 0 THEN \<acute>R :== 1
             ELSE \<acute>R :== CALL Fac(\<acute>N - 1);; \<acute>R :== \<acute>N * \<acute>R FI \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
     apply vcg
     apply simp
     done
 qed
 
 text \<open>To avoid retyping of potentially large pre and postconditions in
 the previous proof we can use the casual term abbreviations of the Isar
 language.
 \<close>
 
 lemma (in Fac_impl) Fac_spec3:
   shows "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>{\<sigma>} \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
   (is "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>(?Pre \<sigma>) ?Fac (?Post \<sigma>)")
 proof (hoare_rule HoarePartial.ProcRec1)
   have Fac_spec: "\<forall>\<sigma>. \<Gamma>,(\<Theta>\<union>(\<Union>\<sigma>. {(?Pre \<sigma>, Fac_'proc, ?Post \<sigma>,{})}))
                        \<turnstile>(?Pre \<sigma>) ?Fac (?Post \<sigma>)"
     apply (rule allI)
     apply (rule hoarep.Asm)
     by simp
   show "\<forall>\<sigma>. \<Gamma>,(\<Theta>\<union>(\<Union>\<sigma>. {(?Pre \<sigma>, Fac_'proc, ?Post \<sigma>,{})}))
             \<turnstile> (?Pre \<sigma>) IF \<acute>N = 0 THEN \<acute>R :== 1
             ELSE \<acute>R :== CALL Fac(\<acute>N - 1);; \<acute>R :== \<acute>N * \<acute>R FI (?Post \<sigma>)"
     apply vcg
     apply simp
     done
 qed
 
 text \<open>The previous proof pattern has still some kind of inconvenience.
 The augmented context is always printed in the proof state. That can
 mess up the state, especially if we have large specifications. This may
 be annoying if we want to develop single step or structured proofs. In this
 case it can be a good idea to introduce a new variable for the augmented
 context.
 \<close>
 
 lemma (in Fac_impl) Fac_spec4:
   shows "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>{\<sigma>} \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac \<^bsup>\<sigma>\<^esup>N\<rbrace>"
   (is "\<forall>\<sigma>. \<Gamma>,\<Theta>\<turnstile>(?Pre \<sigma>) ?Fac (?Post \<sigma>)")
 proof (hoare_rule HoarePartial.ProcRec1)
   define \<Theta>' where "\<Theta>' = \<Theta> \<union> (\<Union>\<sigma>. {(?Pre \<sigma>, Fac_'proc, ?Post \<sigma>,{})})"
   have Fac_spec: "\<forall>\<sigma>. \<Gamma>,\<Theta>'\<turnstile>(?Pre \<sigma>) ?Fac (?Post \<sigma>)"
     by (unfold \<Theta>'_def, rule allI, rule hoarep.Asm) simp
   txt \<open>We have to name the fact \<open>Fac_spec\<close>, so that the vcg can
    use the specification for the recursive call, since it cannot infer it
    from the opaque @{term "\<Theta>'"}.\<close>
   show "\<forall>\<sigma>. \<Gamma>,\<Theta>'\<turnstile> (?Pre \<sigma>) IF \<acute>N = 0 THEN \<acute>R :== 1
             ELSE \<acute>R :== CALL Fac(\<acute>N - 1);; \<acute>R :== \<acute>N * \<acute>R FI (?Post \<sigma>)"
     apply vcg
     apply simp
     done
 qed
 
 text \<open>There are different rules available to prove procedure calls,
 depending on the kind of postcondition and whether or not the
 procedure is recursive or even mutually recursive.
 See for example @{thm [source] HoareTotal.ProcRec1},
 @{thm [source] HoareTotal.ProcNoRec1}.
 They are all derived from the most general rule
 @{thm [source] HoareTotal.ProcRec}.
 All of them have some side-conditions concerning the parameter
 passing protocol and its relation to the pre and postcondition. They can be
 solved in a uniform fashion. Thats why we have created the method
 \<open>hoare_rule\<close>, which behaves like the method \<open>rule\<close> but automatically
 tries to solve the side-conditions.
 \<close>
 
 subsubsection \<open>Odd and Even\<close>
 
 text \<open>Odd and even are defined mutually recursive here. In the
 \<open>procedures\<close> command we conjoin both definitions with \<open>and\<close>.
 \<close>
 
 procedures
  odd(N::nat | A::nat) "IF \<acute>N=0 THEN \<acute>A:==0
                      ELSE IF \<acute>N=1 THEN CALL even (\<acute>N - 1,\<acute>A)
                           ELSE CALL odd (\<acute>N - 2,\<acute>A)
                           FI
                      FI"
 
 and
   even(N::nat | A::nat) "IF \<acute>N=0 THEN \<acute>A:==1
                         ELSE IF \<acute>N=1 THEN CALL odd (\<acute>N - 1,\<acute>A)
                              ELSE CALL even (\<acute>N - 2,\<acute>A)
                              FI
                         FI"
 print_theorems
 print_locale! odd_even_clique
 
 
 text \<open>To prove the procedure calls to @{term "odd"} respectively
 @{term "even"} correct we first derive a rule to justify that we
 can assume both specifications to verify the bodies. This rule can
 be derived from the general @{thm [source] HoareTotal.ProcRec} rule. An ML function will
 do this work:
 \<close>
 
 
 
 ML \<open>ML_Thms.bind_thm ("ProcRec2", Hoare.gen_proc_rec @{context} Hoare.Partial 2)\<close>
 
 
 lemma (in odd_even_clique)
   shows odd_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile>{\<sigma>} \<acute>A :== PROC odd(\<acute>N)
                   \<lbrace>(\<exists>b. \<^bsup>\<sigma>\<^esup>N = 2 * b + \<acute>A) \<and> \<acute>A < 2 \<rbrace>" (is ?P1)
    and even_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile>{\<sigma>} \<acute>A :== PROC even(\<acute>N)
                   \<lbrace>(\<exists>b. \<^bsup>\<sigma>\<^esup>N + 1 = 2 * b + \<acute>A) \<and> \<acute>A < 2 \<rbrace>" (is ?P2)
 proof -
   have "?P1 \<and> ?P2"
     apply (hoare_rule ProcRec2)
     apply  vcg
     apply  clarsimp
     apply  (rule_tac x="b + 1" in exI)
     apply  arith
     apply vcg
     apply clarsimp
     apply arith
     done
   thus "?P1" "?P2"
     by iprover+
 qed
 
 subsection \<open>Expressions With Side Effects\<close>
 
 
 (* R := N++ + M++*)
 lemma (in state_space) shows "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
   \<acute>N \<ggreater> n. \<acute>N :== \<acute>N + 1 \<ggreater>
   \<acute>M \<ggreater> m. \<acute>M :== \<acute>M + 1 \<ggreater>
   \<acute>R :== n + m
   \<lbrace>\<acute>R = \<acute>N + \<acute>M - 2\<rbrace>"
 apply vcg
 apply simp
 done
 
 (* R := Fac (N) + Fac (N) *)
 lemma (in Fac_impl) shows
   "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
   CALL Fac(\<acute>N) \<ggreater> n. CALL Fac(\<acute>N) \<ggreater> m.
   \<acute>R :== n + m
   \<lbrace>\<acute>R = fac \<acute>N + fac \<acute>N\<rbrace>"
 proof -
   note Fac_spec = Fac_spec4
   show ?thesis
     apply vcg
     done
 qed
 
 (* R := Fac (N) + Fac (M) *)
 lemma (in Fac_impl) shows
   "\<Gamma>\<turnstile> \<lbrace>True\<rbrace>
   CALL Fac(\<acute>N) \<ggreater> n. CALL Fac(n) \<ggreater> m.
   \<acute>R :== m
   \<lbrace>\<acute>R = fac (fac \<acute>N)\<rbrace>"
 proof -
   note Fac_spec = Fac_spec4
   show ?thesis
     apply vcg
     done
 qed
 
 
 subsection \<open>Global Variables and Heap\<close>
 
 
 text \<open>
 Now we will define and verify some procedures on heap-lists. We consider
 list structures consisting of two fields, a content element @{term "cont"} and
 a reference to the next list element @{term "next"}. We model this by the
 following state space where every field has its own heap.
 \<close>
 
 
 hoarestate globals_list =
   "next" :: "ref \<Rightarrow> ref"
   cont :: "ref \<Rightarrow> nat"
 
 
 
 
 text \<open>Updates to global components inside a procedure will
 always be propagated to the caller. This is implicitly done by the
 parameter passing syntax translations. The record containing the global variables must begin with the prefix "globals".
 \<close>
 
 text \<open>We will first define an append function on lists. It takes two
 references as parameters. It appends the list referred to by the first
 parameter with the list referred to by the second parameter, and returns
 the result right into the first parameter.
 \<close>
 
 procedures (imports globals_list)
   append(p::ref,q::ref|p::ref)
     "IF \<acute>p=Null THEN \<acute>p :== \<acute>q ELSE \<acute>p \<rightarrow>\<acute>next:== CALL append(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"
 
 
 
 declare [[hoare_use_call_tr' = false]]
 context append_impl
 begin
 term "CALL append(\<acute>p,\<acute>q,\<acute>p\<rightarrow>\<acute>next)"
 end
 declare [[hoare_use_call_tr' = true]]
 
 text \<open>Below we give two specifications this time..
 The first one captures the functional behaviour and focuses on the
 entities that are potentially modified by the procedure, the second one
 is a pure frame condition.
 The list in the modifies clause has to list all global state components that
 may be changed by the procedure. Note that we know from the modifies clause
 that the @{term cont} parts of the lists will not be changed. Also a small
 side note on the syntax. We use ordinary brackets in the postcondition
 of the modifies clause, and also the state components do not carry the
 acute, because we explicitly note the state @{term t} here.
 
 The functional specification now introduces two logical variables besides the
 state space variable @{term "\<sigma>"}, namely @{term "Ps"} and @{term "Qs"}.
 They are universally quantified and range over both the pre and the postcondition, so
 that we are able to properly instantiate the specification
 during the proofs. The syntax \<open>\<lbrace>\<sigma>. \<dots>\<rbrace>\<close> is a shorthand to fix the current
 state: \<open>{s. \<sigma> = s \<dots>}\<close>.
 \<close>
 
 lemma (in append_impl) append_spec:
   shows "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>
             \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {}\<rbrace>
                 \<acute>p :== PROC append(\<acute>p,\<acute>q)
             \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply vcg
   apply fastforce
   done
 
 
 text \<open>The modifies clause is equal to a proper record update specification
 of the following form.
 \<close>
 
 lemma (in append_impl) shows "{t. t may_only_modify_globals Z in [next]}
        =
        {t. \<exists>next. globals t=update id id next_' (K_statefun next) (globals Z)}"
   apply (unfold mex_def meq_def)
   apply simp
   done
 
 text \<open>If the verification condition generator works on a procedure call
 it checks whether it can find a modifies clause in the context. If one
 is present the procedure call is simplified before the Hoare rule
 @{thm [source] HoareTotal.ProcSpec} is applied. Simplification of the procedure call means,
 that the ``copy back'' of the global components is simplified. Only those
 components that occur in the modifies clause will actually be copied back.
 This simplification is justified by the rule @{thm [source] HoareTotal.ProcModifyReturn}.
 So after this simplification all global components that do not appear in
 the modifies clause will be treated as local variables.
 \<close>
 
 text \<open>You can study the effect of the modifies clause on the following two
 examples, where we want to prove that @{term "append"} does not change
 the @{term "cont"} part of the heap.
 \<close>
 lemma (in append_impl)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>p=Null \<and> \<acute>cont=c\<rbrace> \<acute>p :== CALL append(\<acute>p,Null) \<lbrace>\<acute>cont=c\<rbrace>"
   apply vcg
   oops
 
 text \<open>To prove the frame condition,
 we have to tell the verification condition generator to use only the
 modifies clauses and not to search for functional specifications by
 the parameter \<open>spec=modifies\<close> It will also try to solve the
 verification conditions automatically.
 \<close>
 
 lemma (in append_impl) append_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC append(\<acute>p,\<acute>q){t. t may_only_modify_globals \<sigma> in [next]}"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (vcg spec=modifies)
   done
 
 lemma (in append_impl)
   shows "\<Gamma>\<turnstile> \<lbrace>\<acute>p=Null \<and> \<acute>cont=c\<rbrace> \<acute>p\<rightarrow>\<acute>next :== CALL append(\<acute>p,Null) \<lbrace>\<acute>cont=c\<rbrace>"
   apply vcg
   apply simp
   done
 
 text \<open>
 Of course we could add the modifies clause to the functional specification as
 well. But separating both has the advantage that we split up the verification
 work. We can make use of the modifies clause before we apply the
 functional specification in a fully automatic fashion.
 \<close>
 
 
 text \<open>To verify the body of @{term "append"} we do not need the modifies
 clause, since the specification does not talk about @{term "cont"} at all, and
 we don't access @{term "cont"} inside the body. This may be different for
 more complex procedures.
 \<close>
 
 text \<open>
 To prove that a procedure respects the modifies clause, we only need
 the modifies clauses of the procedures called in the body. We do not need
 the functional specifications. So we can always prove the modifies
 clause without functional specifications, but me may need the modifies
 clause to prove the functional specifications.
 \<close>
 
 
 
 
 subsubsection \<open>Insertion Sort\<close>
 
 primrec sorted:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list  \<Rightarrow> bool"
 where
 "sorted le [] = True" |
 "sorted le (x#xs) = ((\<forall>y\<in>set xs. le x y) \<and> sorted le xs)"
 
 
 
 procedures (imports globals_list)
   insert(r::ref,p::ref | p::ref)
     "IF \<acute>r=Null THEN SKIP
      ELSE IF \<acute>p=Null THEN \<acute>p :== \<acute>r;; \<acute>p\<rightarrow>\<acute>next :== Null
           ELSE IF \<acute>r\<rightarrow>\<acute>cont \<le> \<acute>p\<rightarrow>\<acute>cont
                THEN \<acute>r\<rightarrow>\<acute>next :== \<acute>p;; \<acute>p:==\<acute>r
                ELSE \<acute>p\<rightarrow>\<acute>next :== CALL insert(\<acute>r,\<acute>p\<rightarrow>\<acute>next)
                FI
           FI
      FI"
 
 
 text \<open>
 In the postcondition of the functional specification there is a small but
 important subtlety. Whenever we talk about the @{term "cont"} part we refer to
 the one of the pre-state, even in the conclusion of the implication.
 The reason is, that we have separated out, that @{term "cont"} is not modified
 by the procedure, to the modifies clause. So whenever we talk about unmodified
 parts in the postcondition we have to use the pre-state part, or explicitely
 state an equality in the postcondition.
 The reason is simple. If the postcondition would talk about \<open>\<acute>cont\<close>
 instead of \<open>\<^bsup>\<sigma>\<^esup>cont\<close>, we will get a new instance of \<open>cont\<close> during
 verification and the postcondition would only state something about this
 new instance. But as the verification condition generator will use the
 modifies clause the caller of \<open>insert\<close> instead will still have the
 old \<open>cont\<close> after the call. Thats the sense of the modifies clause.
 So the caller and the specification will simply talk about two different things,
 without being able to relate them (unless an explicit equality is added to
 the specification).
 \<close>
 
 lemma (in insert_impl) insert_modifies:
   "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC insert(\<acute>r,\<acute>p){t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (vcg spec=modifies)
 done
 
 
 lemma (in insert_impl) insert_spec:
     "\<forall>\<sigma> Ps . \<Gamma>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and> sorted (\<le>) (map \<acute>cont Ps) \<and>
                   \<acute>r \<noteq> Null \<and> \<acute>r \<notin> set Ps\<rbrace>
          \<acute>p :== PROC insert(\<acute>r,\<acute>p)
    \<lbrace>\<exists>Qs. List \<acute>p \<acute>next Qs \<and> sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont  Qs) \<and>
            set Qs = insert \<^bsup>\<sigma>\<^esup>r (set Ps) \<and>
            (\<forall>x. x \<notin> set Qs \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
 
 apply (hoare_rule HoarePartial.ProcRec1)
 apply vcg
 apply (intro conjI impI)
 apply    fastforce
 apply   fastforce
 apply  fastforce
 apply (clarsimp)
 apply force
 done
 
 procedures (imports globals_list)
   insertSort(p::ref | p::ref)
   where r::ref q::ref
   in
     "\<acute>r:==Null;;
      WHILE (\<acute>p \<noteq> Null) DO
        \<acute>q :== \<acute>p;;
        \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
        \<acute>r :== CALL insert(\<acute>q,\<acute>r)
      OD;;
      \<acute>p:==\<acute>r"
 
 print_locale insertSort_impl
 
 
 lemma (in insertSort_impl) insertSort_modifies:
   shows
    "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} \<acute>p :== PROC insertSort(\<acute>p)
               {t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcRec1)
 apply (vcg spec=modifies)
 done
 
 
 text \<open>Insertion sort is not implemented recursively here but with a while
 loop. Note that the while loop is not annotated with an invariant in the
 procedure definition. The invariant only comes into play during verification.
 Therefore we will annotate the body during the proof with the
 rule @{thm [source] HoareTotal.annotateI}.
 \<close>
 
 
 lemma (in insertSort_impl) insertSort_body_spec:
   shows "\<forall>\<sigma> Ps. \<Gamma>,\<Theta>\<turnstile> \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<rbrace>
               \<acute>p :== PROC insertSort(\<acute>p)
           \<lbrace>\<exists>Qs. List \<acute>p \<acute>next Qs \<and> sorted (\<le>) (map \<^bsup>\<sigma>\<^esup>cont Qs) \<and>
            set Qs = set Ps\<rbrace>"
   apply (hoare_rule HoarePartial.ProcRec1)
   apply (hoare_rule anno=
          "\<acute>r :== Null;;
          WHILE \<acute>p \<noteq> Null
          INV \<lbrace>\<exists>Qs Rs. List \<acute>p \<acute>next Qs \<and> List \<acute>r \<acute>next Rs \<and>
                   set Qs \<inter> set Rs = {} \<and>
                   sorted (\<le>) (map \<acute>cont Rs) \<and> set Qs \<union> set Rs = set Ps \<and>
                   \<acute>cont = \<^bsup>\<sigma>\<^esup>cont \<rbrace>
           DO \<acute>q :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;; \<acute>r :== CALL insert(\<acute>q,\<acute>r) OD;;
           \<acute>p :== \<acute>r" in HoarePartial.annotateI)
   apply vcg
   apply   fastforce
   prefer 2
   apply  fastforce
   apply (clarsimp)
   apply (rule_tac x=ps in exI)
   apply (intro conjI)
   apply    (rule heap_eq_ListI1)
   apply     assumption
   apply    clarsimp
   apply    (subgoal_tac "x\<noteq>p \<and> x \<notin> set Rs")
   apply     auto
   done
 
 subsubsection "Memory Allocation and Deallocation"
 
 text \<open>The basic idea of memory management is to keep a list of allocated
 references in the state space. Allocation of a new reference adds a
 new reference to the list deallocation removes a reference. Moreover
 we keep a counter "free" for the free memory.
 \<close>
 
 (*
 record globals_list_alloc = globals_list +
   alloc_'::"ref list"
   free_'::nat
 
 record 'g list_vars' = "'g list_vars" +
   i_'::nat
   first_'::ref
 *)
 
 hoarestate globals_list_alloc =
   alloc::"ref list"
   free::nat
   "next"::"ref \<Rightarrow> ref"
   cont::"ref \<Rightarrow> nat"
 hoarestate locals_list_alloc =
   i::nat
   first::ref
   p::ref
   q::ref
   r::ref
   root::ref
   tmp::ref
 locale list_alloc = globals_list_alloc + locals_list_alloc
 
 definition "sz = (2::nat)"
 
 lemma (in list_alloc)
  shows
   "\<Gamma>,\<Theta>\<turnstile> \<lbrace>\<acute>i = 0 \<and> \<acute>first = Null \<and> n*sz \<le> \<acute>free\<rbrace>
        WHILE \<acute>i < n
        INV \<lbrace>\<exists>Ps. List \<acute>first \<acute>next Ps \<and> length Ps = \<acute>i \<and> \<acute>i \<le> n \<and>
              set Ps \<subseteq> set \<acute>alloc \<and> (n - \<acute>i)*sz \<le> \<acute>free\<rbrace>
        DO
          \<acute>p :== NEW sz [\<acute>cont:==0,\<acute>next:== Null];;
          \<acute>p\<rightarrow>\<acute>next :== \<acute>first;;
          \<acute>first :== \<acute>p;;
          \<acute>i :== \<acute>i+ 1
        OD
        \<lbrace>\<exists>Ps. List \<acute>first \<acute>next  Ps \<and> length Ps = n \<and> set Ps \<subseteq> set \<acute>alloc\<rbrace>"
 apply (vcg)
 apply   simp
 apply  clarsimp
 apply  (rule conjI)
 apply   clarsimp
 apply   (rule_tac x="new (set alloc)#Ps" in exI)
 apply   clarsimp
 apply   (rule conjI)
 apply    fastforce
 apply   (simp add: sz_def)
 apply  (simp add: sz_def)
 apply fastforce
 done
 
 
 lemma (in list_alloc)
  shows
   "\<Gamma>\<turnstile> \<lbrace>\<acute>i = 0 \<and> \<acute>first = Null \<and> n*sz \<le> \<acute>free\<rbrace>
        WHILE \<acute>i < n
        INV \<lbrace>\<exists>Ps. List \<acute>first \<acute>next Ps \<and> length Ps = \<acute>i \<and> \<acute>i \<le> n \<and>
              set Ps \<subseteq> set \<acute>alloc \<and> (n - \<acute>i)*sz \<le> \<acute>free\<rbrace>
        DO
          \<acute>p :== NNEW sz [\<acute>cont:==0,\<acute>next:== Null];;
          \<acute>p\<rightarrow>\<acute>next :== \<acute>first;;
          \<acute>first :== \<acute>p;;
          \<acute>i :== \<acute>i+ 1
        OD
        \<lbrace>\<exists>Ps. List \<acute>first \<acute>next  Ps \<and> length Ps = n \<and> set Ps \<subseteq> set \<acute>alloc\<rbrace>"
 
 apply (vcg)
 apply   simp
 apply  clarsimp
 apply  (rule conjI)
 apply   clarsimp
 apply   (rule_tac x="new (set alloc)#Ps" in exI)
 apply   clarsimp
 apply   (rule conjI)
 apply    fastforce
 apply   (simp add: sz_def)
 apply  (simp add: sz_def)
 apply fastforce
 done
 
 subsection \<open>Fault Avoiding Semantics\<close>
 
 text \<open>
 If we want to ensure that no runtime errors occur we can insert guards into
 the code. We will not be able to prove any nontrivial Hoare triple
 about code with guards, if we cannot show that the guards will never fail.
 A trivial Hoare triple is one with an empty precondtion.
 \<close>
 
 
 lemma (in list_alloc) "\<Gamma>,\<Theta>\<turnstile> \<lbrace>True\<rbrace>  \<lbrace>\<acute>p\<noteq>Null\<rbrace>\<longmapsto> \<acute>p\<rightarrow>\<acute>next :== \<acute>p \<lbrace>True\<rbrace>"
 apply vcg
 oops
 
 lemma (in list_alloc) "\<Gamma>,\<Theta>\<turnstile> {}  \<lbrace>\<acute>p\<noteq>Null\<rbrace>\<longmapsto> \<acute>p\<rightarrow>\<acute>next :== \<acute>p \<lbrace>True\<rbrace>"
 apply vcg
 done
 
 text \<open>Let us consider this small program that reverts a list. At
 first without guards.
 \<close>
 lemma (in list_alloc)
   shows
   "\<Gamma>,\<Theta>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
   \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps\<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 apply (vcg)
 apply fastforce+
 done
 
 text \<open>If we want to ensure that we do not dereference @{term "Null"} or
 access unallocated memory, we have to add some guards.
 \<close>
 lemma (in list_alloc)
   shows
   "\<Gamma>,\<Theta>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
  \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 apply (vcg)
 apply fastforce+
 done
 
 
 text \<open>We can also just prove that no faults will occur, by giving the
 trivial postcondition.
 \<close>
 lemma (in list_alloc) rev_noFault:
   shows
   "\<Gamma>,\<Theta>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
   UNIV,UNIV"
 apply (vcg)
 apply fastforce+
 done
 
 lemma (in list_alloc) rev_moduloGuards:
 
   shows
   "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<surd> \<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<surd> \<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
  \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 apply vcg
 apply fastforce+
 done
 
 
 
 
 lemma CombineStrip':
   assumes deriv: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/F\<^esub> P c' Q,A"
   assumes deriv_strip: "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c'' UNIV,UNIV"
   assumes c'': "c''= mark_guards False (strip_guards (-F) c')"
   assumes c: "c = mark_guards False c'"
   shows "\<Gamma>,\<Theta>\<turnstile>\<^bsub>/{}\<^esub> P c Q,A"
 proof -
   from deriv_strip [simplified c'']
   have "\<Gamma>,\<Theta>\<turnstile> P (strip_guards (- F) c') UNIV,UNIV"
     by (rule HoarePartialProps.MarkGuardsD)
   with deriv
   have "\<Gamma>,\<Theta>\<turnstile> P c' Q,A"
     by (rule HoarePartialProps.CombineStrip)
   hence "\<Gamma>,\<Theta>\<turnstile> P mark_guards False c' Q,A"
     by (rule HoarePartialProps.MarkGuardsI)
   thus ?thesis
     by (simp add: c)
 qed
 
 
 text \<open>We can then combine the prove that no fault will occur with the
 functional prove of the programm without guards to get the full proove by
 the rule @{thm HoarePartialProps.CombineStrip}
 \<close>
 
 
 lemma (in list_alloc)
   shows
   "\<Gamma>,\<Theta>\<turnstile> \<lbrace>List \<acute>p \<acute>next Ps \<and> List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<and>
        set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>
   WHILE \<acute>p \<noteq> Null
   INV \<lbrace>\<exists>ps qs. List \<acute>p \<acute>next  ps \<and> List \<acute>q \<acute>next qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs \<and>
                set ps \<subseteq> set \<acute>alloc \<and> set qs \<subseteq> set \<acute>alloc\<rbrace>
   DO \<acute>r :== \<acute>p;;
      \<lbrace>\<acute>p\<noteq>Null \<and> \<acute>p\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow> \<acute>next;;
      \<lbrace>\<acute>r\<noteq>Null \<and> \<acute>r\<in>set \<acute>alloc\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;;
      \<acute>q :== \<acute>r OD
  \<lbrace>List \<acute>q \<acute>next (rev Ps @ Qs) \<and> set Ps \<subseteq> set \<acute>alloc \<and> set Qs \<subseteq> set \<acute>alloc\<rbrace>"
 
 apply (rule CombineStrip' [OF rev_moduloGuards rev_noFault])
 apply  simp
 apply simp
 done
 
 
 text \<open>In the previous example the effort to split up the prove did not
 really pay off. But when we think of programs with a lot of guards and
 complicated specifications it may be better to first focus on a prove without
 the messy guards. Maybe it is possible to automate the no fault proofs so
 that it suffices to focus on the stripped program.
 \<close>
 
 context list_alloc
 begin
 text \<open>
 The purpose of guards is to watch for faults that can occur during
 evaluation of expressions. In the example before we watched for null pointer
 dereferencing or memory faults. We can also look for array index bounds or
 division by zero. As the condition of a while loop is evaluated in each
 iteration we cannot just add a guard before the while loop. Instead we need
 a special guard for the condition.
 Example: @{term "WHILE  \<lbrace>\<acute>p\<noteq>Null\<rbrace>\<longmapsto> \<acute>p\<rightarrow>\<acute>next\<noteq>Null DO SKIP OD"}
 \<close>
 end
 
 subsection \<open>Cicular Lists\<close>
 definition
   distPath :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref \<Rightarrow> ref list \<Rightarrow> bool" where
   "distPath x next y as = (Path x next y as  \<and>  distinct as)"
 
 
 lemma neq_dP: "\<lbrakk>p \<noteq> q; Path p h q Ps; distinct Ps\<rbrakk> \<Longrightarrow>
  \<exists>Qs. p\<noteq>Null \<and> Ps = p#Qs \<and> p \<notin> set Qs"
 by (cases Ps, auto)
 
 lemma (in list_alloc) circular_list_rev_I:
   "\<Gamma>,\<Theta>\<turnstile> \<lbrace>\<acute>root = r \<and>  distPath \<acute>root \<acute>next \<acute>root (r#Ps)\<rbrace>
    \<acute>p :== \<acute>root;; \<acute>q :== \<acute>root\<rightarrow>\<acute>next;;
   WHILE \<acute>q \<noteq> \<acute>root
   INV \<lbrace>\<exists> ps qs. distPath \<acute>p \<acute>next \<acute>root ps  \<and> distPath \<acute>q \<acute>next \<acute>root qs \<and>
              \<acute>root = r \<and> r\<noteq>Null \<and> r \<notin> set Ps  \<and> set ps \<inter> set qs = {} \<and>
              Ps = (rev ps) @ qs \<rbrace>
   DO \<acute>tmp :== \<acute>q;; \<acute>q :== \<acute>q\<rightarrow>\<acute>next;; \<acute>tmp\<rightarrow>\<acute>next :== \<acute>p;; \<acute>p:==\<acute>tmp OD;;
   \<acute>root\<rightarrow>\<acute>next :== \<acute>p
   \<lbrace>\<acute>root = r \<and> distPath \<acute>root \<acute>next \<acute>root (r#rev Ps)\<rbrace>"
 apply (simp only:distPath_def)
 apply vcg
 apply   (rule_tac x="[]" in exI)
 apply   fastforce
 apply  clarsimp
 apply  (drule (2) neq_dP)
 apply  (rule_tac x="q # ps" in exI)
 apply  clarsimp
 apply fastforce
 done
 
 
 
 lemma path_is_list:"\<And>a next b. \<lbrakk>Path b next a Ps ; a \<notin> set Ps; a\<noteq>Null\<rbrakk>
 \<Longrightarrow> List b (next(a := Null)) (Ps @ [a])"
 apply (induct Ps)
 apply (auto simp add:fun_upd_apply)
 done
 
 text \<open>
 The simple algorithm for acyclic list reversal, with modified
 annotations, works for cyclic lists as well.:
 \<close>
 
 lemma (in list_alloc) circular_list_rev_II:
  "\<Gamma>,\<Theta>\<turnstile>
  \<lbrace>\<acute>p = r \<and> distPath \<acute>p \<acute>next \<acute>p (r#Ps)\<rbrace>
 \<acute>q:==Null;;
 WHILE \<acute>p \<noteq> Null
 INV
  \<lbrace> ((\<acute>q = Null) \<longrightarrow> (\<exists>ps. distPath \<acute>p \<acute>next r ps  \<and>  ps = r#Ps)) \<and>
   ((\<acute>q \<noteq> Null) \<longrightarrow> (\<exists>ps qs. distPath \<acute>q \<acute>next r qs  \<and> List \<acute>p \<acute>next ps  \<and>
                    set ps \<inter> set qs = {} \<and> rev qs @ ps = Ps@[r])) \<and>
   \<not> (\<acute>p = Null \<and> \<acute>q = Null \<and> r = Null )
    \<rbrace>
 DO
   \<acute>tmp :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;; \<acute>tmp\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q:==\<acute>tmp
 OD
  \<lbrace>\<acute>q = r \<and> distPath \<acute>q \<acute>next \<acute>q (r # rev Ps)\<rbrace>"
 
 apply (simp only:distPath_def)
 apply vcg
 apply   clarsimp
 apply  clarsimp
 apply  (case_tac "(q = Null)")
 apply   (fastforce intro: path_is_list)
 apply  clarify
 apply  (rule_tac x="psa" in exI)
 apply  (rule_tac x=" p # qs" in exI)
 apply  force
 apply fastforce
 done
 
 text\<open>Although the above algorithm is more succinct, its invariant
 looks more involved. The reason for the case distinction on @{term q}
 is due to the fact that during execution, the pointer variables can
 point to either cyclic or acyclic structures.
 \<close>
 
 text \<open>
 When working on lists, its sometimes better to remove
 @{thm[source] fun_upd_apply} from the simpset, and instead include @{thm[source] fun_upd_same} and @{thm[source] fun_upd_other} to
 the simpset
 \<close>
 
 (*
 declare fun_upd_apply[simp del]fun_upd_same[simp] fun_upd_other[simp]
 *)
 
 
 lemma (in state_space) "\<Gamma>\<turnstile> {\<sigma>}
             \<acute>I :== \<acute>M;;
             ANNO \<tau>. \<lbrace>\<tau>. \<acute>I = \<^bsup>\<sigma>\<^esup>M\<rbrace>
                       \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I
                     \<lbrace>\<acute>M = \<^bsup>\<tau>\<^esup>N \<and> \<acute>N = \<^bsup>\<tau>\<^esup>I\<rbrace>
             \<lbrace>\<acute>M = \<^bsup>\<sigma>\<^esup>N \<and> \<acute>N = \<^bsup>\<sigma>\<^esup>M\<rbrace>"
 apply vcg
 apply auto
 done
 
 context state_space
 begin
 term "ANNO (\<tau>,m,k). (\<lbrace>\<tau>. \<acute>M = m\<rbrace>) \<acute>M :== \<acute>N;; \<acute>N :== \<acute>I \<lbrace>\<acute>M = \<^bsup> \<tau>\<^esup>N & \<acute>N = \<^bsup>\<tau>\<^esup>I\<rbrace>,{}"
 end
 
 lemma (in state_space) "\<Gamma>\<turnstile> ({\<sigma>} \<inter> \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>)
       (ANNO \<tau>. ({\<tau>} \<inter> \<lbrace>\<acute>A=\<^bsup>\<sigma>\<^esup>A \<and> \<acute>I=\<^bsup>\<sigma>\<^esup>I \<and> \<acute>M=0 \<and> \<acute>S=0\<rbrace>)
       WHILE \<acute>M \<noteq> \<acute>A
       INV \<lbrace>\<acute>S = \<acute>M * \<acute>I \<and> \<acute>A=\<^bsup>\<tau>\<^esup>A \<and> \<acute>I=\<^bsup>\<tau>\<^esup>I\<rbrace>
       DO \<acute>S :== \<acute>S + \<acute>I;; \<acute>M :== \<acute>M + 1 OD
       \<lbrace>\<acute>S = \<^bsup>\<tau>\<^esup>A * \<^bsup>\<tau>\<^esup>I\<rbrace>)
       \<lbrace>\<acute>S = \<^bsup>\<sigma>\<^esup>A * \<^bsup>\<sigma>\<^esup>I\<rbrace>"
 apply vcg_step
 apply vcg_step
 apply simp
 apply vcg_step
 apply vcg_step
 apply simp
 apply vcg
 apply simp
 apply simp
 apply vcg_step
 apply auto
 done
 
 text \<open>Just some test on marked, guards\<close>
 lemma (in state_space) "\<Gamma>\<turnstile>\<lbrace>True\<rbrace> WHILE \<lbrace>P \<acute>N \<rbrace>\<surd>, \<lbrace>Q \<acute>M\<rbrace>#, \<lbrace>R \<acute>N\<rbrace>\<longmapsto> \<acute>N < \<acute>M
                     INV \<lbrace>\<acute>N < 2\<rbrace> DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 apply vcg
 oops
 
 lemma (in state_space) "\<Gamma>\<turnstile>\<^bsub>/{True}\<^esub> \<lbrace>True\<rbrace> WHILE \<lbrace>P \<acute>N \<rbrace>\<surd>, \<lbrace>Q \<acute>M\<rbrace>#, \<lbrace>R \<acute>N\<rbrace>\<longmapsto> \<acute>N < \<acute>M
                     INV \<lbrace>\<acute>N < 2\<rbrace> DO
                     \<acute>N :== \<acute>M
                   OD
            \<lbrace>hard\<rbrace>"
 apply vcg
 oops
 
 end
diff --git a/thys/Simpl/ex/VcgExTotal.thy b/thys/Simpl/ex/VcgExTotal.thy
--- a/thys/Simpl/ex/VcgExTotal.thy
+++ b/thys/Simpl/ex/VcgExTotal.thy
@@ -1,370 +1,366 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      VcgExTotal.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
 
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section \<open>Examples for Total Correctness\<close>
 
 theory VcgExTotal imports "../HeapList" "../Vcg" begin
 
 record 'g vars = "'g state" +
   A_' :: nat
   I_' :: nat
   M_' :: nat
   N_' :: nat
   R_' :: nat
   S_' :: nat
   Abr_':: string
 
 
 lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
           WHILE \<acute>M \<noteq> a
           INV \<lbrace>\<acute>S = \<acute>M * b \<and> \<acute>M \<le> a\<rbrace>
           VAR MEASURE a - \<acute>M
           DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
           \<lbrace>\<acute>S = a * b\<rbrace>"
 apply vcg
 apply (auto)
 done
 
 lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>I \<le> 3\<rbrace>
      WHILE \<acute>I < 10 INV \<lbrace>\<acute>I\<le> 10\<rbrace> VAR MEASURE 10 - \<acute>I
      DO
        \<acute>I :== \<acute>I + 1
      OD
   \<lbrace>\<acute>I = 10\<rbrace>"
 apply vcg
 apply auto
 done
 
 text \<open>Total correctness of a nested loop. In the inner loop we have to
 express that the loop variable of the outer loop is not changed. We use
 \<open>FIX\<close> to introduce a new logical variable
 \<close>
 
 lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>M=0 \<and> \<acute>N=0\<rbrace>
       WHILE (\<acute>M < i)
       INV \<lbrace>\<acute>M \<le> i \<and> (\<acute>M \<noteq> 0 \<longrightarrow> \<acute>N = j) \<and> \<acute>N \<le> j\<rbrace>
       VAR MEASURE (i - \<acute>M)
       DO
          \<acute>N :== 0;;
          WHILE (\<acute>N < j)
          FIX m.
          INV \<lbrace>\<acute>M=m \<and> \<acute>N \<le> j\<rbrace>
          VAR MEASURE (j - \<acute>N)
          DO
            \<acute>N :== \<acute>N + 1
          OD;;
        \<acute>M :== \<acute>M + 1
        OD
        \<lbrace>\<acute>M=i \<and> (\<acute>M\<noteq>0 \<longrightarrow> \<acute>N=j)\<rbrace>"
 apply vcg
 apply simp_all
 apply arith
 done
 
 primrec fac:: "nat \<Rightarrow> nat"
 where
 "fac 0 = 1" |
 "fac (Suc n) = (Suc n) * fac n"
 
 lemma fac_simp [simp]: "0 < i \<Longrightarrow>  fac i = i * fac (i - 1)"
   by (cases i) simp_all
 
 procedures
   Fac (N | R) = "IF \<acute>N = 0 THEN \<acute>R :== 1
                        ELSE CALL Fac(\<acute>N - 1,\<acute>R);;
                             \<acute>R :== \<acute>N * \<acute>R
                        FI"
 
 lemma (in Fac_impl) Fac_spec:
   shows "\<forall>n. \<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
   apply (hoare_rule HoareTotal.ProcRec1 [where r="measure (\<lambda>(s,p). \<^bsup>s\<^esup>N)"])
   apply vcg
   apply simp
   done
 
 
 
 procedures
   p91(R,N | R) = "IF 100 < \<acute>N THEN \<acute>R :== \<acute>N - 10
                       ELSE \<acute>R :== CALL p91(\<acute>R,\<acute>N+11);;
                            \<acute>R :== CALL p91(\<acute>R,\<acute>R) FI"
 
 
   p91_spec: "\<forall>n. \<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC p91(\<acute>R,\<acute>N)
                         \<lbrace>if 100 < n then \<acute>R = n - 10 else \<acute>R = 91\<rbrace>,{}"
 
 lemma (in p91_impl) p91_spec:
   shows "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} \<acute>R :== PROC p91(\<acute>R,\<acute>N)
                        \<lbrace>if 100 < \<^bsup>\<sigma>\<^esup>N then \<acute>R = \<^bsup>\<sigma>\<^esup>N - 10 else \<acute>R = 91\<rbrace>,{}"
   apply (hoare_rule HoareTotal.ProcRec1 [where r="measure (\<lambda>(s,p). 101 - \<^bsup>s\<^esup>N)"])
   apply vcg
   apply clarsimp
   apply arith
   done
 
 record globals_list =
   next_' :: "ref \<Rightarrow> ref"
   cont_' :: "ref \<Rightarrow> nat"
 
 record 'g list_vars = "'g state" +
   p_'    :: "ref"
   q_'    :: "ref"
   r_'    :: "ref"
   root_' :: "ref"
   tmp_'  :: "ref"
 
 procedures
   append(p,q|p) =
     "IF \<acute>p=Null THEN \<acute>p :== \<acute>q ELSE \<acute>p\<rightarrow>\<acute>next :== CALL append(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"
 
 lemma (in append_impl)
   shows
    "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>\<^sub>t
       \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<rbrace>
        \<acute>p :== PROC append(\<acute>p,\<acute>q)
       \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
    apply (hoare_rule HoareTotal.ProcRec1
             [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
    apply vcg
    apply (fastforce  simp add: List_list)
    done
 
 
 lemma (in append_impl)
   shows
    "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>\<^sub>t
       \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<rbrace>
        \<acute>p :== PROC append(\<acute>p,\<acute>q)
       \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
    apply (hoare_rule HoareTotal.ProcRec1
             [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
    apply vcg
    apply (fastforce  simp add: List_list)
    done
 
 lemma (in append_impl)
   shows
   append_spec:
    "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t ({\<sigma>} \<inter> \<lbrace>islist \<acute>p \<acute>next\<rbrace>)  \<acute>p :== PROC append(\<acute>p,\<acute>q)
     \<lbrace>\<forall>Ps Qs. List \<^bsup>\<sigma>\<^esup>p \<^bsup>\<sigma>\<^esup>next Ps \<and>  List \<^bsup>\<sigma>\<^esup>q \<^bsup>\<sigma>\<^esup>next Qs \<and> set Ps \<inter> set Qs = {}
      \<longrightarrow>
      List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
    apply (hoare_rule HoareTotal.ProcRec1
             [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
    apply vcg
    apply fastforce
    done
 
 lemma "\<Gamma>\<turnstile>\<lbrace>List \<acute>p \<acute>next Ps\<rbrace>
        \<acute>q :== Null;;
        WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>q \<acute>next Qs' \<and>
                              set Ps' \<inter> set Qs' = {} \<and>
                              rev Ps' @ Qs' = rev Ps\<rbrace>
         DO
          \<acute>r :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
          \<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
        OD;;
        \<acute>p :==\<acute>q
        \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace> "
 apply vcg
 apply   clarsimp
 apply  clarsimp
 apply force
 apply simp
 done
 
 lemma conjI2: "\<lbrakk>Q; Q \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P \<and> Q"
 by blast
 
 procedures Rev(p|p) =
       "\<acute>q :== Null;;
        WHILE \<acute>p \<noteq> Null
        DO
          \<acute>r :== \<acute>p;; \<lbrace>\<acute>p \<noteq> Null\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
          \<lbrace>\<acute>r \<noteq> Null\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
        OD;;
        \<acute>p :==\<acute>q"
  Rev_spec:
   "\<forall>Ps. \<Gamma>\<turnstile>\<^sub>t \<lbrace>List \<acute>p \<acute>next Ps\<rbrace> \<acute>p :== PROC Rev(\<acute>p) \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace>"
  Rev_modifies:
   "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} \<acute>p :== PROC Rev(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"
 
 text \<open>We only need partial correctness of modifies clause!\<close>
 
 
 
 lemma upd_hd_next:
   assumes p_ps: "List p next (p#ps)"
   shows "List (next p) (next(p := q)) ps"
 proof -
   from p_ps
   have "p \<notin> set ps"
     by auto
   with p_ps show ?thesis
     by simp
 qed
 
 lemma (in Rev_impl) shows
  Rev_spec:
   "\<forall>Ps. \<Gamma>\<turnstile>\<^sub>t \<lbrace>List \<acute>p \<acute>next Ps\<rbrace> \<acute>p :== PROC Rev(\<acute>p) \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace>"
 apply (hoare_rule HoareTotal.ProcNoRec1)
 apply (hoare_rule anno =
        "\<acute>q :== Null;;
        WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>q \<acute>next Qs' \<and>
                              set Ps' \<inter> set Qs' = {} \<and>
                              rev Ps' @ Qs' = rev Ps\<rbrace>
        VAR MEASURE (length (list \<acute>p \<acute>next) )
         DO
          \<acute>r :== \<acute>p;; \<lbrace>\<acute>p \<noteq> Null\<rbrace>\<longmapsto>\<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
          \<lbrace>\<acute>r \<noteq> Null\<rbrace>\<longmapsto>\<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
        OD;;
        \<acute>p :==\<acute>q" in HoareTotal.annotateI)
 apply vcg
 apply   clarsimp
 apply  clarsimp
 apply  (rule conjI2)
 apply   force
 apply  clarsimp
 apply  (subgoal_tac "List p next (p#ps)")
 prefer 2 apply simp
 apply  (frule_tac q=q in upd_hd_next)
 apply  (simp only: List_list)
 apply  simp
 apply simp
 done
 
 
 lemma (in Rev_impl) shows
  Rev_modifies:
   "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV \<^esub>{\<sigma>} \<acute>p :== PROC Rev(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"
 apply (hoare_rule HoarePartial.ProcNoRec1)
 apply (vcg spec=modifies)
 done
 
 lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>List \<acute>p \<acute>next Ps\<rbrace>
        \<acute>q :== Null;;
        WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>q \<acute>next Qs' \<and>
                              set Ps' \<inter> set Qs' = {} \<and>
                              rev Ps' @ Qs' = rev Ps\<rbrace>
        VAR MEASURE (length (list \<acute>p \<acute>next) )
         DO
          \<acute>r :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
          \<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
        OD;;
        \<acute>p :==\<acute>q
        \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace> "
 apply vcg
 apply   clarsimp
 apply  clarsimp
 apply  (rule conjI2)
 apply   force
 apply  clarsimp
 apply  (subgoal_tac "List p next (p#ps)")
 prefer 2 apply simp
 apply  (frule_tac q=q in upd_hd_next)
 apply  (simp only: List_list)
 apply  simp
 apply simp
 done
 
 
 
 
 procedures
   pedal(N,M) = "IF 0 < \<acute>N THEN
                             IF 0 < \<acute>M THEN CALL coast(\<acute>N- 1,\<acute>M- 1) FI;;
                             CALL pedal(\<acute>N- 1,\<acute>M)
                          FI"
 
 and
 
   coast(N,M) = "CALL pedal(\<acute>N,\<acute>M);;
                          IF 0 < \<acute>M THEN CALL coast(\<acute>N,\<acute>M- 1) FI"
 
 
 ML \<open>ML_Thms.bind_thm ("HoareTotal_ProcRec2", Hoare.gen_proc_rec @{context} Hoare.Total 2)\<close>
 
 
 lemma (in pedal_coast_clique)
   shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace>  PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
          (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
   apply (hoare_rule HoareTotal_ProcRec2
           [where ?r= "inv_image (measure (\<lambda>m. m) <*lex*>
                                   measure (\<lambda>p. if p = coast_'proc then 1 else 0))
                       (\<lambda>(s,p). (\<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M,p))"])
   apply simp_all
-  apply (vcg,force)+
+  apply  vcg
+  apply  simp
+  apply vcg
+  apply simp
   done
 
 lemma (in pedal_coast_clique)
   shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
          (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
   apply (hoare_rule HoareTotal_ProcRec2
           [where ?r= "inv_image (measure (\<lambda>m. m) <*lex*>
                                   measure (\<lambda>p. if p = coast_'proc then 1 else 0))
                       (\<lambda>(s,p). (\<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M,p))"])
   apply simp_all
-  apply (vcg,force)+
+  apply  vcg
+  apply  simp
+  apply vcg
+  apply simp
   done
 
 
 
 
 lemma (in pedal_coast_clique)
   shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
          (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
   apply(hoare_rule HoareTotal_ProcRec2
      [where ?r= "measure (\<lambda>(s,p). \<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M + (if p = coast_'proc then 1 else 0))"])
   apply simp_all
-  apply (vcg,force)+
+  apply  vcg
+  apply  simp
+  apply  arith
+  apply vcg
+  apply simp
   done
 
 
 lemma (in pedal_coast_clique)
   shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
          (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
   apply(hoare_rule HoareTotal_ProcRec2
      [where ?r= "(\<lambda>(s,p). \<^bsup>s\<^esup>N) <*mlex*> (\<lambda>(s,p). \<^bsup>s\<^esup>M) <*mlex*>
                  measure (\<lambda>(s,p). if p = coast_'proc then 1 else 0)"])
    apply  simp_all
-   apply (vcg,force)+
-  done
+   apply  vcg
+   apply  simp
+   apply vcg
+   apply simp
+   done
 
 
 lemma (in pedal_coast_clique)
   shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
          (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
   apply(hoare_rule HoareTotal_ProcRec2
      [where ?r= "measure (\<lambda>s. \<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M) <*lex*>
                  measure (\<lambda>p. if p = coast_'proc then 1 else 0)"])
    apply simp_all
-   apply (vcg,force)+
-  done
+   apply  vcg
+   apply  simp
+   apply vcg
+   apply simp
+   done
 
 
 end
diff --git a/thys/Simpl/ex/XVcgEx.thy b/thys/Simpl/ex/XVcgEx.thy
--- a/thys/Simpl/ex/XVcgEx.thy
+++ b/thys/Simpl/ex/XVcgEx.thy
@@ -1,109 +1,88 @@
 (*
     Author:      Norbert Schirmer
     Maintainer:  Norbert Schirmer, norbert.schirmer at web de
-    License:     LGPL
-*)
-
-(*  Title:      XVcgEx.thy
-    Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2006-2008 Norbert Schirmer
-Some rights reserved, TU Muenchen
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
 *)
 
 section "Examples for Parallel Assignments"
 
 theory XVcgEx
 imports "../XVcg"
 
 begin
 
 record "globals" =
   "G_'"::"nat"
   "H_'"::"nat"
 
 record 'g vars = "'g state" +
   A_' :: nat
   B_' :: nat
   C_' :: nat
   I_' :: nat
   M_' :: nat
   N_' :: nat
   R_' :: nat
   S_' :: nat
   Arr_' :: "nat list"
   Abr_':: string
 
 term "BASIC
          \<acute>A :== x,
          \<acute>B :== y
       END"
 
 term "BASIC
          \<acute>G :== \<acute>H,
          \<acute>H :== \<acute>G
       END"
 
 term "BASIC
         LET (x,y) = (\<acute>A,b);
             z = \<acute>B
         IN \<acute>A :== x,
            \<acute>G :== \<acute>A + y + z
       END"
 
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>A = 0\<rbrace>
       \<lbrace>\<acute>A < 0\<rbrace> \<longmapsto> BASIC
        LET (a,b,c) = foo \<acute>A
        IN
             \<acute>A :== a,
             \<acute>B :== b,
             \<acute>C :== c
       END
       \<lbrace>\<acute>A = x \<and> \<acute>B = y \<and> \<acute>C = c\<rbrace>"
 apply vcg
 oops
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>A = 0\<rbrace>
       \<lbrace>\<acute>A < 0\<rbrace> \<longmapsto> BASIC
        LET (a,b,c) = foo \<acute>A
        IN
             \<acute>A :== a,
             \<acute>G :== b + \<acute>B,
             \<acute>H :== c
       END
       \<lbrace>\<acute>A = x \<and> \<acute>G = y \<and> \<acute>H = c\<rbrace>"
 apply vcg
 oops
 
 definition foo:: "nat \<Rightarrow> (nat \<times> nat \<times> nat)"
   where "foo n = (n,n+1,n+2)"
 
 lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>A = 0\<rbrace>
       \<lbrace>\<acute>A < 0\<rbrace> \<longmapsto> BASIC
        LET (a,b,c) = foo \<acute>A
        IN
             \<acute>A :== a,
             \<acute>G :== b + \<acute>B,
             \<acute>H :== c
       END
       \<lbrace>\<acute>A = x \<and> \<acute>G = y \<and> \<acute>H = c\<rbrace>"
 apply (vcg add: foo_def snd_conv fst_conv)
 oops
 
 end
diff --git a/thys/Simpl/generalise_state.ML b/thys/Simpl/generalise_state.ML
--- a/thys/Simpl/generalise_state.ML
+++ b/thys/Simpl/generalise_state.ML
@@ -1,301 +1,286 @@
 (*  Title:      generalise_state.ML
-
     Author:     Norbert Schirmer, TU Muenchen
 
-Copyright (C) 2005-2007 Norbert Schirmer
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (C) 2006-2008 Norbert Schirmer
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
 
 signature SPLIT_STATE =
-sig
-  val isState: term -> bool
-  val abs_state: term -> term option
+sig val isState: Proof.context -> term -> bool
+  val abs_state: Proof.context -> term -> term option
   val abs_var: Proof.context -> term -> (string * typ)
   val split_state: Proof.context -> string -> typ -> term -> (term * term list)
-  val ex_tac: Proof.context -> term list -> tactic
+  val ex_tac: Proof.context -> term list -> int -> tactic
     (* the term-list is the list of selectors as
        returned by split_state. They may be used to
-       construct the instatiation of the existentially
+       construct the instantiation of the existentially
        quantified state.
     *)
 end;
 
-functor GeneraliseFun (structure SplitState: SPLIT_STATE) =
+signature GENERALISE =
+sig
+  val GENERALISE: Proof.context -> int -> tactic
+end
+
+functor Generalise (structure SplitState: SPLIT_STATE) : GENERALISE =
 struct
 
 val genConj = @{thm generaliseConj};
 val genImp = @{thm generaliseImp};
 val genImpl = @{thm generaliseImpl};
 val genAll = @{thm generaliseAll};
 val gen_all = @{thm generalise_all};
 val genEx = @{thm generaliseEx};
 val genRefl = @{thm generaliseRefl};
 val genRefl' = @{thm generaliseRefl'};
 val genTrans = @{thm generaliseTrans};
 val genAllShift = @{thm generaliseAllShift};
 
 val gen_allShift = @{thm generalise_allShift};
 val meta_spec = @{thm meta_spec};
 val protectRefl = @{thm protectRefl};
 val protectImp = @{thm protectImp};
 
 fun gen_thm decomp (t,ct) =
   let
     val (ts,cts,recomb) = decomp (t,ct)
   in recomb (map (gen_thm decomp) (ts~~cts)) end;
 
 
 fun dest_prop (Const (@{const_name Pure.prop}, _) $ P) = P
   | dest_prop t = raise TERM ("dest_prop", [t]);
 
 fun prem_of thm = #1 (Logic.dest_implies (dest_prop (Thm.prop_of thm)));
 fun conc_of thm = #2 (Logic.dest_implies (dest_prop (Thm.prop_of thm)));
 
 fun dest_All (Const (@{const_name "All"},_)$t) = t
   | dest_All t = raise TERM ("dest_All",[t]);
 
 
 
 fun SIMPLE_OF ctxt rule prems =
   let
     val mx = fold (fn thm => fn i => Int.max (Thm.maxidx_of thm,i)) prems 0;
   in DistinctTreeProver.discharge ctxt prems (Thm.incr_indexes (mx + 1) rule) end;
 
 infix 0 OF_RAW
 fun tha OF_RAW thb = thb COMP (Drule.incr_indexes thb tha);
 
 fun SIMPLE_OF_RAW ctxt tha thb = SIMPLE_OF ctxt tha [thb];
 
 
 datatype qantifier = Meta_all | Hol_all | Hol_ex
 
 fun list_exists (vs, x) =
   fold_rev (fn (x, T) => fn P => HOLogic.exists_const T $ Abs (x, T, P)) vs x;
 
 fun spec' cv thm =
   let (* thm = Pure.prop ((all x. P x) ==> Q), where "all" is meta or HOL *)
       val (ct1,ct2) = thm |> Thm.cprop_of |> Thm.dest_comb |> #2
                       |> Thm.dest_comb |> #2 |> Thm.dest_comb;
   in
      (case Thm.term_of ct1 of
        Const (@{const_name "Trueprop"},_)
         => let
              val (Var (sP,_)$Var (sV,sVT)) = HOLogic.dest_Trueprop (Thm.concl_of spec);
              val cvT = Thm.ctyp_of_cterm cv;
              val vT = Thm.typ_of cvT;
            in Thm.instantiate
                 (TVars.make [(dest_TVar sVT, cvT)],
                  Vars.make [((sP, vT --> HOLogic.boolT), #2 (Thm.dest_comb ct2)),
                  ((sV, vT), cv)])
                 spec
            end
       | Const (@{const_name Pure.all},_)
         => let
              val (Var (sP,_)$Var (sV,sVT)) = Thm.concl_of meta_spec;
              val cvT = Thm.ctyp_of_cterm cv;
              val vT = Thm.typ_of cvT;
            in Thm.instantiate
                 (TVars.make [(dest_TVar sVT, cvT)],
                  Vars.make [((sP, vT --> propT), ct2),
                  ((sV, vT),cv)])
                 meta_spec
            end
       | _ => raise THM ("spec'",0,[thm]))
   end;
 
 
 fun split_thm qnt ctxt s T t =
   let
     val (t',vars) = SplitState.split_state ctxt s T t;
     val vs = map (SplitState.abs_var ctxt) vars;
 
     val prop = (case qnt of
                   Meta_all => Logic.list_all (vs,t')
                 | Hol_all  => HOLogic.mk_Trueprop (HOLogic.list_all (vs, t'))
                 | Hol_ex   => Logic.mk_implies
                                 (HOLogic.mk_Trueprop (list_exists (vs, t')),
                                  HOLogic.mk_Trueprop (HOLogic.mk_exists (s,T,t))))
   in (case qnt of
-        Hol_ex => Goal.prove ctxt [] [] prop (fn _ => SplitState.ex_tac ctxt vars)
+        Hol_ex => Goal.prove ctxt [] [] prop (fn _ => SplitState.ex_tac ctxt vars 1)
       | _ => let
                val rP = conc_of genRefl';
                val thm0 = Thm.instantiate (TVars.empty, Vars.make [(dest_Var rP, Thm.cterm_of ctxt prop)]) genRefl';
                fun elim_all v thm =
                  let
                    val cv = Thm.cterm_of ctxt v;
                    val spc = Goal.protect 0 (spec' cv thm);
                  in SIMPLE_OF ctxt genTrans [thm,spc] end;
                val thm = fold elim_all vars thm0;
              in thm end)
    end;
 
 
 
 
 fun eta_expand ctxt ct =
   let
     val mi = Thm.maxidx_of_cterm ct;
     val T = domain_type (Thm.typ_of_cterm ct);
     val x = Thm.cterm_of ctxt (Var (("s",mi+1),T));
   in Thm.lambda x (Thm.apply ct x) end;
 
 fun split_abs ctxt ct =
   (case Thm.term_of ct of
      Abs x => (x, Thm.dest_abs_global ct)
    | _ => split_abs ctxt (eta_expand ctxt ct))
 
 fun decomp ctxt (Const (@{const_name HOL.conj}, _) $ t $ t', ct) =
       ([t,t'],snd (Drule.strip_comb ct), fn [thm,thm'] => SIMPLE_OF ctxt genConj [thm,thm'])
   | decomp ctxt ((allc as Const (@{const_name "All"},aT)) $ f, ct) =
        let
          val cf = snd (Thm.dest_comb ct);
          val (abst as (x,T,_),(cx',cb)) = split_abs ctxt cf;
          val Free (x',_) = Thm.term_of cx';
          val (Const (@{const_name Pure.all},_)$Abs (s,_,_)) = genAll |> Thm.prems_of |> hd |> dest_prop;
          val genAll' = Drule.rename_bvars [(s,x)] genAll;
          val (Const (@{const_name Pure.all},_)$Abs (s',_,_)) = genAllShift |> Thm.prems_of |> hd |> dest_prop;
          val genAllShift' = Drule.rename_bvars [(s',x)] genAllShift;
-       in if SplitState.isState (allc$Abs abst)
+       in if SplitState.isState ctxt (allc$Abs abst)
           then ([Thm.term_of cb],[cb], fn [thm] =>
                        let val P = HOLogic.dest_Trueprop (dest_prop (prem_of thm));
                            val thm' = split_thm Hol_all ctxt x' T P;
                            val thm1 = genAllShift' OF_RAW
                                         Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm'));
                            val thm2 = genAll' OF_RAW
                                         Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm));
                        in SIMPLE_OF ctxt genTrans [thm1,thm2]
                        end)
           else ([Thm.term_of cb],[cb], fn [thm] =>
                         genAll' OF_RAW Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm)))
        end
   | decomp ctxt ((exc as Const (@{const_name "Ex"},_)) $ f, ct) =
        let
          val cf = snd (Thm.dest_comb ct);
          val (abst as (x,T,_),(cx',cb)) = split_abs ctxt cf;
          val Free (x',_) = Thm.term_of cx';
          val (Const (@{const_name Pure.all},_)$Abs (s,_,_)) = genEx |> Thm.prems_of |> hd |> dest_prop;
          val genEx' = Drule.rename_bvars [(s,x)] genEx;
-       in if SplitState.isState (exc$Abs abst)
+       in if SplitState.isState ctxt (exc$Abs abst)
           then ([Thm.term_of cb],[cb], fn [thm] =>
                        let val P = HOLogic.dest_Trueprop (dest_prop (prem_of thm));
                            val thm' = split_thm Hol_ex ctxt x' T P;
                        in SIMPLE_OF_RAW ctxt protectImp (Goal.protect 0 thm') end )
           else ([Thm.term_of cb],[cb], fn [thm] =>
                        genEx' OF_RAW Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm)))
        end
   | decomp ctxt (Const (@{const_name HOL.implies},_)$P$Q, ct) =
        let
          val [cP,cQ] = (snd (Drule.strip_comb ct));
        in ([Q],[cQ],fn [thm] =>
              let
                val X = genImp |> Thm.concl_of |> dest_prop |> Logic.dest_implies |> #1
                        |> dest_prop |> HOLogic.dest_Trueprop |> HOLogic.dest_imp |> #1
                        |> dest_Var;
                val genImp' = Thm.instantiate (TVars.empty, Vars.make [(X,cP)]) genImp;
              in SIMPLE_OF ctxt genImp' [thm] end)
        end
   | decomp ctxt (Const (@{const_name Pure.imp},_)$P$Q, ct) =
        let
          val [cP,cQ] = (snd (Drule.strip_comb ct));
        in ([Q],[cQ],fn [thm] =>
              let
                val X = genImpl |> Thm.concl_of |> dest_prop |> Logic.dest_implies |> #1
                        |> dest_prop  |> Logic.dest_implies |> #1
                        |> dest_Var;
                val genImpl' = Thm.instantiate (TVars.empty, Vars.make [(X,cP)]) genImpl;
              in SIMPLE_OF ctxt genImpl' [thm] end)
        end
   | decomp ctxt ((allc as Const (@{const_name Pure.all},_)) $ f, ct) =
        let
          val cf = snd (Thm.dest_comb ct);
          val (abst as (x,T,_),(cx',cb)) = split_abs ctxt cf;
          val Free (x',_) = Thm.term_of cx';
          val (Const (@{const_name Pure.all},_)$Abs (s,_,_)) = gen_all |> Thm.prems_of |> hd |> dest_prop;
          val gen_all' = Drule.rename_bvars [(s,x)] gen_all;
          val (Const (@{const_name Pure.all},_)$Abs (s',_,_)) = gen_allShift |> Thm.prems_of |> hd |> dest_prop;
          val gen_allShift' = Drule.rename_bvars [(s',x)] gen_allShift;
-       in if SplitState.isState (allc$Abs abst)
+       in if SplitState.isState ctxt (allc$Abs abst)
           then ([Thm.term_of cb],[cb], fn [thm] =>
                        let val P = dest_prop (prem_of thm);
                            val thm' = split_thm Meta_all ctxt x' T P;
                            val thm1 = gen_allShift' OF_RAW
                                        Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm'));
                            val thm2 = gen_all' OF_RAW
                                        Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm));
                        in SIMPLE_OF ctxt genTrans [thm1,thm2]
                        end)
           else ([Thm.term_of cb],[cb], fn [thm] =>
                     gen_all' OF_RAW Goal.protect 0 (Thm.forall_intr cx' (Goal.conclude thm)))
        end
   | decomp ctxt (Const (@{const_name "Trueprop"},_)$P, ct) = ([P],snd (Drule.strip_comb ct),fn [thm] => thm)
   | decomp ctxt (t, ct) = ([],[], fn [] =>
                          let val rP = HOLogic.dest_Trueprop (dest_prop (conc_of genRefl));
                          in  Thm.instantiate (TVars.empty, Vars.make [(dest_Var rP, ct)]) genRefl end)
 
 fun generalise ctxt ct = gen_thm (decomp ctxt) (Thm.term_of ct,ct);
 
 (*
   -------- (init)
   #C ==> #C
 *)
 fun init ct = Thm.instantiate' [] [SOME ct] protectRefl;
 
-fun generalise_over_tac ctxt P i st =
-  let
-    val t = List.nth (Thm.prems_of st, i - 1);  (* FIXME !? *)
-  in (case P t of
-       SOME t' =>
-        let
-          val ct = Thm.cterm_of ctxt t';
-          val meta_spec_protect' = infer_instantiate ctxt [(("x", 0), ct)] @{thm meta_spec_protect};
-        in
-          (init (Thm.adjust_maxidx_cterm 0 (List.nth (Drule.cprems_of st, i - 1)))
-           |> resolve_tac ctxt [meta_spec_protect'] 1
-           |> Seq.maps (fn st' =>
-                Thm.bicompose NONE {flatten = true, match = false, incremented = false}
-                        (false, Goal.conclude st', Thm.nprems_of st') i st))
-        end
-      | NONE => no_tac st)
-  end;
+fun generalise_over_tac ctxt P = SUBGOAL (fn (t, i) => fn st =>
+  (case P t of
+     SOME t' =>
+      let
+        val ct = Thm.cterm_of ctxt t';
+        val meta_spec_protect' = infer_instantiate ctxt [(("x", 0), ct)] @{thm meta_spec_protect};
+      in
+        (init (Thm.adjust_maxidx_cterm 0 (List.nth (Drule.cprems_of st, i - 1)))
+         |> resolve_tac ctxt [meta_spec_protect'] 1
+         |> Seq.maps (fn st' =>
+              Thm.bicompose NONE {flatten = true, match = false, incremented = false}
+                      (false, Goal.conclude st', Thm.nprems_of st') i st))
+      end
+    | NONE => no_tac st))
 
 fun generalise_over_all_states_tac ctxt i =
-  REPEAT (generalise_over_tac ctxt SplitState.abs_state i);
+  REPEAT (generalise_over_tac ctxt (SplitState.abs_state ctxt) i);
 
-fun generalise_tac ctxt i st =
+fun generalise_tac ctxt = CSUBGOAL (fn (ct, i) => fn st =>
   let
-    val ct = List.nth (Drule.cprems_of st, i - 1);
     val ct' = Thm.dest_equals_rhs (Thm.cprop_of (Thm.eta_conversion ct));
     val r = Goal.conclude (generalise ctxt ct');
   in (init (Thm.adjust_maxidx_cterm 0 (List.nth (Drule.cprems_of st, i - 1)))
       |> (resolve_tac ctxt [r] 1 THEN resolve_tac ctxt [Drule.protectI] 1)
       |> Seq.maps (fn st' =>
             Thm.bicompose NONE {flatten = true, match = false, incremented = false}
                     (false, Goal.conclude st', Thm.nprems_of st') i st))
-  end
+  end)
 
 fun GENERALISE ctxt i =
   generalise_over_all_states_tac ctxt i THEN
   generalise_tac ctxt i
 
 end;
 
 
 
 
 
 
diff --git a/thys/Simpl/hoare.ML b/thys/Simpl/hoare.ML
--- a/thys/Simpl/hoare.ML
+++ b/thys/Simpl/hoare.ML
@@ -1,3403 +1,3609 @@
 (*  Title:      hoare.ML
     Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2007 Norbert Schirmer
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
 signature HOARE =
 sig
   datatype hoareMode = Partial | Total
   val gen_proc_rec: Proof.context -> hoareMode -> int -> thm
-  datatype state_kind = Record | Function
+  datatype state_kind = Record | Function | Other of string (* future extensions of state space *)
   datatype par_kind = In | Out
   val deco: string
   val proc_deco: string
   val par_deco: string -> string
   val chopsfx: string -> string -> string
   val is_state_var: string -> bool
   val extern: Proof.context -> string -> string
   val remdeco: Proof.context -> string -> string
-  val remdeco': string -> string
+  val remdeco': Proof.context -> string -> string
   val undeco: Proof.context -> term -> term
   val varname: string -> string
   val resuffix: string -> string -> string -> string
+  type state_space = {
+     name: string,
+     is_state_type: Proof.context -> typ -> bool,
+     generalise: Proof.context -> int -> tactic,
+     state_simprocs: simproc list,
+     state_upd_simprocs: simproc list,
+     state_ex_sel_eq_simprocs: simproc list,
+
+     (* syntax *)
+     read_function_name: Proof.context -> xstring -> term,
+     is_defined: Proof.context -> xstring -> bool,
+     lookup_tr: Proof.context -> xstring -> term,
+     update_tr: Proof.context -> xstring -> term,
+     is_lookup: Proof.context -> term -> bool,
+     lookup_tr': Proof.context -> term -> term,
+     dest_update_tr': Proof.context -> term -> term * term * term option,
+     update_tr': Proof.context -> term -> term
+  }
+  type lense = {lookup: term, update : term}
   type proc_info =
-    {params: ((par_kind * string) list),
+    {params: ((par_kind * string * lense option) list),
      recursive: bool,
      state_kind: state_kind}
   type hoare_tac = (bool -> int -> tactic) -> Proof.context -> hoareMode -> int -> tactic
   type hoare_data =
    {proc_info: proc_info Symtab.table,
     active_procs: string list list,
     default_state_kind: state_kind,
-    generate_guard: (stamp * (Proof.context -> term -> term option)),
-    wp_tacs: (string * hoare_tac) list,
+    generate_guard: (stamp option * (Proof.context -> term -> term option)),
+    name_tr: (stamp option * (Proof.context -> bool -> string -> string)), (* bool indicates input tr: true vs. output tr: false *)
     hoare_tacs: (string * hoare_tac) list,
-    vcg_simps: thm list}
+    vcg_simps: thm list,
+    state_spaces: (string * state_space) list (* registry for state space extensions *)
+  }
   val get_data: Proof.context -> hoare_data
-  val get_params: string -> Proof.context -> (par_kind * string) list option
+  val get_params: string -> Proof.context -> (par_kind * string * lense option) list option
   val get_default_state_kind: Proof.context -> state_kind
   val get_state_kind: string -> Proof.context -> state_kind option
+  val get_default_state_space: Proof.context -> state_space option
   val clique_name: string list -> string
   val install_generate_guard: (Proof.context -> term -> term option) ->
     Context.generic -> Context.generic
   val generate_guard: Proof.context -> term -> term option
+  val install_name_tr: (Proof.context -> bool -> string -> string) ->
+    Context.generic -> Context.generic
+  val name_tr: Proof.context -> bool -> string -> string
+  val install_state_space: state_space -> Context.generic -> Context.generic
   val BasicSimpTac: Proof.context -> state_kind ->
     bool -> thm list -> (int -> tactic) -> int -> tactic
   val hoare: (Proof.context -> Proof.method) context_parser
   val hoare_raw: (Proof.context -> Proof.method) context_parser
   val vcg: (Proof.context -> Proof.method) context_parser
   val vcg_step: (Proof.context -> Proof.method) context_parser
   val hoare_rule: (Proof.context -> Proof.method) context_parser
 
   val add_foldcongsimps: thm list -> theory -> theory
   val get_foldcong_ss : theory -> simpset
   val add_foldcongs : thm list -> theory -> theory
   val modeqN : string
   val modexN : string
   val implementationN : string
   val specL : string
 
   val vcg_tac : string -> string -> string list -> Proof.context -> int -> tactic
   val hoare_rule_tac : Proof.context -> thm list -> int -> tactic
 
+  val solve_modifies_tac: Proof.context -> state_kind -> (term -> int) -> int -> tactic
+
+  val add_hoare_tacs: (string * hoare_tac) list -> Context.generic -> Context.generic
   datatype 'a bodykind = BodyTyp of 'a | BodyTerm of 'a
   val proc_specs : (bstring * string) list parser
-  val add_params : morphism -> string -> (par_kind * string) list ->
+  val add_params : morphism -> string -> (par_kind * string * lense option) list ->
                    Context.generic -> Context.generic
   val set_default_state_kind : state_kind -> Context.generic -> Context.generic
   val add_state_kind : morphism -> string -> state_kind -> Context.generic ->
                        Context.generic
   val add_recursive : morphism -> string -> Context.generic -> Context.generic
+
+  structure FunSplitState : SPLIT_STATE
+  val first_subterm: (term -> bool) -> term -> ((string * typ) list * term) option
+  val dest_string: term -> string
+  val dest_hoare_raw: term -> term * term * term * term * hoareMode * term * term * term
+  val idx: ('a -> string -> bool) -> 'a list -> string -> int
+  val sort_variables: bool Config.T
+  val destr_to_constr: term -> term
 end;
 
 structure Hoare: HOARE =
 struct
 
 (* Misc *)
 
 val record_vanish = Attrib.setup_config_bool @{binding hoare_record_vanish} (K true);
 val use_generalise = Attrib.setup_config_bool @{binding hoare_use_generalise} (K false);
 val sort_variables = Attrib.setup_config_bool @{binding hoare_sort_variables} (K true);
 val use_cond_inv_modifies = Attrib.setup_config_bool @{binding hoare_use_cond_inv_modifies} (K true);
 
-val hoare_trace = Attrib.setup_config_bool @{binding hoare_trace} (K false);
+val hoare_trace = Attrib.setup_config_int @{binding hoare_trace} (K 0);
 
 val body_def_sfx = "_body";
 
 val programN = "\<Gamma>";
 val hoare_ctxtL = "hoare";
 val specL = "_spec";
 val procL = "_proc";
 
 val bodyP = "_impl";
 
 val modifysfx = "_modifies";
 val modexN = "Hoare.mex";
 val modeqN = "Hoare.meq";
 
 val KNF = @{const_name StateFun.K_statefun};
 
 
 (* Some abstract syntax operations *)
 
 val Trueprop = HOLogic.mk_Trueprop;
 
 infix 0 ===;
 val (op ===) = Trueprop o HOLogic.mk_eq;
 
 fun is_empty_set (Const (@{const_name Orderings.bot}, _)) = true
   | is_empty_set _ = false;
 
 fun mk_Int Ts A B = let val T = fastype_of1 (Ts, A)
   in Const (@{const_name Lattices.inf}, T --> T --> T) $ A $ B end;
 
 fun mk_Un T (A, B) = Const (@{const_name Lattices.sup}, T --> T --> T) $ A $ B;
 
 fun dest_Un (Const (@{const_name Lattices.sup}, _) $ t1 $ t2) = dest_Un t1 @ dest_Un t2
   | dest_Un t = [t]
 
 fun mk_UN' dT rT t =
   let
     val dTs = HOLogic.mk_setT dT;
     val rTs = HOLogic.mk_setT rT;
   in
     Const (@{const_name Complete_Lattices.Sup}, rTs --> rT) $
       (Const (@{const_name image}, (dT --> rT) --> dTs --> rTs) $ t $
       Const (@{const_name Orderings.top}, dTs))
   end;
 
 fun mk_UN ((x, T), P) = mk_UN' T (fastype_of P) (absfree (x, T) P);
 
 fun dest_UN (Const (@{const_name Complete_Lattices.Sup}, _) $
       (Const (@{const_name Set.image}, _) $ Abs (x, T, t) $
       Const (@{const_name Orderings.top}, _))) =
       let val (vars, body) = dest_UN t
       in ((x, T) :: vars, body) end
   | dest_UN t = ([], t);
 
 fun tap_UN (Const (@{const_name Complete_Lattices.Sup}, _) $
      (Const (@{const_name Set.image}, _) $ t $
      Const (@{const_name Orderings.top}, _))) = SOME t
   | tap_UN _ = NONE;
 
 
 (* Fetching the rules *)
 
 datatype hoareMode = Partial | Total
 
 fun get_rule p t Partial = p
   | get_rule p t Total   = t
 
+fun get_rule' p t m Partial true = m
+  | get_rule' p t m Partial false = p
+  | get_rule' p t m Total _ = t
+
+fun get_call_rule p t p_exn t_exn Partial NONE = p
+  | get_call_rule p t p_exn t_exn Partial (SOME _) = p_exn
+  | get_call_rule p t p_exn t_exn Total NONE = t
+  | get_call_rule p t p_exn t_exn Total (SOME _) = t_exn
+
 val Guard = get_rule @{thm HoarePartial.Guard} @{thm HoareTotal.Guard};
 
 val GuardStrip = get_rule @{thm HoarePartial.GuardStrip} @{thm HoareTotal.GuardStrip};
 
 val GuaranteeAsGuard = get_rule @{thm HoarePartial.GuaranteeAsGuard} @{thm HoareTotal.GuaranteeAsGuard};
 
 val Guarantee = get_rule @{thm HoarePartial.Guarantee} @{thm HoareTotal.Guarantee};
 
 val GuaranteeStrip = get_rule @{thm HoarePartial.GuaranteeStrip} @{thm HoareTotal.GuaranteeStrip};
 
 val GuardsNil = get_rule @{thm HoarePartial.GuardsNil} @{thm HoareTotal.GuardsNil};
 
 val GuardsCons = get_rule @{thm HoarePartial.GuardsCons} @{thm HoareTotal.GuardsCons};
 
 val GuardsConsGuaranteeStrip =
       get_rule @{thm HoarePartial.GuardsConsGuaranteeStrip} @{thm HoareTotal.GuardsConsGuaranteeStrip};
 
 val Skip = get_rule @{thm HoarePartial.Skip} @{thm HoareTotal.Skip};
 
 val Basic = get_rule @{thm HoarePartial.Basic} @{thm HoareTotal.Basic};
 
 val BasicCond = get_rule @{thm HoarePartial.BasicCond} @{thm HoareTotal.BasicCond};
 
 val Spec = get_rule @{thm HoarePartial.Spec} @{thm HoareTotal.Spec};
 
 val SpecIf = get_rule @{thm HoarePartial.SpecIf} @{thm HoareTotal.SpecIf};
 
 val Throw = get_rule @{thm HoarePartial.Throw} @{thm HoareTotal.Throw};
 
 val Raise = get_rule @{thm HoarePartial.raise} @{thm HoareTotal.raise};
 
-val Catch = get_rule @{thm HoarePartial.Catch} @{thm HoareTotal.Catch};
-
-val CondCatch = get_rule @{thm HoarePartial.condCatch} @{thm HoareTotal.condCatch};
+val Catch = get_rule' @{thm HoarePartial.Catch} @{thm HoareTotal.Catch} @{thm HoarePartial.CatchSame};
+
+val CondCatch = get_rule' @{thm HoarePartial.condCatch} @{thm HoareTotal.condCatch}  @{thm HoarePartial.condCatchSame};
 
 val CatchSwap = get_rule @{thm HoarePartial.CatchSwap} @{thm HoareTotal.CatchSwap};
 
 val CondCatchSwap = get_rule @{thm HoarePartial.condCatchSwap} @{thm HoareTotal.condCatchSwap};
 
-val Seq = get_rule @{thm HoarePartial.Seq} @{thm HoareTotal.Seq};
+val Seq = get_rule' @{thm HoarePartial.Seq} @{thm HoareTotal.Seq} @{thm HoarePartial.SeqSame};
 
 val SeqSwap = get_rule @{thm HoarePartial.SeqSwap} @{thm HoareTotal.SeqSwap};
 
-val BSeq = get_rule @{thm HoarePartial.BSeq} @{thm HoareTotal.BSeq};
+val BSeq = get_rule' @{thm HoarePartial.BSeq} @{thm HoareTotal.BSeq} @{thm HoarePartial.BSeqSame};
 
 val Cond = get_rule @{thm HoarePartial.Cond} @{thm HoareTotal.Cond};
 
 val CondInv'Partial = @{thm HoarePartial.CondInv'};
 val CondInv'Total = @{thm HoareTotal.CondInv'};
 val CondInv' = get_rule CondInv'Partial CondInv'Total;
 
 val SwitchNil = get_rule @{thm HoarePartial.switchNil} @{thm HoareTotal.switchNil};
 
 val SwitchCons = get_rule @{thm HoarePartial.switchCons} @{thm HoareTotal.switchCons};
 
 val CondSwap = get_rule @{thm HoarePartial.CondSwap} @{thm HoareTotal.CondSwap};
 
 val While = get_rule @{thm HoarePartial.While} @{thm HoareTotal.While};
 
 val WhileAnnoG = get_rule @{thm HoarePartial.WhileAnnoG} @{thm HoareTotal.WhileAnnoG};
 
 val WhileAnnoFix = get_rule @{thm HoarePartial.WhileAnnoFix'} @{thm HoareTotal.WhileAnnoFix'};
 
 val WhileAnnoGFix = get_rule @{thm HoarePartial.WhileAnnoGFix} @{thm HoareTotal.WhileAnnoGFix};
 
 val BindR = get_rule @{thm HoarePartial.Bind} @{thm HoareTotal.Bind};
 
 val Block = get_rule @{thm HoarePartial.Block} @{thm HoareTotal.Block};
 
 val BlockSwap = get_rule @{thm HoarePartial.BlockSwap} @{thm HoareTotal.BlockSwap};
 
-val Proc = get_rule @{thm HoarePartial.ProcSpec} @{thm HoareTotal.ProcSpec};
-
-val ProcNoAbr = get_rule @{thm HoarePartial.ProcSpecNoAbrupt} @{thm HoareTotal.ProcSpecNoAbrupt};
+val Proc = get_call_rule
+  @{thm HoarePartial.ProcSpec} @{thm HoareTotal.ProcSpec}
+  @{thm HoarePartial.Proc_exnSpec} @{thm HoareTotal.Proc_exnSpec};
+
+val ProcNoAbr = get_call_rule
+  @{thm HoarePartial.ProcSpecNoAbrupt} @{thm HoareTotal.ProcSpecNoAbrupt}
+  @{thm HoarePartial.Proc_exnSpecNoAbrupt} @{thm HoareTotal.Proc_exnSpecNoAbrupt};
 
 val ProcBody = get_rule @{thm HoarePartial.ProcBody} @{thm HoareTotal.ProcBody};
 
-val CallBody = get_rule @{thm HoarePartial.CallBody} @{thm HoareTotal.CallBody};
+val CallBody = get_call_rule
+  @{thm HoarePartial.CallBody} @{thm HoareTotal.CallBody}
+  @{thm HoarePartial.Call_exnBody} @{thm HoareTotal.Call_exnBody};
 
 val FCall = get_rule @{thm HoarePartial.FCall} @{thm HoareTotal.FCall};
 
 val ProcRecSpecs = get_rule @{thm HoarePartial.ProcRecSpecs} @{thm HoareTotal.ProcRecSpecs};
 
-val ProcModifyReturnSameFaults =
-      get_rule @{thm HoarePartial.ProcModifyReturnSameFaults} @{thm HoareTotal.ProcModifyReturnSameFaults};
-
-val ProcModifyReturn = get_rule @{thm HoarePartial.ProcModifyReturn} @{thm HoareTotal.ProcModifyReturn};
-
-val ProcModifyReturnNoAbr = get_rule @{thm HoarePartial.ProcModifyReturnNoAbr} @{thm HoareTotal.ProcModifyReturnNoAbr};
+val ProcModifyReturnSameFaults = get_call_rule
+  @{thm HoarePartial.ProcModifyReturnSameFaults} @{thm HoareTotal.ProcModifyReturnSameFaults}
+  @{thm HoarePartial.Proc_exnModifyReturnSameFaults} @{thm HoareTotal.Proc_exnModifyReturnSameFaults};
+
+val ProcModifyReturn = get_call_rule
+  @{thm HoarePartial.ProcModifyReturn} @{thm HoareTotal.ProcModifyReturn}
+  @{thm HoarePartial.Proc_exnModifyReturn} @{thm HoareTotal.Proc_exnModifyReturn};
+
+val ProcModifyReturnNoAbr = get_call_rule
+  @{thm HoarePartial.ProcModifyReturnNoAbr} @{thm HoareTotal.ProcModifyReturnNoAbr}
+  @{thm HoarePartial.Proc_exnModifyReturnNoAbr} @{thm HoareTotal.Proc_exnModifyReturnNoAbr};
 
 val ProcModifyReturnNoAbrSameFaultsPartial =
       @{thm HoarePartial.ProcModifyReturnNoAbrSameFaults};
 val ProcModifyReturnNoAbrSameFaultsTotal =
       @{thm HoareTotal.ProcModifyReturnNoAbrSameFaults};
-val ProcModifyReturnNoAbrSameFaults =
-      get_rule ProcModifyReturnNoAbrSameFaultsPartial ProcModifyReturnNoAbrSameFaultsTotal;
+val ProcModifyReturnNoAbrSameFaults = get_call_rule
+  ProcModifyReturnNoAbrSameFaultsPartial ProcModifyReturnNoAbrSameFaultsTotal
+  @{thm HoarePartial.Proc_exnModifyReturnNoAbrSameFaults} @{thm HoareTotal.Proc_exnModifyReturnNoAbrSameFaults};
 
 val TrivPost = get_rule @{thm HoarePartial.TrivPost} @{thm HoareTotal.TrivPost};
 
 val TrivPostNoAbr = get_rule @{thm HoarePartial.TrivPostNoAbr} @{thm HoareTotal.TrivPostNoAbr};
 
-val DynProcProcPar = get_rule @{thm HoarePartial.DynProcProcPar} @{thm HoareTotal.DynProcProcPar};
-
-val DynProcProcParNoAbr = get_rule @{thm HoarePartial.DynProcProcParNoAbrupt} @{thm HoareTotal.DynProcProcParNoAbrupt};
-
-val ProcProcParModifyReturn = get_rule @{thm HoarePartial.ProcProcParModifyReturn} @{thm HoareTotal.ProcProcParModifyReturn};
+val DynProcProcPar = get_call_rule
+  @{thm HoarePartial.DynProcProcPar} @{thm HoareTotal.DynProcProcPar}
+  @{thm HoarePartial.DynProc_exnProcPar} @{thm HoareTotal.DynProc_exnProcPar};
+
+val DynProcProcParNoAbr = get_call_rule
+  @{thm HoarePartial.DynProcProcParNoAbrupt} @{thm HoareTotal.DynProcProcParNoAbrupt}
+  @{thm HoarePartial.DynProc_exnProcParNoAbrupt} @{thm HoareTotal.DynProc_exnProcParNoAbrupt};
+
+val ProcProcParModifyReturn = get_call_rule
+  @{thm HoarePartial.ProcProcParModifyReturn} @{thm HoareTotal.ProcProcParModifyReturn}
+  @{thm HoarePartial.Proc_exnProcParModifyReturn} @{thm HoareTotal.Proc_exnProcParModifyReturn};
 
 val ProcProcParModifyReturnSameFaultsPartial =
       @{thm HoarePartial.ProcProcParModifyReturnSameFaults};
 val ProcProcParModifyReturnSameFaultsTotal =
       @{thm HoareTotal.ProcProcParModifyReturnSameFaults};
-val ProcProcParModifyReturnSameFaults =
-      get_rule ProcProcParModifyReturnSameFaultsPartial
-               ProcProcParModifyReturnSameFaultsTotal;
-
-val ProcProcParModifyReturnNoAbr =
-      get_rule @{thm HoarePartial.ProcProcParModifyReturnNoAbr} @{thm HoareTotal.ProcProcParModifyReturnNoAbr};
+val ProcProcParModifyReturnSameFaults = get_call_rule
+  ProcProcParModifyReturnSameFaultsPartial ProcProcParModifyReturnSameFaultsTotal
+  @{thm HoarePartial.ProcProcParModifyReturnSameFaults} @{thm HoareTotal.ProcProcParModifyReturnSameFaults};
+
+val ProcProcParModifyReturnNoAbr = get_call_rule
+  @{thm HoarePartial.ProcProcParModifyReturnNoAbr} @{thm HoareTotal.ProcProcParModifyReturnNoAbr}
+  @{thm HoarePartial.Proc_exnProcParModifyReturnNoAbr} @{thm HoareTotal.Proc_exnProcParModifyReturnNoAbr};
 
 val ProcProcParModifyReturnNoAbrSameFaultsPartial =
       @{thm HoarePartial.ProcProcParModifyReturnNoAbrSameFaults};
 val ProcProcParModifyReturnNoAbrSameFaultsTotal   =
       @{thm HoareTotal.ProcProcParModifyReturnNoAbrSameFaults};
-val ProcProcParModifyReturnNoAbrSameFaults =
-      get_rule ProcProcParModifyReturnNoAbrSameFaultsPartial
-               ProcProcParModifyReturnNoAbrSameFaultsTotal;
+val ProcProcParModifyReturnNoAbrSameFaults = get_call_rule
+  ProcProcParModifyReturnNoAbrSameFaultsPartial ProcProcParModifyReturnNoAbrSameFaultsTotal
+  @{thm HoarePartial.Proc_exnProcParModifyReturnNoAbrSameFaults}  @{thm HoareTotal.Proc_exnProcParModifyReturnNoAbrSameFaults};
 
 val DynCom = get_rule @{thm HoarePartial.DynComConseq} @{thm HoareTotal.DynComConseq};
 
 val AugmentContext = get_rule @{thm HoarePartial.augment_context'} @{thm HoareTotal.augment_context'};
 
 val AugmentEmptyFaults = get_rule @{thm HoarePartial.augment_emptyFaults} @{thm HoareTotal.augment_emptyFaults};
 
 val AsmUN = get_rule @{thm HoarePartial.AsmUN} @{thm HoareTotal.AsmUN};
 
 val SpecAnno = get_rule @{thm HoarePartial.SpecAnno'} @{thm HoareTotal.SpecAnno'};
 
 val SpecAnnoNoAbrupt = get_rule @{thm HoarePartial.SpecAnnoNoAbrupt} @{thm HoareTotal.SpecAnnoNoAbrupt};
 
 val LemAnno = get_rule @{thm HoarePartial.LemAnno} @{thm HoareTotal.LemAnno};
 
 val LemAnnoNoAbrupt = get_rule @{thm HoarePartial.LemAnnoNoAbrupt} @{thm HoareTotal.LemAnnoNoAbrupt};
 
 
 
 val singleton_conv_sym = @{thm Set.singleton_conv2} RS sym;
 
 val anno_defs = [@{thm Language.whileAnno_def},@{thm Language.whileAnnoG_def},@{thm Language.specAnno_def},
                  @{thm Language.whileAnnoGFix_def},@{thm Language.whileAnnoFix_def},@{thm Language.lem_def}];
 val strip_simps =
   @{thm Language.strip_simp} :: @{thm Option.option.map(2)} :: @{thms Language.strip_guards_simps};
 val normalize_simps =
  [@{thm Language.while_def}, @{thm Language.bseq_def}, @{thm List.append_Nil}, @{thm List.append_Cons}] @
   @{thms List.list.cases} @
   @{thms Language.flatten_simps} @
   @{thms Language.sequence.simps} @
   @{thms Language.normalize_simps} @
   @{thms Language.guards.simps} @
   [@{thm fst_conv}, @{thm snd_conv}];
 val K_rec_convs = [];
 val K_fun_convs = [@{thm StateFun.K_statefun_apply}, @{thm StateFun.K_statefun_comp}];
 val K_convs = K_rec_convs @ K_fun_convs;
 val K_rec_congs = [];
 val K_fun_congs = [@{thm StateFun.K_statefun_cong}];
 val K_congs = K_rec_congs @ K_fun_congs;
 
 (* misc. aux. functions *)
 
 (* first_subterm
  * yields result x of P for first subterm for which P is (SOME x),
    and all bound variables on the path
  * to that term
  *)
 fun first_subterm_dest P =
   let fun first abs_vars t =
         (case P t of
            SOME x => SOME (abs_vars,x)
          |_=> (case t of
                 u $ v => (case first abs_vars u of
                             NONE => first abs_vars v
                           | SOME x => SOME x)
               | Abs (c,T,u) => first (abs_vars @ [(c,T)]) u
               | _ => NONE))
   in first [] end;
 
 
 (* first_subterm
  * yields first subterm for which P holds, and all bound variables on the path
  * to that term
  *)
 fun first_subterm P =
   let fun P' t = if P t then SOME t else NONE;
   in first_subterm_dest P' end;
 
 (* max_subterm_dest
  * yields results of P for all maximal subterms for which P is (SOME x),
  * and all bound variables on the path to that subterm
  *)
 fun max_subterms_dest P =
   let fun collect abs_vars t =
         (case P t of
            SOME x => [(abs_vars,x)]
          |_=> (case t of
                 u $ v => collect abs_vars u @ collect abs_vars v
               | Abs (c,T,u) => collect (abs_vars @ [(c,T)]) u
               | _ => []))
   in collect [] end;
 
 fun last [] = raise Empty
   | last [x] = x
   | last (_::xs) = last xs;
 
 fun dest_splits (Const (@{const_name case_prod},_)$Abs (n,T,t)) = (n,T)::dest_splits t
   | dest_splits (Const (@{const_name case_prod},_)$Abs (n,T,t)$_) = (n,T)::dest_splits t
   | dest_splits (Abs (n,T,_)) = [(n,T)]
   | dest_splits _ = [];
 
 fun idx eq [] x = ~1
   | idx eq (x::rs) y =
       if eq x y then 0
       else let val i = idx eq rs y in if i < 0 then i else i+1 end;
 
 fun resuffix sfx1 sfx2 s =
   suffix sfx2 (unsuffix sfx1 s)
   handle Fail _ => s;
 
-(* state space representation dependent functions *)
-
-datatype state_kind = Record | Function
-fun state_simprocs Record   = [Record.simproc]
-  | state_simprocs Function = [Record.simproc, StateFun.lookup_simproc];
-
-fun state_upd_simproc Record   = Record.upd_simproc
-  | state_upd_simproc Function = StateFun.update_simproc;
-
-fun state_ex_sel_eq_simproc Record   = Record.ex_sel_eq_simproc
-  | state_ex_sel_eq_simproc Function = StateFun.ex_lookup_eq_simproc;
-
-val state_split_simp_tac = Record.split_simp_tac
-val state_hierarchy = Record.dest_recTs
-
-
-fun stateT_id T = case (state_hierarchy T) of [] => NONE | Ts => SOME (last Ts);
-
-fun globalsT (Type (_, T :: _)) = SOME T
-  | globalsT _ = NONE;
-
-fun stateT_ids T =
-  (case stateT_id T of
-     NONE => NONE
-   | SOME sT => (case globalsT T of
-                   NONE => SOME [sT]
-                 | SOME gT => (case stateT_id gT of
-                                 NONE => SOME [sT]
-                                | SOME gT' => SOME [sT,gT'])));
-
 datatype par_kind = In | Out
 
+datatype state_kind = Record | Function | Other of string;
+
 
 (*** utilities ***)
 
 (* utils for variable name decorations *)
 
 
 val deco = "_'";
 val proc_deco = "_'proc";
 
 fun par_deco name = deco ^ name ^ deco;
 
 fun chopsfx sfx str =
     (case try (unsuffix sfx) str of
        SOME s => s
      | NONE   => str)
 
 val is_state_var = can (unsuffix deco);
 
-(* removes the suffix of the string beginning with deco.
- *  "xys_'a" --> "xys";
- * The a is also chopped, since sometimes the bound variables
- * are renamed, I think SELECT_GOAL in rename_goal is to blame
- *)
-fun remdeco' str =
-    let
-        fun chop (p::ps) (x::xs) = chop ps xs
-          | chop []      xs      = []
-          | chop (p::ps) []      = error "remdeco: code should never be reached";
-
-        fun remove prf (s as (x::xs)) = if is_prefix (op =) prf s then chop prf s
-                                        else (x::remove prf xs)
-          | remove prf [] = [];
-
-    in String.implode (remove (String.explode deco) (String.explode str)) end;
 
 fun extern ctxt s =
   (case try (Proof_Context.extern_const ctxt o Lexicon.unmark_const) s of
      NONE => s
    | SOME s' => s');
 
-fun remdeco ctxt s = remdeco' (extern ctxt s);
-
-fun undeco ctxt (Const (c, T)) = Const (remdeco ctxt c, T)
-  | undeco ctxt ((f as Const (@{syntax_const "_free"},_)) $ Free (x, T)) =
-      (*f$*)Const (remdeco' x, T)
-  | undeco ctxt (Const _ $ _ $ ((Const (@{syntax_const "_free"},_)) $ Free (x, T))) =
-      (*f$*)Const (remdeco' x, T)
-  | undeco ctxt (Free (c, T)) = Const (remdeco' c, T)
-  | undeco ctxt x = x
-
 fun varname x = x ^ deco
 
-val dest_string = map (chr o HOLogic.dest_char) o HOLogic.dest_list;
+val dest_string = implode o map (chr o HOLogic.dest_char) o HOLogic.dest_list;
 
 fun dest_string' t =
      (case try dest_string t of
-       SOME s => implode s
+       SOME s => s
       | NONE => (case t of
                    Free (s,_) => s
                  | Const (s,_) => Long_Name.base_name s
                  | _ => raise TERM ("dest_string'",[t])))
 
-
-fun is_state_space_var Tids t =
-    let
-      fun is_stateT T = (case stateT_id T of NONE => 0
-                         | SOME id => if member (op =) Tids id then ~1 else 0);
-    in
-      (case t of
-         Const _ $ Abs (_,T,_) => is_stateT T
-       | Free (_,T) => is_stateT T
-       | _ => 0)
-    end;
-
-
-datatype callMode = Static | Parameter
-
-fun proc_name Static (Const (p,_)$_) = resuffix deco proc_deco (Long_Name.base_name p)
-  | proc_name Static (Const (@{const_name StateFun.lookup},_)$_$Free (p,_)$_) =
-       suffix proc_deco (remdeco' (Long_Name.base_name p))
-  | proc_name Static p = dest_string' p
-  | proc_name Parameter (Const (p,_)) = resuffix deco proc_deco (Long_Name.base_name p)
-  | proc_name Parameter (Abs (_,_,Const (p,_)$Bound 0)) =
-      resuffix deco proc_deco (Long_Name.base_name p)
-  | proc_name Parameter (Abs (_,_,Const (@{const_name StateFun.lookup},_)$_$Free (p,_)$_)) =
-      suffix proc_deco (remdeco' (Long_Name.base_name p))
-  | proc_name _ t = raise TERM ("proc_name",[t]);
-
-
-
-fun dest_call (Const (@{const_name Language.call},_)$init$pname$return$c) =
-           (init,pname,return,c,Static,true)
-  | dest_call (Const (@{const_name Language.fcall},_)$init$pname$return$_$c) =
-           (init,pname,return,c,Static,true)
-  | dest_call (Const (@{const_name Language.com.Call},_)$pname) =
-           (Bound 0,pname,Bound 0,Bound 0,Static,false)
-  | dest_call (Const (@{const_name Language.dynCall},_)$init$pname$return$c) =
-           (init,pname,return,c,Parameter,true)
-  | dest_call t = raise TERM ("Hoare.dest_call: unexpected term",[t]);
-
-fun dest_whileAnno (Const (@{const_name Language.whileAnnoG},_) $gs$b$I$V$c) =
-        (SOME gs,b,I,V,c,false)
-  | dest_whileAnno (Const (@{const_name Language.whileAnno},_) $b$I$V$c) = (NONE,b,I,V,c,false)
-  | dest_whileAnno (Const (@{const_name Language.whileAnnoGFix},_)$gs$b$I$V$c) =
-        (SOME gs,b,I,V,c,true)
-  | dest_whileAnno (Const (@{const_name Language.whileAnnoFix},_) $b$I$V$c) = (NONE,b,I,V,c,true)
-  | dest_whileAnno t = raise TERM ("Hoare.dest_while: unexpected term",[t]);
-
-fun dest_Guard (Const (@{const_name Language.com.Guard},_)$f$g$c) = (f,g,c,false)
-  | dest_Guard (Const (@{const_name Language.guaranteeStrip},_)$f$g$c) = (f,g,c,true)
-  | dest_Guard t = raise TERM ("Hoare.dest_guard: unexpected term",[t]);
-
+val state_hierarchy = Record.dest_recTs
+fun stateT_id T = case (state_hierarchy T) of [] => NONE | Ts => SOME (last Ts);
+
+fun globalsT (Type (_, T :: _)) = SOME T
+  | globalsT _ = NONE;
+
+fun stateT_ids T =
+  (case stateT_id T of
+     NONE => NONE
+   | SOME sT => (case globalsT T of
+                   NONE => SOME [sT]
+                 | SOME gT => (case stateT_id gT of
+                                 NONE => SOME [sT]
+                                | SOME gT' => SOME [sT,gT'])));
 
 
 (*** extend theory by procedure definition ***)
 
 fun add_declaration name decl thy =
   thy
   |> Named_Target.init [] name
   |> Local_Theory.declaration {syntax = false, pervasive = false, pos = \<^here>} decl
   |> Local_Theory.exit
   |> Proof_Context.theory_of;
 
 (* data kind 'HOL/hoare' *)
 
+type lense = {lookup: term, update : term}
+
 type proc_info =
-  {params: ((par_kind * string) list),
-   recursive: bool,
-   state_kind: state_kind}
+  {
+    params: ((par_kind * string * lense option) list),
+    recursive: bool,
+    state_kind: state_kind
+  };
+
+type state_space =
+  {
+    name: string,
+    is_state_type: Proof.context -> typ -> bool,
+    generalise: Proof.context -> int -> tactic,
+    state_simprocs: simproc list,
+    state_upd_simprocs: simproc list,
+    state_ex_sel_eq_simprocs: simproc list,
+    is_defined: Proof.context -> xstring -> bool,
+    read_function_name: Proof.context -> xstring -> term,
+    lookup_tr: Proof.context -> xstring -> term,
+    update_tr: Proof.context -> xstring -> term,
+    is_lookup: Proof.context -> term -> bool,
+    lookup_tr': Proof.context -> term -> term,
+    dest_update_tr': Proof.context -> term -> term * term * term option,
+    update_tr': Proof.context -> term -> term
+  };
+
 
 type hoare_tac = (bool -> int -> tactic) -> Proof.context -> hoareMode -> int -> tactic;
 
 type hoare_data =
- {proc_info: proc_info Symtab.table,
-  active_procs: string list list,
-  default_state_kind: state_kind,
-  generate_guard: (stamp * (Proof.context -> term -> term option)),
-  wp_tacs: (string * hoare_tac) list,
-  hoare_tacs: (string * hoare_tac) list,
-  vcg_simps: thm list};
+ {
+   proc_info: proc_info Symtab.table,
+   active_procs: string list list,
+   default_state_kind: state_kind,
+   generate_guard: (stamp option * (Proof.context -> term -> term option)),
+   name_tr: (stamp option * (Proof.context -> bool -> string -> string)),
+   hoare_tacs: (string * hoare_tac) list,
+   vcg_simps: thm list,
+   state_spaces: (string * state_space) list
+ };
 
 
 fun make_hoare_data proc_info active_procs default_state_kind generate_guard
-     wp_tacs hoare_tacs vcg_simps =
+     name_tr hoare_tacs vcg_simps state_spaces =
   {proc_info = proc_info, active_procs = active_procs, default_state_kind = default_state_kind,
    generate_guard = generate_guard,
-   wp_tacs = wp_tacs, hoare_tacs = hoare_tacs, vcg_simps = vcg_simps};
+   name_tr = name_tr, hoare_tacs = hoare_tacs, vcg_simps = vcg_simps, state_spaces = state_spaces};
+
+fun merge_stamped err_msg ((NONE, _), p) = p
+  | merge_stamped err_msg (p, (NONE,_)) = p
+  | merge_stamped err_msg ((SOME (stamp1:stamp), x), (SOME stamp2, _)) =
+    if stamp1 = stamp2 then (SOME stamp1, x)
+    else error err_msg;
+
+fun fast_merge merge (x, y) = if pointer_eq (x, y) then x else merge (x, y)
 
 structure Hoare_Data = Generic_Data
 (
   type T = hoare_data;
 
   val empty = make_hoare_data
                (Symtab.empty: proc_info Symtab.table)
                ([]:string list list)
                (Function)
-               (stamp (),(K (K NONE)): Proof.context -> term -> term option)
-               ([]:(string * hoare_tac) list)
+               (NONE,(K (K NONE)): Proof.context -> term -> term option)
+               (NONE,(K (K I)): Proof.context -> bool -> string -> string)
                ([]:(string * hoare_tac) list)
-               ([]:thm list);
-
-  (* FIXME exponential blowup due to append !? *)
-  fun merge ({proc_info = proc_info1, active_procs = active_procs1,
+               ([]:thm list)
+               ([]:(string * state_space) list);
+
+  val merge = fast_merge (fn ({proc_info = proc_info1, active_procs = active_procs1,
                  default_state_kind = _,
-                  generate_guard = (stmp1,generate_gaurd1),
-                 wp_tacs = wp_tacs1, hoare_tacs = hoare_tacs1, vcg_simps = vcg_simps1},
+                  generate_guard = generate_guard1,
+                 name_tr = name_tr1, hoare_tacs = hoare_tacs1, vcg_simps = vcg_simps1, state_spaces=state_spaces1},
                 {proc_info = proc_info2, active_procs = active_procs2,
                  default_state_kind = default_state_kind2,
-                 generate_guard = (stmp2, _),
-                 wp_tacs = wp_tacs2, hoare_tacs = hoare_tacs2, vcg_simps=vcg_simps2}) : T =
-      if stmp1=stmp2 then
+                 generate_guard = generate_guard2,
+                 name_tr = name_tr2, hoare_tacs = hoare_tacs2, vcg_simps=vcg_simps2, state_spaces=state_spaces2}) =>
           make_hoare_data (Symtab.merge (K true) (proc_info1,proc_info2))
                           (active_procs1 @ active_procs2)
                           (default_state_kind2)
-                          (stmp1,generate_gaurd1)
-                          (wp_tacs1 @ wp_tacs2)
-                          (hoare_tacs1 @ hoare_tacs2)
+                          (merge_stamped
+                            "Theories have different aux. functions to generate guards, please resolve before merge"
+                            (generate_guard1, generate_guard2))
+                          (merge_stamped
+                            "Theories have different aux. functions to translate names, please resolve before merge"
+                            (name_tr1, name_tr2))
+                          (AList.merge (op =) (K true) (hoare_tacs1, hoare_tacs2))
                           (Thm.merge_thms (vcg_simps1,vcg_simps2))
-      else error ("Theories have different aux. functions to generate guards")
+                          (AList.merge (op =) (K true) (state_spaces1, state_spaces2)))
 );
 
 val get_data = Hoare_Data.get o Context.Proof;
 
+(* state space representation dependent functions *)
+
+fun get_state_space_comps sel ctxt n =
+ AList.lookup (op =) (#state_spaces (Hoare_Data.get (Context.Proof ctxt))) n
+ |> Option.map sel |> these;
+
+
+fun state_simprocs ctxt Record   = [Record.simproc]
+  | state_simprocs ctxt Function = [Record.simproc, StateFun.lookup_simproc]
+  | state_simprocs ctxt (Other n) = get_state_space_comps (#state_simprocs) ctxt n;
+
+
+fun state_upd_simprocs ctxt Record   = [Record.upd_simproc]
+  | state_upd_simprocs ctxt Function = [StateFun.update_simproc]
+  | state_upd_simprocs ctxt (Other n) = get_state_space_comps (#state_upd_simprocs) ctxt n;
+
+fun state_ex_sel_eq_simprocs ctxt Record   = [Record.ex_sel_eq_simproc]
+  | state_ex_sel_eq_simprocs ctxt Function = [StateFun.ex_lookup_eq_simproc]
+  | state_ex_sel_eq_simprocs ctxt (Other n) = get_state_space_comps (#state_ex_sel_eq_simprocs) ctxt n;
+
+val state_split_simp_tac = Record.split_simp_tac
+val state_hierarchy = Record.dest_recTs
+
+
+fun stateT_id T = case (state_hierarchy T) of [] => NONE | Ts => SOME (last Ts);
+
+fun globalsT (Type (_, T :: _)) = SOME T
+  | globalsT _ = NONE;
+
+fun stateT_ids T =
+  (case stateT_id T of
+     NONE => NONE
+   | SOME sT => (case globalsT T of
+                   NONE => SOME [sT]
+                 | SOME gT => (case stateT_id gT of
+                                 NONE => SOME [sT]
+                                | SOME gT' => SOME [sT,gT'])));
+
 
 (* access 'params' *)
 
 fun mk_free context name =
   let
     val ctxt = Context.proof_of context;
     val n' = Variable.intern_fixed ctxt name |> perhaps Long_Name.dest_hidden;
     val T' = Proof_Context.infer_type ctxt (n', dummyT) handle ERROR _ => dummyT
   in (Free (n',T')) end;
 
 
 fun morph_name context phi name =
   (case Morphism.term phi (mk_free context name) of
      Free (x,_) => x
    | _ => name);
 
 
 datatype 'a bodykind = BodyTyp of 'a | BodyTerm of 'a
 
 fun set_default_state_kind sk context =
   let
-    val {proc_info,active_procs,default_state_kind,generate_guard,wp_tacs,hoare_tacs,
-           vcg_simps,...}
+    val {proc_info,active_procs,default_state_kind,generate_guard,name_tr,hoare_tacs,
+           vcg_simps,state_spaces, ...}
             = Hoare_Data.get context;
       val data = make_hoare_data proc_info active_procs sk
-                   generate_guard wp_tacs hoare_tacs vcg_simps;
+                   generate_guard name_tr hoare_tacs vcg_simps state_spaces;
   in Hoare_Data.put data context end;
 
 val get_default_state_kind = #default_state_kind o get_data;
 
+fun get_default_state_space ctxt =
+  case get_default_state_kind ctxt of
+     Other sp => AList.lookup (op =) (#state_spaces (Hoare_Data.get (Context.Proof ctxt))) sp
+   | _ => NONE
+
 fun add_active_procs phi ps context =
   let
-      val {proc_info,active_procs,default_state_kind,generate_guard,wp_tacs,hoare_tacs,
-           vcg_simps,...}
+      val {proc_info,active_procs,default_state_kind,generate_guard,name_tr,hoare_tacs,
+           vcg_simps,state_spaces, ...}
             = Hoare_Data.get context;
       val data = make_hoare_data proc_info
                    ((map (morph_name context phi) ps)::active_procs)
                    default_state_kind
-                   generate_guard wp_tacs hoare_tacs vcg_simps;
+                   generate_guard name_tr hoare_tacs vcg_simps state_spaces;
   in Hoare_Data.put data context end;
 
 
 fun add_hoare_tacs tacs context =
   let
-      val {proc_info,active_procs, default_state_kind, generate_guard,wp_tacs,hoare_tacs,
-           vcg_simps,...}
+      val {proc_info,active_procs, default_state_kind, generate_guard,name_tr,hoare_tacs,
+           vcg_simps,state_spaces,...}
             = Hoare_Data.get context;
       val data = make_hoare_data proc_info active_procs default_state_kind generate_guard
-                   wp_tacs (hoare_tacs@tacs) vcg_simps;
+                   name_tr (AList.merge (op =) (K true) (hoare_tacs, tacs)) vcg_simps state_spaces;
   in Hoare_Data.put data context end;
 
 fun map_vcg_simps f context =
   let
-      val {proc_info,active_procs,default_state_kind,generate_guard,wp_tacs,hoare_tacs,
-           vcg_simps,...}
+      val {proc_info,active_procs,default_state_kind,generate_guard,name_tr,hoare_tacs,
+           vcg_simps,state_spaces,...}
             = Hoare_Data.get context;
       val data = make_hoare_data proc_info active_procs default_state_kind generate_guard
-                   wp_tacs hoare_tacs (f vcg_simps);
+                   name_tr hoare_tacs (f vcg_simps) state_spaces;
   in Hoare_Data.put data context end;
 
-fun thy_attrib f = Thm.declaration_attribute (fn thm => map_vcg_simps (f thm));
-
-val vcg_simpadd = Thm.add_thm
-val vcg_simpdel = Thm.del_thm
-
-val vcg_simp_add = thy_attrib vcg_simpadd;
-val vcg_simp_del = thy_attrib vcg_simpdel;
+val vcg_simp_add = Thm.declaration_attribute (map_vcg_simps o Thm.add_thm o Thm.trim_context);
+val vcg_simp_del = Thm.declaration_attribute (map_vcg_simps o Thm.del_thm);
 
 
 (* add 'procedure' *)
 
 fun mk_proc_info params recursive state_kind =
    {params=params,recursive=recursive,state_kind=state_kind};
 val empty_proc_info = {params=[],recursive=false,state_kind=Record};
 
 fun map_proc_info_params f {params,recursive,state_kind} =
      mk_proc_info (f params) recursive state_kind;
 fun map_proc_info_recursive f {params,recursive,state_kind} =
      mk_proc_info params (f recursive) state_kind;
 fun map_proc_info_state_kind f {params,recursive,state_kind} =
      mk_proc_info params recursive (f state_kind);
 
 
+fun morph_lense phi ({lookup, update}:lense) =
+  {lookup = Morphism.term phi lookup, update = Morphism.term phi update}:lense;
 
 fun add_params phi name frmls context =
   let
-      val {proc_info,active_procs,default_state_kind,generate_guard,wp_tacs,hoare_tacs,
-           vcg_simps,...}
+      val {proc_info,active_procs,default_state_kind,generate_guard,name_tr,hoare_tacs,
+           vcg_simps,state_spaces, ...}
             = Hoare_Data.get context;
-      val params = map (apsnd (morph_name context phi)) frmls;
+      val params = map (fn (kind, name, lense_opt) =>
+            (kind, morph_name context phi name, Option.map (morph_lense phi) lense_opt)) frmls;
       val f = map_proc_info_params (K params);
       val default = f empty_proc_info;
-      val proc_info' = Symtab.map_default (morph_name context phi name,default) f proc_info;
+      val proc_info' = Symtab.map_default (morph_name context phi name, default) f proc_info;
       val data = make_hoare_data proc_info' active_procs default_state_kind
-                   generate_guard wp_tacs hoare_tacs vcg_simps;
+                   generate_guard name_tr hoare_tacs vcg_simps state_spaces;
   in Hoare_Data.put data context end;
 
 fun get_params name ctxt =
   Option.map #params (Symtab.lookup (#proc_info (get_data ctxt)) name);
 
 
 fun add_recursive phi name context =
   let
-     val {proc_info,active_procs,default_state_kind,generate_guard,wp_tacs,hoare_tacs,
-          vcg_simps,...}
+     val {proc_info,active_procs,default_state_kind,generate_guard,name_tr,hoare_tacs,
+          vcg_simps,state_spaces, ...}
           = Hoare_Data.get context;
      val f = map_proc_info_recursive (K true);
      val default = f empty_proc_info;
      val proc_info'= Symtab.map_default (morph_name context phi name,default) f proc_info;
      val data = make_hoare_data proc_info' active_procs default_state_kind
-                  generate_guard wp_tacs hoare_tacs vcg_simps;
+                  generate_guard name_tr hoare_tacs vcg_simps state_spaces;
   in Hoare_Data.put data context end;
 
 fun get_recursive name ctxt =
   Option.map #recursive (Symtab.lookup (#proc_info (get_data ctxt)) name);
 
 fun add_state_kind phi name sk context =
   let
-     val {proc_info,active_procs,default_state_kind,generate_guard,wp_tacs,hoare_tacs,
-          vcg_simps,...}
+     val {proc_info,active_procs,default_state_kind,generate_guard,name_tr,hoare_tacs,
+          vcg_simps,state_spaces,...}
           = Hoare_Data.get context;
      val f = map_proc_info_state_kind (K sk);
      val default = f empty_proc_info;
      val proc_info'= Symtab.map_default (morph_name context phi name,default) f proc_info;
      val data = make_hoare_data proc_info' active_procs default_state_kind
-                  generate_guard wp_tacs hoare_tacs vcg_simps;
+                  generate_guard name_tr hoare_tacs vcg_simps state_spaces;
   in Hoare_Data.put data context end;
 
 fun get_state_kind name ctxt =
   Option.map #state_kind (Symtab.lookup (#proc_info (get_data ctxt)) name);
 
 fun install_generate_guard f context =
   let
-    val {proc_info,active_procs, default_state_kind, generate_guard,wp_tacs,hoare_tacs,
-         vcg_simps,...} =
+    val {proc_info,active_procs, default_state_kind, generate_guard,name_tr,hoare_tacs,
+         vcg_simps,state_spaces,...} =
          Hoare_Data.get context;
-    val data = make_hoare_data proc_info active_procs default_state_kind (stamp (), f)
-                wp_tacs hoare_tacs vcg_simps
+    val data = make_hoare_data proc_info active_procs default_state_kind (SOME (stamp ()), f)
+                name_tr hoare_tacs vcg_simps state_spaces
   in Hoare_Data.put data context end;
 
 fun generate_guard ctxt = snd (#generate_guard (get_data ctxt)) ctxt;
 
+fun install_state_space sp ctxt =
+  let
+    val {proc_info,active_procs, default_state_kind, generate_guard,name_tr,hoare_tacs,
+         vcg_simps,state_spaces,...} =
+         Hoare_Data.get ctxt;
+    val data = make_hoare_data proc_info active_procs default_state_kind generate_guard
+                name_tr hoare_tacs vcg_simps (AList.update (op =) (#name sp, sp) state_spaces)
+  in Hoare_Data.put data ctxt end;
+
+fun generalise_other ctxt name =
+  Option.map #generalise (AList.lookup (op =) (#state_spaces (get_data ctxt)) name);
+
+fun install_name_tr f ctxt =
+  let
+    val {proc_info,active_procs, default_state_kind, generate_guard,name_tr,hoare_tacs,
+         vcg_simps,state_spaces,...} =
+         Hoare_Data.get ctxt;
+    val data = make_hoare_data proc_info active_procs default_state_kind generate_guard
+                (SOME (stamp ()), f) hoare_tacs vcg_simps state_spaces
+  in Hoare_Data.put data ctxt end;
+
+fun name_tr ctxt = snd (#name_tr (get_data ctxt)) ctxt;
+
+
+(* utils for variable name decorations *)
+
+
+(* removes the suffix of the string beginning with deco.
+ *  "xys_'a" --> "xys";
+ * The a is also chopped, since sometimes the bound variables
+ * are renamed, I think SELECT_GOAL in rename_goal is to blame
+ *)
+fun remdeco' ctxt str =
+    let
+        fun chop (p::ps) (x::xs) = chop ps xs
+          | chop []      xs      = []
+          | chop (p::ps) []      = error "remdeco: code should never be reached";
+
+        fun remove prf (s as (x::xs)) = if is_prefix (op =) prf s then chop prf s
+                                        else (x::remove prf xs)
+          | remove prf [] = [];
+
+    in name_tr ctxt false (String.implode (remove (String.explode deco) (String.explode str))) end;
+
+
+fun remdeco ctxt s = remdeco' ctxt (extern ctxt s);
+
+fun undeco ctxt (Const (c, T)) = Const (remdeco ctxt c, T)
+  | undeco ctxt ((f as Const (@{syntax_const "_free"},_)) $ Free (x, T)) =
+      (*f$*)Const (remdeco' ctxt x, T)
+  | undeco ctxt (Const _ $ _ $ ((Const (@{syntax_const "_free"},_)) $ Free (x, T))) =
+      (*f$*)Const (remdeco' ctxt x, T)
+  | undeco ctxt (Free (c, T)) = Const (remdeco' ctxt c, T)
+  | undeco ctxt x = x
+
+fun is_state_space_var Tids t =
+    let
+      fun is_stateT T = (case stateT_id T of NONE => 0
+                         | SOME id => if member (op =) Tids id then ~1 else 0);
+    in
+      (case t of
+         Const _ $ Abs (_,T,_) => is_stateT T
+       | Free (_,T) => is_stateT T
+       | _ => 0)
+    end;
+
+
+datatype callMode = Static | Parameter
+
+fun proc_name ctxt Static (Const (p,_)$_) = resuffix deco proc_deco (Long_Name.base_name p)
+  | proc_name ctxt Static (Const (@{const_name StateFun.lookup},_)$_$Free (p,_)$_) =
+       suffix proc_deco (remdeco' ctxt (Long_Name.base_name p))
+  | proc_name ctxt Static p = dest_string' p
+  | proc_name ctxt Parameter (Const (p,_)) = resuffix deco proc_deco (Long_Name.base_name p)
+  | proc_name ctxt Parameter (Abs (_,_,Const (p,_)$Bound 0)) =
+      resuffix deco proc_deco (Long_Name.base_name p)
+  | proc_name ctxt Parameter (Abs (_,_,Const (@{const_name StateFun.lookup},_)$_$Free (p,_)$_)) =
+      suffix proc_deco (remdeco' ctxt (Long_Name.base_name p))
+  | proc_name _ _ t = raise TERM ("proc_name",[t]);
+
+
+fun dest_call (Const (@{const_name Language.call},_)$init$pname$return$c) =
+           (init,pname,return,c,Static,true,NONE)
+  | dest_call (Const (@{const_name Language.fcall},_)$init$pname$return$_$c) =
+           (init,pname,return,c,Static,true,NONE)
+  | dest_call (Const (@{const_name Language.com.Call},_)$pname) =
+           (Bound 0,pname,Bound 0,Bound 0,Static,false,NONE)
+  | dest_call (Const (@{const_name Language.dynCall},_)$init$pname$return$c) =
+           (init,pname,return,c,Parameter,true,NONE)
+  | dest_call (Const (@{const_name Language.call_exn},_)$init$pname$return$result_exn$c) =
+           (init,pname,return,c,Static,true,SOME result_exn)
+  | dest_call (Const (@{const_name Language.dynCall_exn},_)$init$pname$return$result_exn$c) =
+           (init,pname,return,c,Parameter,true,SOME result_exn)
+  | dest_call t = raise TERM ("Hoare.dest_call: unexpected term",[t]);
+
+
+fun dest_whileAnno (Const (@{const_name Language.whileAnnoG},_) $gs$b$I$V$c) =
+        (SOME gs,b,I,V,c,false)
+  | dest_whileAnno (Const (@{const_name Language.whileAnno},_) $b$I$V$c) = (NONE,b,I,V,c,false)
+  | dest_whileAnno (Const (@{const_name Language.whileAnnoGFix},_)$gs$b$I$V$c) =
+        (SOME gs,b,I,V,c,true)
+  | dest_whileAnno (Const (@{const_name Language.whileAnnoFix},_) $b$I$V$c) = (NONE,b,I,V,c,true)
+  | dest_whileAnno t = raise TERM ("Hoare.dest_while: unexpected term",[t]);
+
+fun dest_Guard (Const (@{const_name Language.com.Guard},_)$f$g$c) = (f,g,c,false)
+  | dest_Guard (Const (@{const_name Language.guaranteeStrip},_)$f$g$c) = (f,g,c,true)
+  | dest_Guard t = raise TERM ("Hoare.dest_guard: unexpected term",[t]);
+
+
 
 fun check_procedures_definition procs thy =
     let
         val ctxt = Proof_Context.init_global thy;
 
         fun already_defined name =
             if is_some (get_params name ctxt)
             then ["procedure " ^ quote name ^ " already defined"]
             else []
 
         val err_already_defined = maps (already_defined o #1) procs;
 
         fun duplicate_procs names =
             (case duplicates (op =) names of
                [] => []
              | dups => ["Duplicate procedures " ^ commas_quote dups]);
 
         val err_duplicate_procs = duplicate_procs (map #1 procs);
 
         fun duplicate_pars name pars =
             (case duplicates (op =) (map fst pars) of
                [] => []
              | dups => ["Duplicate parameters in procedure "
                         ^ quote name ^ ": " ^ commas_quote dups]);
 
         val err_duplicate_pars =
              maps (fn (name,inpars,outpars,locals,_,_,_) =>
                       duplicate_pars name (inpars @ locals) @
                       duplicate_pars name (outpars @ locals)) procs;
-        (* FIXME: Check that no global variables are used as result parameters *)
+        (* fixme: Check that no global variables are used as result parameters *)
         val errs = err_already_defined @ err_duplicate_procs @ err_duplicate_pars;
     in if null errs then () else error (cat_lines errs)
     end;
 
 
 fun add_parameter_info phi cname (name,(inpars,outpars,state_kind)) context =
     let fun par_deco' T = if T = "" then deco else par_deco (cname name);
-        val pars = map (fn (par,T) => (In,suffix (par_deco' T) par)) inpars@
-                   map (fn (par,T) => (Out,suffix (par_deco' T) par)) outpars;
-    in
-      context
-      |> add_params phi name pars
-      |> add_state_kind phi name state_kind
+        val pars = map (fn (par,T) => (In,suffix (par_deco' T) par, NONE)) inpars@
+                   map (fn (par,T) => (Out,suffix (par_deco' T) par, NONE)) outpars;
+
+        val ctxt_decl = context
+              |> add_params phi name pars
+              |> add_state_kind phi name state_kind
+    in ctxt_decl
     end;
 
 fun mk_loc_exp xs =
   let fun mk_expr s = (s,(("",false),(Expression.Named [],[])))
   in (map mk_expr xs,[]) end;
 
 val parametersN = "_parameters";
 val variablesN = "_variables";
 val signatureN = "_signature";
 val bodyN      = "_body";
 val implementationN = "_impl";
 val cliqueN = "_clique";
 val clique_namesN = "_clique_names";
 val NoBodyN = @{const_name Vcg.NoBody};
 val statetypeN = "StateType";
 val proc_nameT = HOLogic.stringT;
 
 fun expression_no_pos (expr, fixes) : Expression.expression =
   (map (fn (name, inst) => ((name, Position.none), inst)) expr, fixes);
 
 fun add_locale name expr elems thy =
   thy
   |> Expression.add_locale (Binding.name name) (Binding.name name) [] expr elems
   |> snd
   |> Local_Theory.exit;
 
 fun add_locale' name expr elems thy =
   thy
   |> Expression.add_locale (Binding.name name) (Binding.name name) [] expr elems
   ||> Local_Theory.exit;
 
 fun add_locale_cmd name expr elems thy =
   thy
   |> Expression.add_locale_cmd (Binding.name name) (Binding.name name) []
     (expression_no_pos expr) elems
   |> snd
   |> Local_Theory.exit;
 
 fun read_typ thy raw_T env =
   let
     val ctxt' =
       Proof_Context.init_global thy
       |> fold (Variable.declare_typ o TFree) env;
     val T = Syntax.read_typ ctxt' raw_T;
     val env' = Term.add_tfreesT T env;
   in (T, env') end;
 
 fun add_variable_statespaces (cname, (inpars, outpars, locvars)) thy =
   let
     val inpars'  = if forall (fn (_,T) => T = "") inpars then [] else inpars;
     val outpars' = if forall (fn (_,T) => T = "") outpars then [] else outpars;
     fun prep_comp (n, T) env =
       let
         val (T', env') = read_typ thy T env handle ERROR msg =>
           cat_error msg ("The error(s) above occurred in component " ^ quote n)
       in ((n, T'), env') end;
 
     val (in_outs,in_out_env) = fold_map prep_comp (distinct (op =) (inpars'@outpars')) [];
     val (locs,var_env) = fold_map prep_comp locvars in_out_env;
 
     val parSP = cname ^ parametersN;
     val in_outs' = map (apfst (suffix (par_deco cname))) in_outs;
     val in_out_args = map fst in_out_env;
 
     val varSP = cname ^ variablesN;
     val locs' = map (apfst (suffix (par_deco cname))) locs;
     val var_args = map fst var_env;
 
   in if null inpars' andalso null outpars' andalso null locvars
      then
        thy
        |> add_locale_cmd parSP ([],[]) [] |> Proof_Context.theory_of
        |> add_locale_cmd varSP ([],[]) [] |> Proof_Context.theory_of
      else
        thy
        |> StateSpace.define_statespace_i (SOME statetypeN) in_out_args parSP [] in_outs'
        |> StateSpace.define_statespace_i (SOME statetypeN)
            var_args varSP [((cname, false), ((map TFree in_out_env),parSP,[]))] locs'
   end;
 
 fun intern_locale thy = Locale.intern thy #> perhaps Long_Name.dest_hidden;
 
 fun apply_in_context thy lexp f t =
   let
     fun name_variant lname =
          if intern_locale thy lname = lname then lname
          else name_variant (lname ^ "'");
   in
     thy
     (* Create a dummy locale in dummy theory just to read the term *)
     |> add_locale_cmd (name_variant "foo") lexp []
     |> (fn ctxt => f ctxt t)
   end;
 
 fun add_abbrev loc mode name spec thy =
   thy
   |> Named_Target.init [] loc
   |> (fn lthy => let val t = Syntax.read_term (Local_Theory.target_of lthy) spec;
       in Local_Theory.abbrev mode ((Binding.name name, NoSyn), t) lthy end)
   |> #2
   |> Local_Theory.exit
   |> Proof_Context.theory_of;
 
 
 exception TOPSORT of string
 fun topsort less [] = []
   | topsort less xs =
   let
     fun list_all P xs = fold (fn x => fn b => b andalso P x) xs true;
 
     fun split_min n (x::xs) =
       if n=0 then raise TOPSORT "no minimum in list"
       else if list_all (less x) xs then (x,xs)
       else split_min (n-1) (xs@[x]);
 
     fun tsort [] = []
       | tsort xs = let val (x,xs') = split_min (length xs) xs;
                    in x::tsort xs' end;
   in tsort xs end;
 
 
 fun clique_name clique =
       (foldr1 (fn (a,b) => a ^ "_" ^ b) (map (unsuffix proc_deco) clique));
 
 
 fun error_to_warning msg f thy =
   f thy handle ERROR msg' => (warning (msg' ^ "\n" ^ msg); thy);
 
 
 fun procedures_definition locname procs thy =
   let
     val procs' = map (fn (name,a,b,c,d,e,f) => (suffix proc_deco name,a,b,c,d,e,f)) procs;
     val _ = check_procedures_definition procs' thy;
     val name_pars  =
          map (fn (name,inpars,outpars,_,_,_,sk)  => (name,(inpars,outpars,sk))) procs';
     val name_vars = map (fn (name,inpars,outpars,locals,_,_,_)  =>
                             (name,(inpars,outpars,locals))) procs';
     val name_body  = map (fn (name,_,_,_,body,_,_)  => (name,body)) procs';
     val name_pars_specs = map (fn (name,inpars,outpars,_,_,specs,sk) =>
                                   (name,(inpars,outpars,sk),specs)) procs';
     val names       = map #1 procs';
     val sk = #7 (hd procs');
 
     val thy = thy |> Context.theory_map (set_default_state_kind sk);
 
     val (all_callss,cliques,is_recursive,has_body) =
       let
         val context =
           Context.Theory thy
           |> fold (add_parameter_info  Morphism.identity (unsuffix proc_deco)) name_pars
           |> Config.put_generic StateSpace.silent true
 
         fun read_body (_, body) =
           Syntax.read_term (Context.proof_of context) body;
 
         val bodies = map read_body name_body;
         fun dcall t =
           (case try dest_call t of
-             SOME (_,p,_,_,m,_) => SOME (proc_name m p)
+             SOME (_,p,_,_,m,_,_) => SOME (proc_name (Context.proof_of context) m p)
            | _ => NONE);
         fun in_names x = if member (op =) names x then SOME x else NONE;
         fun add_edges n = fold (fn x => Graph.add_edge (n, x));
 
         val all_callss = map (map snd o max_subterms_dest dcall) bodies;
         val callss = map (map_filter in_names) all_callss;
         val graph = fold (fn n => Graph.new_node (n, ())) names Graph.empty;
         val graph' = fold2 add_edges names callss graph;
         fun idx x = find_index (fn y => x=y) names;
         fun name_ord (a,b) = int_ord (idx a, idx b);
         val cliques = Graph.strong_conn graph';
         val cliques' = map (sort name_ord) cliques;
 
         val my_calls = these o AList.lookup (op =) (names ~~ map (distinct (op =)) callss);
         val my_body = AList.lookup (op =) (names ~~ bodies);
 
         fun is_recursive n =
           exists (fn [_] => false | ns => member (op =) ns n) (Graph.strong_conn graph');
 
         fun has_body n =
           (case my_body n of
              SOME (Const (c,_)) => c <> NoBodyN
            | _ => true)
 
         fun clique_less c1 c2 = null
           (inter (op =) (distinct (op =) (maps my_calls c1)) c2);
 
         val cliques'' = topsort clique_less cliques';
       in (all_callss,cliques'',is_recursive,has_body) end;
 
     (* cliques may only depend on ones to the left, so it is safe to
      * add the locales from the left to the right. *)
 
     fun my_clique n = Library.find_first (fn c => member (op =) c n) cliques;
 
     fun lname sfx clique = suffix sfx (clique_name clique);
     fun cname n = clique_name (the (my_clique n));
     fun parameter_info_decl phi = fold (add_parameter_info phi cname) name_pars;
 
 
     fun get_loc sfx clique n =
         if member (op =) clique n then NONE else SOME (resuffix proc_deco sfx n);
 
     fun parent_locales thy sfx clique =
       let
         val calls = distinct (op =) (flat
                      (map_filter (AList.lookup (op =) (names ~~ all_callss)) clique));
       in map (intern_locale thy)
             (distinct (op =) (map_filter (get_loc sfx clique) calls))
       end;
 
     val names_all_callss = names ~~ map (distinct (op =)) all_callss;
     val get_calls = the o AList.lookup (op =) names_all_callss;
 
     fun clique_vars clique =
       let
         fun add name (ins,outs,locs) =
          let val (nins,nouts,nlocs) = the (AList.lookup (op =) name_vars name)
          in (ins@nins,outs@nouts,locs@nlocs) end;
         val (is,os,ls) = fold add clique ([],[],[]);
       in (lname "" clique, (distinct (op =) is, distinct (op =) os, distinct (op =) ls)) end;
 
     fun add_signature_locale (cname, name) thy =
       let
         val name' = unsuffix proc_deco name;
         val fixes = [Element.Fixes [(Binding.name name, SOME proc_nameT, NoSyn)]];
-        (* FIXME: may use HOLogic.typeT as soon as locale type-inference works properly *)
+        (* fixme: may use HOLogic.typeT as soon as locale type-inference works properly *)
         val pE = mk_loc_exp [intern_locale thy (suffix parametersN cname)];
         val sN = suffix signatureN  name';
       in thy
          |> add_locale sN pE fixes
          |> Proof_Context.theory_of
          |> (fn thy => add_declaration (intern_locale thy sN) parameter_info_decl thy)
       end;
 
 
    fun mk_bdy_def read_term name =
       let
         val name' = unsuffix proc_deco name;
         val bdy = read_term (the (AList.lookup (op =) name_body name));
         val bdy_defN = suffix body_def_sfx name';
         val b = Binding.name bdy_defN;
       in ((b, NoSyn), ((Thm.def_binding b, []), bdy)) end;
 
    fun add_body_locale (name, _) thy =
       let
         val name' = unsuffix proc_deco name;
         val callees = filter_out (fn n => n = name) (get_calls name)
 
         val fixes = [Element.Fixes [(Binding.name name, SOME proc_nameT, NoSyn)]];
-            (* FIXME: may use HOLogic.typeT as soon as locale type-inference works properly *)
+            (* fixme: may use HOLogic.typeT as soon as locale type-inference works properly *)
         val pE = mk_loc_exp
                   (map (intern_locale thy)
                     ([lname variablesN (the (my_clique name))]@
                      the_list locname@
                      map (resuffix proc_deco signatureN) callees));
 
 
         fun def lthy =
           let val read = Syntax.read_term
                           (Context.proof_map (add_active_procs Morphism.identity
                              (the (my_clique name)))
                            (Local_Theory.target_of lthy))
           in mk_bdy_def read name
           end;
 
         fun add_decl_and_def lname ctxt =
             ctxt
             |> Proof_Context.theory_of
             |> Named_Target.init [] lname
             |> Local_Theory.declaration {syntax = false, pervasive = false, pos = \<^here>} parameter_info_decl
             |> (fn lthy => if has_body name
                            then snd (Local_Theory.define (def lthy) lthy)
                            else lthy)
             |> Local_Theory.exit
             |> Proof_Context.theory_of;
 
       in thy
          |> add_locale' (suffix bodyN name') pE fixes
          |-> add_decl_and_def
       end;
 
    fun mk_def_eq thy read_term name =
       if has_body name
       then
          let
-           (* FIXME: All the read_term stuff is just because type-inference/abbrevs for
+           (* fixme: All the read_term stuff is just because type-inference/abbrevs for
             * new locale elements does not work right now;
             * We read the term to expand the abbreviations, then we print it again
             * (without folding the abbreviation) and reread as string  *)
            val name' = unsuffix proc_deco name;
            val bdy_defN = suffix body_def_sfx name';
            val rhs = read_term ("Some " ^ bdy_defN);
            val nt  = read_term name;
            val Free (gamma,_) = read_term programN;
            val eq = HOLogic.Trueprop$
                      HOLogic.mk_eq (Free (gamma,fastype_of nt --> fastype_of rhs)$nt,rhs)
            val consts = Sign.consts_of thy;
            val eqs =
-            YXML.string_of_body (Term_XML.Encode.term consts (Consts.dummy_types consts eq));
+             YXML.string_of_body (Term_XML.Encode.term consts (Consts.dummy_types consts eq));
            val assms = Element.Assumes [((Binding.name (suffix bodyP name'), []),[(eqs,[])])]
          in [assms]
          end
       else [];
 
    fun add_impl_locales clique thy =
       let
         val cliqN =  lname cliqueN clique;
         val cnamesN = lname clique_namesN clique;
         val multiple_procs = length clique > 1;
         val add_distinct_procs_namespace =
             if multiple_procs
             then StateSpace.namespace_definition cnamesN proc_nameT ([],[]) [] clique
             else I;
         val bodyLs = map (suffix bodyN o unsuffix proc_deco) clique;
         fun pE thy = mk_loc_exp (map (intern_locale thy) (hoare_ctxtL::bodyLs)
                               @ (parent_locales thy implementationN clique)
                               @ (if multiple_procs then [intern_locale thy cnamesN] else []));
         fun read_term thy = apply_in_context thy (pE thy) Syntax.read_term;
         fun elems thy = maps (mk_def_eq thy (read_term thy)) clique;
         fun add_recursive_info phi name =
             if is_recursive name then (add_recursive phi name) else I;
         fun proc_declaration phi = add_active_procs phi clique;
         fun recursive_declaration phi context =
             context |> fold (add_recursive_info phi) clique;
 
 
         fun add_impl_locale name thy =
           let
             val implN = suffix implementationN (unsuffix proc_deco name);
             val parentN = intern_locale thy cliqN
             val parent = mk_loc_exp [parentN];
           in thy
              |> add_locale_cmd implN parent []
              |> Proof_Context.theory_of
              |> (fn thy => Interpretation.global_sublocale parentN
                   (mk_loc_exp [intern_locale thy implN]) [] thy)
              |> Proof.global_terminal_proof
                  ((Method.Basic (fn ctxt => Method.SIMPLE_METHOD
                    (Locale.intro_locales_tac {strict = true, eager = false} ctxt [])), Position.no_range), NONE)
              |> Proof_Context.theory_of
           end;
 
       in thy
          |> add_distinct_procs_namespace
          |> (fn thy =>
               add_locale_cmd cliqN (pE thy) (elems thy) thy)
          |> Proof_Context.theory_of
          |> fold add_impl_locale clique
          |> (fn thy => add_declaration (intern_locale thy cliqN) proc_declaration thy)
          |> (fn thy => add_declaration (intern_locale thy cliqN)
                 recursive_declaration thy)
       end;
 
    fun add_spec_locales (name, _, specs) thy =
       let
         val name' = unsuffix proc_deco name;
         val ps = (suffix signatureN name' :: the_list locname);
         val ps' = hoare_ctxtL :: ps ;
         val pE = mk_loc_exp (map (intern_locale thy) ps)
         val pE' = mk_loc_exp (map (intern_locale thy) ps')
 
         fun read thy =
          apply_in_context thy
             (mk_loc_exp [intern_locale thy (suffix cliqueN (cname name))])
             (Syntax.read_prop);
 
         fun proc_declaration phi =
                  (*parameter_info_decl phi o  already in signature *)
                  add_active_procs phi (the (my_clique name));
 
         fun add_locale'' (thm_name,spec) thy =
           let
             val spec' = read thy spec;
             val elem = Element.Assumes [((Binding.name thm_name, []), [(spec', [])])];
           in thy
              |> add_locale thm_name pE' [elem]
              |> Proof_Context.theory_of
              |> (fn thy =>
                   add_declaration (intern_locale thy thm_name) proc_declaration thy)
              |> error_to_warning ("abbreviation: '" ^ thm_name  ^ "' not added")
                   (add_abbrev (intern_locale thy (suffix cliqueN (cname name))) Syntax.mode_input thm_name spec)
           end;
       in thy |> fold add_locale'' specs end;
 
   in
     thy
     |> fold (add_variable_statespaces o clique_vars) cliques
     |> fold (fn c => fold (fn n => add_signature_locale (lname "" c, n)) c) cliques
     |> fold add_body_locale name_pars
     |> fold add_impl_locales cliques
     |> fold add_spec_locales name_pars_specs
   end;
 
 
 
 (*********************  theory extender interface ********************************)
 
 (** package setup **)
 
 (* outer syntax *)
 
 val var_declP  = Parse.name -- (@{keyword "::"} |-- Parse.!!! Parse.embedded);
 val var_declP' = Parse.name >> (fn n => (n,""));
 
 val localsP = Scan.repeat var_declP;
 
 val argP = var_declP;
 val argP' = var_declP';
 
 val not_eqP = Scan.ahead (Scan.unless @{keyword "="} (Scan.one (K true)))
 
 val proc_decl_statespace =
   (Parse.short_ident --| @{keyword "("}) --
       ((Parse.list argP) -- (Scan.optional (@{keyword "|"} |-- Parse.list argP) []) --| @{keyword ")"})
       --| not_eqP
 
 val proc_decl_record =
   (Parse.short_ident --| @{keyword "("}) --
       ((Parse.list argP') -- (Scan.optional (@{keyword "|"} |-- Parse.list argP') []) --| @{keyword ")"})
       --| Scan.option @{keyword "="}
 
 val proc_decl = proc_decl_statespace >> pair Function || proc_decl_record >> pair Record;
 
 val loc_decl = Scan.optional (@{keyword "where"} |-- localsP --| @{keyword "in"}) []
 
 val proc_body = Parse.embedded (*>> BodyTerm*)
 
 
 fun proc_specs x = (Parse.!!! (Scan.repeat (Parse_Spec.thm_name ":" -- Parse.embedded))
     >> map (fn ((thm_name, _), prop) => (Binding.name_of thm_name, prop))) x
 
 val par_loc =
   Scan.option (@{keyword "("} |-- @{keyword "imports"} |-- Parse.name --| @{keyword ")"});
 
 
 val _ =
   Outer_Syntax.command @{command_keyword procedures} "define procedures"
     (par_loc -- (Parse.and_list1 (proc_decl -- loc_decl -- proc_body -- proc_specs))
       >> (fn (loc,decls) =>
           let
             val decls' = map (fn ((((state_kind,(name,(ins,outs))),ls),bdy),specs) =>
                                  (name,ins,outs,ls,bdy,specs,state_kind))
                            decls
           in Toplevel.theory (procedures_definition loc decls')
           end));
 
 
 val _ =
   Outer_Syntax.command @{command_keyword hoarestate} "define state space for hoare logic"
     (StateSpace.statespace_decl >> (fn ((args,name),(parents,comps)) =>
       Toplevel.theory
         (StateSpace.define_statespace args name parents (map (apfst (suffix deco)) comps))));
 
 
 
 (***************************  Auxiliary Functions for integration of  ********************)
 (***************************  automatic program analysers             ********************)
 
 fun dest_conjs t =
   (case HOLogic.dest_conj t of
      [t1,t2] => dest_conjs t1 @ dest_conjs t2
    | ts => ts);
 
 fun split_guard (Const (@{const_name Collect},CT)$(Abs (s,T,t))) =
      let
        fun mkCollect t = Const (@{const_name Collect},CT)$(Abs (s,T,t));
      in map mkCollect (dest_conjs t) end
   | split_guard t = [t];
 
 fun split_guards gs =
   let
     fun norm c f g = map (fn g => c$f$g) (split_guard g);
     fun norm_guard ((c as Const (@{const_name Pair},_))$f$g) = norm c f g
       | norm_guard ((c as Const (@{const_name Language.guaranteeStripPair},_))$f$g) = norm c f g
       | norm_guard t = [t];
   in maps norm_guard (HOLogic.dest_list gs)
   end
 
 fun fold_com f t =
   let
     (* traverse does not descend into abstractions, like in DynCom, call, etc. *)
     fun traverse cnt (c as Const (@{const_name Language.com.Skip},_)) = (cnt,f cnt c [] [])
       | traverse cnt ((c as Const (@{const_name Language.com.Basic},_))$g) = (cnt, f cnt c [g] [])
       | traverse cnt ((c as Const (@{const_name Language.com.Spec},_))$r) = (cnt, f cnt c [r] [])
       | traverse cnt ((c as Const (@{const_name Language.com.Seq},_))$c1$c2) =
           let
             val (cnt1,v1) = traverse cnt c1;
             val (cnt2,v2) = traverse cnt1 c2;
           in (cnt2, f cnt c [] [v1,v2]) end
       | traverse cnt ((c as Const (@{const_name Language.com.Cond},_))$b$c1$c2) =
           let
             val (cnt1,v1) = traverse cnt c1;
             val (cnt2,v2) = traverse cnt1 c2;
           in (cnt2, f cnt c [b] [v1,v2]) end
       | traverse cnt ((c as Const (@{const_name Language.com.While},_))$b$c1) =
           let val (cnt1,v1) = traverse cnt c1 in (cnt1, f cnt c [b] [v1]) end
       | traverse cnt ((c as Const (@{const_name Language.com.Call},_))$p) = (cnt, f cnt c [p] [])
       | traverse cnt ((c as Const (@{const_name Language.com.DynCom},_))$c1) = (cnt, f cnt c [c1] [])
       | traverse cnt ((c as Const (@{const_name Language.com.Guard},_))$flt$g$c1) =
           let val (cnt1,v1) = traverse (cnt + length (split_guard g)) c1
           in (cnt1, f cnt c [flt,g] [v1]) end
       | traverse cnt (c as Const (@{const_name Language.com.Throw},_)) = (cnt,f cnt c [] [])
       | traverse cnt ((c as Const (@{const_name Language.com.Catch},_))$c1$c2) =
           let
             val (cnt1,v1) = traverse cnt c1;
             val (cnt2,v2) = traverse cnt1 c2;
           in (cnt2, f cnt c [] [v1,v2]) end
       | traverse cnt ((c as Const (@{const_name Language.guards},_))$gs$c1) =
           let
             val (cnt1,v1) = traverse (cnt + length (split_guards gs)) c1;
           in (cnt1, f cnt c [gs] [v1]) end
       | traverse cnt ((c as Const (@{const_name Language.block},_))$init$c1$return$c2) =
           let val (cnt1,v1) = traverse cnt c1 in (cnt1, f cnt c [init,return,c2] [v1]) end
       | traverse cnt ((c as Const (@{const_name Language.call},_))$init$p$return$c1) =
            (cnt, f cnt c [init,p,return,c1] [])
       | traverse cnt ((c as Const (@{const_name Language.whileAnno},_))$b$I$V$c1) =
           let val (cnt1,v1) = traverse cnt c1 in (cnt1, f cnt c [b,I,V] [v1]) end
       | traverse cnt ((c as Const (@{const_name Language.whileAnnoG},_))$gs$b$I$V$c1) =
           let val (cnt1,v1) = traverse (cnt + length (split_guards gs)) c1
           in (cnt1, f cnt c [gs,b,I,V] [v1]) end
       | traverse _ t = raise TERM ("fold_com: unknown command",[t]);
    in snd (traverse 0 t) end;
 
 (***************************  Tactics ****************************************************)
 
 
 (*** Aux. tactics ***)
 
 
 fun cond_rename_bvars cond name thm =
   let
     fun rename (tm as (Abs (x, T, t))) =
           if cond tm then Abs (name x, T, rename t) else Abs (x, T, rename t)
       | rename (t $ u) = rename t $ rename u
       | rename a = a;
   in Thm.renamed_prop (rename (Thm.prop_of thm)) thm end;
 
 val rename_bvars = cond_rename_bvars (K true);
 
-fun trace_tac ctxt str st = (if Config.get ctxt hoare_trace then tracing str else (); all_tac st);
+fun trace_msg ctxt str = if Config.get ctxt hoare_trace > 0 then tracing str else ()
+fun trace_tac ctxt str st = (trace_msg ctxt str; all_tac st);
+
+fun trace_subgoal_tac ctxt s i =
+    SUBGOAL (fn (prem, _) => trace_tac ctxt (s ^ (Syntax.string_of_term ctxt prem))) i
+
 
 fun error_tac str st = (error str;no_tac st);
 
 fun rename_goal ctxt name =
     EVERY' [K (trace_tac ctxt "rename_goal -- START"),
             SELECT_GOAL (PRIMITIVE (rename_bvars name)),
             K (trace_tac ctxt "rename_goal -- STOP")];
 
 (* splits applications of tupled arguments to a schematic Variables, e.g.
  *  ALL a b. ?P (a,b) --> ?Q (a,b) gets
  *  ALL a b. ?P a b --> ?Q a b
  * only tuples nested to the right are splitted.
  *)
 fun split_pair_apps ctxt thm =
   let
     val t = Thm.prop_of thm;
     fun mk_subst subst (Abs (x,T,t)) = mk_subst subst t
       | mk_subst subst (t as (t1$t2)) =
          (case strip_comb t of
             (var as Var (v,vT),args) =>
             (if not (AList.defined (op =) subst var)
              then
               let
                 val len = length args;
                 val (argTs,bdyT) = strip_type vT;
                 val (z, _) = Name.variant "z" (fold Term.declare_term_frees args Name.context);
                 val frees = map (apfst (fn i => z^string_of_int i))
                                 (0 upto (len - 1) ~~ argTs);
                 fun splitT (Type (@{type_name Product_Type.prod}, [T1, T2])) = T1::splitT T2
                   | splitT T = [T];
 
                 fun pair_depth (Const (@{const_name Pair},aT)$t1$t2) = 1 + (pair_depth t2)
                   | pair_depth _ = 0;
 
                 fun mk_sel max free i  =
                   let val snds = funpow i HOLogic.mk_snd (Free free)
                   in if i=max then snds else HOLogic.mk_fst snds end;
 
 
                 fun split (free,arg) =
                   let
                     val depth = (pair_depth arg);
                   in if depth = 0 then [Free free]
                      else map (mk_sel depth free) (0 upto depth)
                   end;
 
 
                 val args' = maps split (frees ~~ args);
                 val argTs' = maps splitT argTs;
                 val inst = fold_rev absfree frees (list_comb (Var (v,argTs' ---> bdyT), args'))
               in subst@[(var,inst)]
               end
              else subst)
           | _ =>  mk_subst (mk_subst subst t1) t2)
       | mk_subst subst t = subst;
 
   val subst = map (fn (v,t) => (dest_Var v, Thm.cterm_of ctxt t)) (mk_subst [] t);
 
   in full_simplify (put_simpset HOL_basic_ss ctxt addsimps [@{thm fst_conv}, @{thm snd_conv}])
        (Drule.instantiate_normalize (TVars.empty, Vars.make subst) thm)
   end;
 
 (* Generates split theorems, for !!,!,? quantifiers and for UN, e.g.
  * ALL x. P x = ALL a b. P a b
  *)
 fun mk_split_thms ctxt (vars as _::_)  =
   let
     val thy = Proof_Context.theory_of ctxt;
     val names = map fst vars;
     val types = map snd vars;
     val free_vars = map Free vars;
     val pT = foldr1 HOLogic.mk_prodT types;
     val x = (singleton (Name.variant_list names) "x", pT);
     val xp = foldr1 HOLogic.mk_prod free_vars;
     val tfree_names = fold Term.add_tfree_names free_vars [];
     val zeta = TFree (singleton (Name.variant_list tfree_names) "z", Sign.defaultS thy);
 
     val split_meta_prop =
       let val P = Free (singleton (Name.variant_list names) "P", pT --> Term.propT)
       in Logic.mk_equals (Logic.all (Free x) (P $ Free x), fold_rev Logic.all free_vars (P $ xp))
       end;
 
     val P = Free (singleton (Name.variant_list names) "P", pT --> HOLogic.boolT);
 
     val split_object_prop =
       let fun ALL vs t = Library.foldr (fn ((v,T),t) => HOLogic.mk_all (v,T,t)) (vs,t)
       in (ALL [x] (P $ Free x)) === (ALL vars (P $ xp))
       end;
 
     val split_ex_prop =
       let fun EX vs t = Library.foldr (fn ((v,T),t) => HOLogic.mk_exists (v,T,t)) (vs,t)
       in (EX [x] (P $ Free x)) === (EX vars (P $ xp))
       end;
 
     val split_UN_prop =
       let val P = Free (singleton (Name.variant_list names) "P", pT --> HOLogic.mk_setT zeta);
           fun UN vs t = Library.foldr mk_UN (vs, t)
       in (UN [x] (P $ Free x)) === (UN vars (P $ xp))
       end;
 
     fun prove_simp simps prop =
-      let val ([prop'], _) = Variable.importT_terms [prop] ctxt  (* FIXME continue context!? *)
+      let val ([prop'], _) = Variable.importT_terms [prop] ctxt  (* fixme continue context!? *)
       in
         Goal.prove_global thy [] [] prop'
           (fn {context = goal_ctxt, ...} =>
             ALLGOALS (simp_tac (put_simpset HOL_basic_ss goal_ctxt addsimps simps)))
       end;
 
     val split_meta   = prove_simp [@{thm split_paired_all}] split_meta_prop;
     val split_object = prove_simp [@{thm split_paired_All}] split_object_prop;
     val split_ex     = prove_simp [@{thm split_paired_Ex}] split_ex_prop;
     val split_UN     = prove_simp [@{thm Hoare.split_paired_UN}] split_UN_prop;
   in [split_meta,split_object,split_ex,split_UN]
   end
  | mk_split_thms _ _ = raise Match;
 
 
 fun rename_aux_var name rule =
   let fun is_aux_var (Abs ("Z",TVar(_,_),_)) = true
         | is_aux_var _ = false;
   in cond_rename_bvars is_aux_var (K name) rule end;
 
 (* adapts single auxiliary variable in a rule to potentialy multiple auxiliary
  * variables in actual specification, e.g. if vars are a b,
  * split_app=false: ALL Z. ?P Z gets to ALL a b. ?P (a,b)
  * split_app=true:  ALL Z. ?P Z gets to ALL a b. ?P a b
  * If only one auxiliary variable is given, the variables are just renamed,
  * If no auxiliary is given, unit is inserted for Z:
  * ALL Z. ?P Z gets P ()
  *)
 fun adapt_aux_var ctxt split_app (vars as (_::_::_)) tvar_rules =
      let
        val thy = Proof_Context.theory_of ctxt;
        val max_idx = fold Integer.max (map (Thm.maxidx_of o snd) tvar_rules) 0;
        val types = map (fn i => TVar (("z",i),Sign.defaultS thy))
                     (max_idx + 1 upto (max_idx + length vars));
        fun tvar n = (n, Sign.defaultS thy);
        val pT = Thm.ctyp_of ctxt (foldr1 HOLogic.mk_prodT types);
        val rules' = map (fn (z,r) => (Drule.instantiate_normalize (TVars.make [(tvar z,pT)], Vars.empty) r)) tvar_rules;
        val splits = mk_split_thms ctxt (vars ~~ types);
        val rules'' = map (full_simplify (put_simpset HOL_basic_ss ctxt addsimps splits)) rules';
      in if split_app then (map (split_pair_apps ctxt) rules'') else rules'' end
   | adapt_aux_var _ _ ([name]) tvar_rules = map (rename_aux_var name o snd) tvar_rules
   | adapt_aux_var ctxt _ ([]) tvar_rules =
       let
         val thy = Proof_Context.theory_of ctxt;
         fun tvar n = (n, Sign.defaultS thy);
         val uT = Thm.ctyp_of ctxt HOLogic.unitT;
         val rules' = map (fn (z,r) => (Drule.instantiate_normalize (TVars.make [(tvar z,uT)], Vars.empty) r)) tvar_rules;
         val splits = [@{thm Hoare.unit_meta},@{thm Hoare.unit_object},@{thm Hoare.unit_ex},@{thm Hoare.unit_UN}];
         val rules'' = map (full_simplify (put_simpset HOL_basic_ss ctxt addsimps splits)) rules';
       in rules'' end
 
 
 (* Generates a rule for recursion for n procedures out of general recursion rule *)
 fun gen_call_rec_rule ctxt specs_name n rule =
   let
     val thy = Proof_Context.theory_of ctxt;
     val maxidx = Thm.maxidx_of rule;
     val vars = Term.add_vars (Thm.prop_of rule) [];
     fun get_type n = the (AList.lookup (op =) vars (n, 0));
     val (Type (_, [Type (_, [assT, Type (_, [pT,_])])])) = get_type specs_name;
     val zT = TVar (("z",maxidx+1),Sign.defaultS thy)
 
     fun mk_var i n T = Var ((n ^ string_of_int i,0),T);
 
     val quadT = HOLogic.mk_prodT (assT,
                           HOLogic.mk_prodT (pT,
                            HOLogic.mk_prodT (assT,assT)));
     val quadT_set = HOLogic.mk_setT quadT;
     fun mk_spec i =
       let
          val quadruple = HOLogic.mk_ptuple (HOLogic.flat_tupleT_paths quadT) quadT
                 [mk_var i "P" (zT --> assT)$Bound 0,
                  mk_var i "p" pT,
                  mk_var i "Q" (zT --> assT)$Bound 0,
                  mk_var i "A" (zT --> assT)$Bound 0];
          val single = HOLogic.mk_set quadT [quadruple];
      in mk_UN' zT quadT_set (Abs ("Z", zT, single)) end;
 
      val Specs = foldr1 (mk_Un quadT_set) (map mk_spec (1 upto n));
      val rule' =
        Thm.instantiate' [] [SOME (Thm.cterm_of ctxt Specs)] rule
        |> full_simplify (put_simpset (simpset_of @{theory_context Main}) ctxt
               addsimps [@{thm Hoare.conjE_simp},@{thm Hoare.in_Specs_simp},@{thm Hoare.in_set_Un_simp},@{thm split_all_conj},
                         @{thm image_Un},@{thm image_Un_single_simp}] )
        |> rename_bvars (fn s => if member (op =) ["s","\<sigma>"] s then s else "Z")
   in rule'
   end;
 
 fun gen_proc_rec ctxt mode n =
   gen_call_rec_rule ctxt "Specs" n (ProcRecSpecs mode);
 
 (*** verification condition generator ***)
 
 (* simplifications on "Collect" sets, like {s. P s} Int {s. Q s} = {s. P s & Q s} *)
 fun merge_assertion_simp_tac ctxt thms =
      simp_tac (put_simpset HOL_basic_ss ctxt
                    addsimps ([@{thm Hoare.CollectInt_iff},@{thm HOL.conj_assoc},@{thm Hoare.Compl_Collect},singleton_conv_sym,
                    @{thm Set.Int_empty_right},@{thm Set.Int_empty_left},@{thm Un_empty_right},@{thm Un_empty_left}]@thms)) ;
 
 (* The following probably shouldn't live here, but refactoring
    so that Hoare could depend on recursive_records does not look feasible.
    The upshot is that there's a duplicate foldcong_ss set here. *)
 structure FoldCongData = Theory_Data
 (
   type T = simpset;
   val empty = HOL_basic_ss;
   val merge = merge_ss;
 )
 
 val get_foldcong_ss = FoldCongData.get
 
 fun add_foldcongs congs thy = FoldCongData.map (fn ss =>
         Proof_Context.init_global thy
         |> put_simpset ss
         |> fold Simplifier.add_cong congs
         |> simpset_of) thy
 
 fun add_foldcongsimps simps thy = FoldCongData.map (fn ss =>
         Proof_Context.init_global thy
         |> put_simpset ss
         |> (fn ctxt => ctxt addsimps simps)
         |> simpset_of) thy
 
 (* propagates state into "Collect" sets and simplifies selections updates like:
  *  s:{s. P s} = P s
  *)
 fun in_assertion_simp_tac ctxt state_kind thms i =
  let
-     val vcg_simps = #vcg_simps (get_data ctxt);
-     val fold_simps = get_foldcong_ss (Proof_Context.theory_of ctxt)
+     val thy = Proof_Context.theory_of ctxt
+     val vcg_simps = map (Thm.transfer thy) (#vcg_simps (get_data ctxt));
+     val fold_simps = get_foldcong_ss thy
+     val state_simps = Named_Theorems.get ctxt @{named_theorems "state_simp"}
  in
    EVERY [simp_tac
             (put_simpset HOL_basic_ss ctxt addsimps ([mem_Collect_eq,@{thm Set.Un_iff},@{thm Set.Int_iff},
                                      @{thm Set.empty_subsetI}, @{thm Set.empty_iff}, UNIV_I,
-                                     @{thm Hoare.Collect_False}]@thms@K_convs@vcg_simps)
-                          addsimprocs (state_simprocs state_kind)
+                                     @{thm Hoare.Collect_False}]@state_simps@thms@K_convs@vcg_simps)
+                          addsimprocs (state_simprocs ctxt state_kind)
                           |> fold Simplifier.add_cong K_congs)  i
            THEN_MAYBE
-           (simp_tac (put_simpset fold_simps ctxt addsimprocs [state_upd_simproc state_kind])  i)
+           (simp_tac (put_simpset fold_simps ctxt addsimprocs (state_upd_simprocs ctxt state_kind))  i)
          ]
  end;
 
 
 fun assertion_simp_tac ctxt state_kind thms i =
     merge_assertion_simp_tac ctxt [] i
     THEN_MAYBE in_assertion_simp_tac ctxt state_kind thms i
 
 (* simplify equality test on strings (and datatype-constructors) and propagate result*)
 fun string_eq_simp_tac ctxt =
   simp_tac (put_simpset HOL_basic_ss ctxt
     addsimps @{thms list.inject list.distinct char.inject
       cong_exp_iff_simps simp_thms});
 
 
 fun assertion_string_eq_simp_tac ctxt state_kind thms i =
     assertion_simp_tac ctxt state_kind thms i THEN_MAYBE string_eq_simp_tac ctxt i;
 
 
 fun before_set2pred_simp_tac ctxt =
   (simp_tac (put_simpset HOL_basic_ss ctxt addsimps [singleton_conv_sym,
                                     @{thm Hoare.CollectInt_iff},
                                     @{thm Hoare.Compl_Collect}]));
 
 (*****************************************************************************)
 (** set2pred transforms sets inclusion into predicates implication,         **)
 (** maintaining the original variable names.                                **)
 (** Ex. "{x. x=0} <= {x. x <= 1}" -set2pred-> "x=0 --> x <= 1"              **)
 (** Subgoals containing intersections (A Int B) or complement sets (-A)     **)
 (** are first simplified by "before_set2pred_simp_tac", that returns only   **)
 (** subgoals of the form "{x. P x} <= {x. Q x}", which are easily           **)
 (** transformed.                                                            **)
 (** This transformation may solve very easy subgoals due to a ligth         **)
 (** simplification done by full_simp_tac                                    **)
 (*****************************************************************************)
 
+val Collect_subset_to_pred =
+@{lemma \<open>(\<And>x. A x \<Longrightarrow> P x)
+   \<Longrightarrow> {x. A x} \<subseteq> {x. P x}\<close>
+ by (rule subsetI, rule CollectI, drule CollectD, assumption)}
+
+
 fun set2pred_tac ctxt i thm =
   ((before_set2pred_simp_tac ctxt i) THEN_MAYBE
           (EVERY [trace_tac ctxt "set2pred",
-                  resolve_tac ctxt [subsetI] i,
-                  resolve_tac ctxt [CollectI] i,
-                  dresolve_tac ctxt [CollectD] i,
+                  resolve_tac ctxt [Collect_subset_to_pred] i,
                   full_simp_tac (put_simpset HOL_basic_ss ctxt) i ])) thm
 
 
 (*****************************************************************************)
 (** BasicSimpTac is called to simplify all verification conditions. It does **)
 (** a light simplification by applying "mem_Collect_eq"                     **)
 (** then it tries to solve subgoals of the form "A <= A" and then if        **)
 (** set2pred is true it                                                     **)
 (** transforms any other into predicates, applying then                     **)
 (** the tactic chosen by the user, which may solve the subgoal completely   **)
 (** (MaxSimpTac).                                                           **)
 (*****************************************************************************)
 
 fun MaxSimpTac ctxt tac i =
   TRY (FIRST[resolve_tac ctxt [subset_refl] i,
-      set2pred_tac ctxt i THEN_MAYBE tac i,
+      (set2pred_tac ctxt i THEN_MAYBE tac i) ORELSE tac i,
       trace_tac ctxt "final_tac failed"
       ]);
 
 fun BasicSimpTac ctxt state_kind set2pred thms tac i =
  EVERY [(trace_tac ctxt "BasicSimpTac -- START --"),
          assertion_simp_tac ctxt state_kind thms i
          THEN_MAYBE (if set2pred then MaxSimpTac ctxt tac i else TRY (resolve_tac ctxt [subset_refl] i)),
         (trace_tac ctxt "BasicSimpTac -- STOP --")];
 (*
  EVERY [(trace_tac ctxt "BasicSimpTac -- START --"),
          simp_tac
           (HOL_basic_ss addsimps [mem_Collect_eq,@{thm Hoare.CollectInt_iff},
                                   @{thm Set.empty_subsetI}, @{thm Set.empty_iff}, UNIV_I]
                         addsimprocs [state_simproc sk]) i
          THEN_MAYBE
          simp_tac (HOL_basic_ss  addsimprocs [state_upd_simproc sk]) i
          THEN_MAYBE (if set2pred then MaxSimpTac ctxt tac i else TRY (rtac subset_refl i)),
         (trace_tac ctxt "BasicSimpTac -- STOP --")];
 *)
 
 
 
 (*
 fun simp_state_eq_tac Record state_space =
   full_simp_tac (HOL_basic_ss addsimprocs (state_simprocs Record))
   THEN_MAYBE'
   full_simp_tac (HOL_basic_ss addsimprocs [state_upd_simproc Record])
   THEN_MAYBE'
   (state_split_simp_tac [] state_space)
   | simp_state_eq_tac StateFun state_space =
 *)
 
 fun post_conforms_tac ctxt state_kind i =
    EVERY [REPEAT1 (resolve_tac ctxt [allI,impI] i),
           ((fn i => TRY (resolve_tac ctxt [conjI] i))
            THEN_ALL_NEW
           (fn i => (REPEAT (resolve_tac ctxt [allI,impI] i))
                     THEN (full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps
                              [mem_Collect_eq,@{thm Set.singleton_iff},@{thm Set.empty_iff},UNIV_I]
-                             addsimprocs (state_simprocs state_kind)) i))) i];
+                             addsimprocs (state_simprocs ctxt state_kind)) i))) i];
 
 
 fun dest_hoare_raw (Const(@{const_name HoarePartialDef.hoarep},_)$G$T$F$P$C$Q$A) = (P,C,Q,A,Partial,G,T,F)
   | dest_hoare_raw (Const(@{const_name HoareTotalDef.hoaret},_)$G$T$F$P$C$Q$A) = (P,C,Q,A,Total,G,T,F)
   | dest_hoare_raw t = raise TERM ("Hoare.dest_hoare_raw: unexpected term",[t])
 
 
 fun mk_hoare_abs Ts (P,C,Q,A,mode,G,T,F) =
   let
     val hoareT = map (curry fastype_of1 Ts) [G,T,F,P,C,Q,A] ---> HOLogic.boolT;
     val hoareC = (case mode of Partial => Const (@{const_name HoarePartialDef.hoarep},hoareT)
                      | Total => Const (@{const_name HoareTotalDef.hoaret},hoareT));
   in hoareC$G$T$F$P$C$Q$A end;
 
 
 val is_hoare = can dest_hoare_raw
 
 fun dest_hoare t =
     let
       val triple =
         (strip_qnt_body @{const_name "All"} o
-          HOLogic.dest_Trueprop o strip_qnt_body @{const_name Pure.all}) t;
+          HOLogic.dest_Trueprop o Logic.strip_assums_concl) t;
     in
       dest_hoare_raw triple
     end;
 
 
 fun get_aux_tvar rule =
   let
     fun aux_hoare (Abs ("Z",TVar (z,_),t)) =
           if is_hoare (strip_qnt_body @{const_name All} t)
           then SOME z
           else NONE
       | aux_hoare _ = NONE;
   in (case first_subterm_dest (aux_hoare) (Thm.prop_of rule) of
         SOME (_,z) => (z,rule)
       | NONE => raise TERM ("get_aux_tvar: No auxiliary variable of hoare-rule found",
                              [Thm.prop_of rule]))
   end;
 
 fun strip_vars t =
   let
     val bdy = (HOLogic.dest_Trueprop o Logic.strip_assums_concl) t;
   in strip_qnt_vars @{const_name Pure.all} t @ strip_qnt_vars @{const_name All} bdy end;
 
 
 local
 (* ex_simps are necessary in case of multiple logical variables. The state will
    usually be the first variable. EX s a b. s=s' ... . We have to transport
    EX s to s=s' to perform the substitution *)
 
 val conseq1_ss_base =
   simpset_of (put_simpset HOL_basic_ss @{context}
     addsimps ([mem_Collect_eq,@{thm Set.singleton_iff},@{thm Set.Int_iff},
               @{thm Set.empty_iff},UNIV_I,
               @{thm HOL.conj_assoc}, @{thm disj_assoc}] @ @{thms Hoare.all_imp_eq_triv}
               @K_convs @ @{thms simp_thms} @ @{thms ex_simps} @ @{thms all_simps})
     delsimps [@{thm Hoare.all_imp_to_ex}]
     |> fold Simplifier.add_cong K_congs)
-val conseq1_ss_record =
-  simpset_of (put_simpset conseq1_ss_base @{context} addsimprocs (state_simprocs Record));
-val conseq1_ss_fun =
-  simpset_of (put_simpset conseq1_ss_base @{context} addsimprocs (state_simprocs Function));
-fun conseq1_ss Record   = conseq1_ss_record
-  | conseq1_ss Function = conseq1_ss_fun;
 
 val conseq2_ss_base =
   simpset_of (put_simpset HOL_basic_ss @{context}
     addsimps (@{thms Hoare.all_imp_eq_triv} @ @{thms simp_thms} @ @{thms ex_simps} @ @{thms all_simps})
     delsimps [@{thm Hoare.all_imp_to_ex}]
     |> Simplifier.add_cong @{thm imp_cong});
-
-val conseq2_ss_record =
-  simpset_of (put_simpset conseq2_ss_base @{context}
-    addsimprocs [state_upd_simproc Record, state_ex_sel_eq_simproc Record]);
-val conseq2_ss_fun =
-  simpset_of (put_simpset conseq2_ss_base @{context}
-    addsimprocs [state_upd_simproc Function, state_ex_sel_eq_simproc Function]);
-fun conseq2_ss Record   = conseq2_ss_record
-  | conseq2_ss Function = conseq2_ss_fun;
-
 in
 
 fun raw_conseq_simp_tac ctxt state_kind thms i =
   let
     val ctxt' = Config.put simp_depth_limit 0 ctxt;
   in
-     simp_tac (put_simpset (conseq1_ss state_kind) ctxt' addsimps thms) i
+     simp_tac (put_simpset conseq1_ss_base ctxt'
+       addsimprocs (state_simprocs ctxt' state_kind)
+       addsimps thms) i
      THEN_MAYBE
-     simp_tac (put_simpset (conseq2_ss state_kind) ctxt') i
+     simp_tac (put_simpset conseq2_ss_base ctxt'
+       addsimprocs (state_upd_simprocs ctxt' state_kind @ state_ex_sel_eq_simprocs ctxt' state_kind)) i
   end
 
 end
 
 val conseq_simp_tac = raw_conseq_simp_tac;
 
 (* Generates the hoare-quadruples that can be derived out of the hoare-context T *)
 fun gen_context_thms ctxt mode params G T F =
   let
     val Type (_,[comT]) = range_type (fastype_of G);
 
     fun destQuadruple (Const (@{const_name Set.insert},_) $ PpQA $ Const (@{const_name Orderings.bot}, _)) = PpQA
       | destQuadruple t = raise Match;
 
     fun mkCallQuadruple (Const (@{const_name Pair}, _) $ P $ (Const (@{const_name Pair}, _)
         $ p $ (Const(@{const_name Pair}, _) $ Q $ A))) =
       let val Call_p = Const (@{const_name Language.com.Call}, fastype_of p --> comT) $ p;
       in (P, Call_p, Q, A) end;
 
     fun mkHoare mode G T F (vars,PpQA) =
       let
         val hoare =
           (case mode of Partial => @{const_name HoarePartialDef.hoarep}
           | Total => @{const_name HoareTotalDef.hoaret});
-        (* FIXME: Use future Proof_Context.rename_vars or make closed term and remove by hand *)
+        (* fixme: Use future Proof_Context.rename_vars or make closed term and remove by hand *)
         (*
         fun free_params ps t = foldr (fn ((x,xT),t) => snd (variant_abs (x,xT,t))) (ps,t);
         val PpQA' = mkCallQuadruple (strip_qnt_body @{const_name Pure.all} (free_params params (Term.list_all (vars,PpQA))));
         *)
         val params' = (Variable.variant_frees ctxt [PpQA] params);
         val bnds = map Bound (0 upto (length vars  - 1));
         fun free_params_vars t = subst_bounds (bnds @ rev (map Free params' ), t)
         fun free_params t = subst_bounds (rev (map Free params' ), t)
         val (P',p',Q',A') = mkCallQuadruple (free_params_vars PpQA);
 
         val T' = free_params T;
         val G' = free_params G;
         val F' = free_params F;
         val bdy = mk_hoare_abs [] (P',p',Q',A',mode,G',T',F');
 
       in (HOLogic.mk_Trueprop (HOLogic.list_all (vars,bdy)), map fst params')
       end;
 
     fun hoare_context_specs mode G T F =
       let fun mk t = try (mkHoare mode G T F o apsnd destQuadruple o dest_UN) t;
       in map_filter mk (dest_Un T) end;
 
 
     fun mk_prove mode (prop,params) =
       let
         val vars = map fst (strip_qnt_vars @{const_name All}
                              (HOLogic.dest_Trueprop (Logic.strip_assums_concl prop)));
+        val [asmUN'] = adapt_aux_var ctxt true vars [get_aux_tvar (AsmUN mode)]
       in Goal.prove ctxt params [] prop
           (fn {context = ctxt', ...} =>
             EVERY[trace_tac ctxt' "extracting specifications from hoare context",
-                  resolve_tac ctxt' (adapt_aux_var ctxt' true vars [get_aux_tvar (AsmUN mode)]) 1,
+                  resolve_tac ctxt' [asmUN'] 1,
                   DEPTH_SOLVE_1 (resolve_tac ctxt' [subset_refl,refl] 1 ORELSE
                     ((resolve_tac ctxt' [@{thm Hoare.subset_unI1}] 1 APPEND resolve_tac ctxt' [@{thm Hoare.subset_unI2}] 1)
                      ORELSE
                      (resolve_tac ctxt' [@{thm Hoare.subset_singleton_insert1}] 1
                       APPEND resolve_tac ctxt' [@{thm Hoare.subset_singleton_insert2}] 1)))
                   ORELSE error_tac ("vcg: cannot extract specifications from context")
                  ])
       end;
 
     val specs = hoare_context_specs mode G T F;
   in map (mk_prove mode) specs end;
 
+fun is_modifies_assertion t =
+    exists_subterm (fn (Const (@{const_name Hoare.meq},_)) => true| _ => false) t
 
 fun is_modifies_clause t =
-    exists_subterm (fn (Const (@{const_name Hoare.meq},_)) => true| _ => false)
-           (#3 (dest_hoare (Logic.strip_assums_concl t)))
+  is_modifies_assertion (#3 (dest_hoare (Logic.strip_assums_concl t)))
     handle (TERM _) => false;
 val is_spec_clause = not o is_modifies_clause;
 
 
 (* e.g: Intg => the_Intg
         lift Intg => lift the_Intg
         map Ingt => map the_Intg
         Hp o lift Intg => lift the_Intg o the_Hp
 *)
 fun swap_constr_destr f (t as (Const (@{const_name Fun.id},_))) = t
   | swap_constr_destr f  (t as (Const (c,Type ("fun",[T,valT])))) =
      (Const (f c, Type ("fun",[valT,T]))
       handle Empty => raise TERM ("Hoare.swap_constr_destr",[t]))
-  | swap_constr_destr f (Const ("StateFun.map_fun",Type ("fun",   (* FIXME unknown "StateFun.map_fun" !? *)
+  | swap_constr_destr f (Const ("StateFun.map_fun",Type ("fun",   (* fixme: unknown "StateFun.map_fun" !? *)
                                              [Type ("fun",[T,valT]),
                                               Type ("fun",[Type ("fun",[xT,T']),
                                                            Type ("fun",[xT',valT'])])]))$g) =
       Const ("StateFun.map_fun",Type("fun",[Type ("fun",[valT,T]),
                                          Type ("fun",[Type ("fun",[xT,valT']),
                                                       Type ("fun",[xT',T'])])]))$
         swap_constr_destr f g
   | swap_constr_destr f (Const (@{const_name Fun.comp},Type ("fun",
                                        [Type ("fun",[bT',cT]),
                                         Type ("fun",[Type ("fun",[aT ,bT]),
                                                      Type ("fun",[aT',cT'])])]))$h$g) =
      let
        val h'=swap_constr_destr f h;
        val g'=swap_constr_destr f g;
      in Const (@{const_name Fun.comp},Type ("fun",
                                        [Type ("fun",[bT,aT]),
                                         Type ("fun",[Type ("fun",[cT,bT']),
                                                      Type ("fun",[cT',aT'])])]))$g'$h'
      end
   | swap_constr_destr f (Const (@{const_name List.map},Type ("fun",
                                          [Type ("fun",[aT,bT]),
                                           Type ("fun",[asT,bsT])]))$g) =
      (Const (@{const_name List.map},Type ("fun",
                           [Type ("fun",[bT,aT]),
                            Type ("fun",[bsT,asT])]))$swap_constr_destr f g)
   | swap_constr_destr f t = raise TERM ("Hoare.swap_constr_destr",[t]);
 
-(* FIXME: unused? *)
+(* fixme: unused? *)
 val destr_to_constr =
     let
       fun convert c =
         let
           val (path,base) = split_last (Long_Name.explode c);
         in Long_Name.implode (path @ ["val",unprefix "the_" base]) end;
     in  swap_constr_destr convert end;
 
 fun gen_call_tac cont_tac mode cmode state_kind state_space ctxt asms spec_sfx
-                 pname return has_args _ =
+                 pname return has_args result_exn _ =
   let
     val thy = Proof_Context.theory_of ctxt;
-    val pname' = unsuffix proc_deco pname;
+    val pname' = chopsfx proc_deco pname;
     val spec = (case AList.lookup (op =) asms pname of
                  SOME s => SOME s
                | NONE =>  try (Proof_Context.get_thm ctxt) (suffix spec_sfx pname'));
-
     fun auxvars_for p t =
          (case first_subterm_dest (try dest_call) t of
-           SOME (vars,(_,p',_,_,m,_)) => (if m=Static andalso
+           SOME (vars,(_,p',_,_,m,_,_)) => (if m=Static andalso
                                            p=(dest_string' p')
                                         then SOME vars
                                         else NONE)
           | NONE => NONE);
 
     fun get_auxvars_for p t =
           (case (map_filter ((auxvars_for p) o snd) (max_subterms_dest tap_UN t)) of
             (vars::_) => vars
            | _ => []);
 
 
     fun spec_tac ctxt' augment_rule augment_emptyFaults _ spec i =
          let
            val spec' = augment_emptyFaults OF [spec]
                        handle THM _ => spec;
          in
            EVERY [resolve_tac ctxt' [augment_rule] i,
                   resolve_tac ctxt' [spec'] (i+1),
                   TRY (resolve_tac ctxt' [subset_refl, @{thm Set.empty_subsetI}, @{thm Set.Un_upper1}, @{thm Set.Un_upper2}] i)]
          end;
 
     fun check_spec name P thm =
          (case try dest_hoare (Thm.concl_of thm) of
                SOME spc => (case try dest_call (#2 spc) of
-                             SOME (_,p,_,_,m,_) => if proc_name m p = name andalso
+                             SOME (_,p,_,_,m,_,_) => if proc_name ctxt m p = name andalso
                                                     P (Thm.concl_of thm)
                                                  then SOME (#5 spc,thm)
                                                  else NONE
                             | _ => NONE)
              | _ => NONE)
 
     fun find_dyn_specs name P thms = map_filter (check_spec name P) thms;
 
     fun get_spec name P thms =
          case find_dyn_specs name P thms of
           (spec_mode,spec)::_ => SOME (spec_mode,spec)
          | _ => NONE;
 
 
     fun solve_spec ctxt' augment_rule _ augment_emptyFaults mode _ (SOME spec_mode) (SOME spec) i=
         if mode=Partial andalso spec_mode=Total
         then resolve_tac ctxt' [@{thm HoareTotal.hoaret_to_hoarep'}] i THEN spec_tac ctxt' augment_rule augment_emptyFaults mode spec i
         else if mode=spec_mode then spec_tac ctxt' augment_rule augment_emptyFaults mode spec i
               else error("vcg: cannot use a partial correctness specification of "
                           ^ pname' ^ " for a total correctness proof")
       | solve_spec ctxt' _ asmUN_rule _ mode Static _ _ i =(* try to infer spec out of context *)
          EVERY[trace_tac ctxt' "inferring specification from hoare context1",
                resolve_tac ctxt' [asmUN_rule] i,
                DEPTH_SOLVE_1 (resolve_tac ctxt' [subset_refl,refl] i ORELSE
                 ((resolve_tac ctxt' [@{thm Hoare.subset_unI1}] i APPEND resolve_tac ctxt' [@{thm Hoare.subset_unI2}] i)
                  ORELSE
                  (resolve_tac ctxt' [@{thm Hoare.subset_singleton_insert1}] i
                   APPEND resolve_tac ctxt' [@{thm Hoare.subset_singleton_insert2}] i)))
                ORELSE error_tac ("vcg: cannot infer specification of "
                                    ^ pname' ^ " from context")
                (* if tactic for DEPTH_SOLVE_1 would create new subgoals,
                   use SELECT_GOAL and DEPTH_SOLVE *)
               ]
 
       | solve_spec ctxt' augment_rule asmUN_rule augment_emptyFaults mode Parameter _ _ i =
           (* try to infer spec out of assumptions *)
          let
-             fun tac ({context = ctxt'', prems, ...}: Subgoal.focus) =
-              (case (find_dyn_specs pname is_spec_clause prems) of
+             fun tac thms =
+              (case (find_dyn_specs pname is_spec_clause thms) of
                 (spec_mode,spec)::_
-                 => solve_spec ctxt'' augment_rule asmUN_rule augment_emptyFaults mode Parameter
+                 => solve_spec ctxt' augment_rule asmUN_rule augment_emptyFaults mode Parameter
                        (SOME spec_mode) (SOME spec) 1
                | _ => all_tac)
-         in Subgoal.FOCUS tac ctxt' i end
+         in Subgoal.FOCUS (tac o #prems) ctxt i end
 
     val strip_spec_vars = strip_qnt_vars @{const_name All} o HOLogic.dest_Trueprop;
 
     fun apply_call_tac ctxt' pname mode cmode spec_mode spec_goal is_abr
                        spec (subgoal,i) =
       let
         val spec_vars = map fst
              (case spec of
                 SOME sp => (strip_spec_vars (Thm.concl_of sp))
               | NONE => (case try (dest_hoare) subgoal of
                            SOME (_,_,_,_,_,_,Theta,_) => get_auxvars_for pname Theta
                           | _ => []));
 
-        fun get_call_rule Static mode is_abr  =
-            if is_abr then Proc mode else ProcNoAbr mode
-          | get_call_rule Parameter mode is_abr =
-                if is_abr then DynProcProcPar mode else DynProcProcParNoAbr mode;
+        fun get_call_rule' Static mode is_abr result_exn =
+            if is_abr then Proc mode result_exn else ProcNoAbr mode result_exn
+          | get_call_rule' Parameter mode is_abr result_exn =
+                if is_abr then DynProcProcPar mode result_exn else DynProcProcParNoAbr mode result_exn;
 
         val [call_rule,augment_ctxt_rule,asmUN_rule, augment_emptyFaults] =
                 adapt_aux_var ctxt' true spec_vars
                   (map get_aux_tvar
-                    [get_call_rule cmode mode is_abr,
+                    [get_call_rule' cmode mode is_abr result_exn,
                      AugmentContext mode,
                      AsmUN mode,
                      AugmentEmptyFaults mode]);
-
       in EVERY [resolve_tac ctxt' [call_rule] i,
                 trace_tac ctxt' "call_tac -- basic_tac -- solving spec",
-                solve_spec ctxt' augment_ctxt_rule asmUN_rule augment_emptyFaults
+                solve_spec ctxt'  augment_ctxt_rule asmUN_rule augment_emptyFaults
                            mode cmode spec_mode spec spec_goal]
       end;
 
     fun basic_tac ctxt' spec i =
         let
            val msg ="Theorem " ^pname'^spec_sfx ^
                     " is no proper specification for procedure " ^pname'^
                      "; trying to infer specification from hoare context";
            fun spec' s mode abr =
                 if is_modifies_clause (Thm.concl_of s)
                 then if abr then (TrivPost mode) OF [s] else (TrivPostNoAbr mode) OF [s]
                 else s;
 
            val (is_abr,spec_mode,spec,spec_has_args) =
                                           (* is there a proper specification fact? *)
                case spec of NONE => (true,NONE,NONE,false)
                | SOME s
                  => case try dest_hoare (Thm.concl_of s) of
                       NONE => (warning msg;(true,NONE,NONE,false))
                     | SOME (_,c,Q,spec_abr,spec_mode,_,_,_)
                       => case try dest_call c of
                            NONE => (warning msg;(true,NONE,NONE,false))
-                         | SOME (_,p,_,_,m,spec_has_args)
-                           => if proc_name m p = pname
+                         | SOME (_,p,_,_,m,spec_has_args,_)
+                           => if proc_name ctxt m p = pname
                               then if (mode=Total andalso spec_mode=Partial)
                                    then (warning msg;(true,NONE,NONE,false))
                                    else if is_empty_set spec_abr then
                                             (false,SOME spec_mode,
                                               SOME (spec' s spec_mode false),spec_has_args)
                                         else (true,SOME spec_mode,
                                                  SOME (spec' s spec_mode true),spec_has_args)
                               else (warning msg;(true,NONE,NONE,false));
 
            val () = if spec_has_args
                     then error "procedure call in specification must be parameterless!"
                     else ();
 
            val spec_goal = i+2;
         in
            EVERY[trace_tac ctxt' "call_tac -- basic_tac -- START --",
                  SUBGOAL
                    (apply_call_tac ctxt' pname mode cmode spec_mode spec_goal is_abr spec) i,
                  resolve_tac ctxt' [allI] (i+1),
                  resolve_tac ctxt' [allI] (i+1),
                  cont_tac ctxt' (i+1),
                  trace_tac ctxt' "call_tac -- basic_tac -- simplify",
-                 conseq_simp_tac ctxt' state_kind [@{thm StateSpace.upd_globals_def}] i,
+                 conseq_simp_tac ctxt' state_kind (Named_Theorems.get ctxt @{named_theorems "state_simp"}) i,
                  trace_tac ctxt' "call_tac -- basic_tac -- STOP --"]
         end;
 
     fun get_modifies (Const (@{const_name Collect},_) $ Abs (_,_,m)) = m
       | get_modifies t =  raise TERM ("gen_call_tac.get_modifies",[t]);
 
     fun get_updates (Abs (_,_,t)) = get_updates t
       | get_updates (Const (@{const_name Hoare.mex},_) $ t) = get_updates t
       | get_updates (Const (@{const_name Hoare.meq},T) $ _ $ upd) = (T,upd)
       | get_updates t = raise TERM ("gen_call_tac.get_updates",[t]);
 
 
 
     (* return has the form: %s t. s(|globals:=globals t,...|)
      * should be translated to %s t. s(|globals := globals s(|m := m (globals t),...|),...|)
      * for all m in the modifies list.
      *)
      fun mk_subst gT meqT =
        fst (Sign.typ_unify thy (gT,domain_type meqT) (Vartab.empty,0));
 
      fun mk_selR subst gT (upd,uT) =
        let val vT = range_type (hd (binder_types uT));
        in Const (unsuffix Record.updateN upd,gT --> (Envir.norm_type subst vT)) end;
 
      (* lookup:: "('v => 'a) => 'n => ('n => 'v) => 'a"
       * update:: "('v => 'a) => ('a => 'v) => 'n => ('a => 'a) => ('n => 'v) => ('n => 'v)"
       *)
      fun mk_selF subst uT d n =
        let
           val vT_a::a_vT::nT::aT_aT::n_vT::_ = binder_types uT;
           val lT = (Envir.norm_type subst (vT_a --> nT --> n_vT --> (domain_type aT_aT)));
           val d' = map_types (Envir.norm_type subst) d;
        in Const (@{const_name StateFun.lookup},lT)$d'$n
        end;
 
      fun mk_rupdR subst gT (upd,uT) =
        let val [vT,_] = binder_types uT
        in Const (upd,(Envir.norm_type subst vT) --> gT --> gT) end;
 
 
      fun K_fun kn uT =
          let val T=range_type (hd (binder_types uT)) in Const (kn,T --> T --> T) end;
 
      fun K_rec uT t =
          let val T=range_type (hd (binder_types uT))
          in Abs ("_", T, incr_boundvars 1 t) end;
 
      fun mk_supdF subst uT d c n =
        let
          val uT' = Envir.norm_type subst uT;
          val c' = map_types (Envir.norm_type subst) c;
          val d' = map_types (Envir.norm_type subst) d;
        in Const (@{const_name StateFun.update},uT')$d'$c'$n end;
 
      fun modify_updatesR subst gT glob ((Const (upd,uT))$_$(Const _$Z)) =
              mk_rupdR subst gT (upd,uT)$
                (K_rec uT (mk_selR subst gT (upd,uT)$(glob$Bound 0)))$(glob$Bound 1)
        | modify_updatesR subst gT glob ((Const (upd,uT))$_$s) =
              mk_rupdR subst gT (upd,uT)$
                (K_rec uT (mk_selR subst gT (upd,uT)$(glob$Bound 0)))$
                modify_updatesR subst gT glob s
        | modify_updatesR subst gT glob ((_$Z)) = (glob$Bound 1) (* may_not_modify *)
        | modify_updatesR _ _ _ t = raise TERM ("gen_call_tac.modify_updatesR",[t]);
 
      fun modify_updatesF subst _ glob
           (Const (@{const_name StateFun.update},uT)$d$c$n$_$(Const globs$Z)) =
              mk_supdF subst uT d c n$
                (K_fun KNF uT$(mk_selF subst uT d n$(glob$Bound 0)))$(glob$Bound 1)
        | modify_updatesF subst gT glob (Const (@{const_name StateFun.update},uT)$d$c$n$_$s) =
              mk_supdF subst uT d c n$
                (K_fun KNF uT$(mk_selF subst uT d n$(glob$Bound 0)))$modify_updatesF subst gT glob s
        | modify_updatesF subst _ glob ((globs$Z)) = (glob$Bound 1) (* may_not_modify *)
        | modify_updatesF _ _ _ t = raise TERM ("gen_call_tac.modify_updatesF",[t]);
 
-     fun modify_updates Record = modify_updatesR
-       | modify_updates _ = modify_updatesF
+     fun modify_updates Function = modify_updatesF
+       | modify_updates _ (* Record and Other *) = modify_updatesR
 
 
      fun globalsT (Const (gupd,T)) = domain_type (hd (binder_types T))
        | globalsT t = raise TERM ("gen_call_tac.globalsT",[t]);
 
 
      fun mk_upd meqT mods (gupd$(Abs (dmy,dmyT,(glob$Bound 1)))$Bound 1) =
        let val gT = (globalsT gupd);
            val subst = mk_subst gT meqT;
        in (gupd$(Abs (dmy,dmyT,incr_boundvars 1
                    (modify_updates state_kind subst gT glob mods)))$Bound 1) end
        | mk_upd meqT mods (upd$v$s) = upd$v$mk_upd meqT mods s
        | mk_upd _ _ t = raise TERM ("gen_call_tac.mk_upd",[t]);
 
      fun modify_return (meqT,mods) (Abs (s,T,Abs (t,U,upd))) =
            (Abs (s,T,Abs (t,U,mk_upd meqT mods upd)))
        | modify_return _ t = raise TERM ("get_call_tac.modify_return",[t]);
 
      fun modify_tac ctxt' spec modifies_thm i =
        try (fn () =>
         let
           val (_,call,modif_spec_nrm,modif_spec_abr,modif_spec_mode,G,Theta,_) =
                 dest_hoare (Thm.concl_of modifies_thm);
           val is_abr = not (is_empty_set modif_spec_abr);
           val emptyTheta = is_empty_set Theta;
           (*val emptyFaults = is_empty_set F;*)
-          val spec_has_args = #6 (dest_call call);
+          val (_,_,_,_,_,spec_has_args,_) = dest_call call;
           val () = if spec_has_args
               then error "procedure call in modifies-specification must be parameterless!"
               else ();
           val (mxprem,ModRet) = (case cmode of
                  Static =>
                   (8,if is_abr
-                     then if emptyTheta then (ProcModifyReturn mode)
-                          else (ProcModifyReturnSameFaults mode)
-                     else if emptyTheta then (ProcModifyReturnNoAbr mode)
-                          else (ProcModifyReturnNoAbrSameFaults mode))
+                     then if emptyTheta then (ProcModifyReturn mode result_exn)
+                          else (ProcModifyReturnSameFaults mode result_exn)
+                     else if emptyTheta then (ProcModifyReturnNoAbr mode result_exn)
+                          else (ProcModifyReturnNoAbrSameFaults mode result_exn))
                | Parameter =>
                   (9,if is_abr
-                     then if emptyTheta then (ProcProcParModifyReturn mode)
-                          else (ProcProcParModifyReturnSameFaults mode)
-                     else if emptyTheta then (ProcProcParModifyReturnNoAbr mode)
-                          else (ProcProcParModifyReturnNoAbrSameFaults mode)));
+                     then if emptyTheta then (ProcProcParModifyReturn mode result_exn)
+                          else (ProcProcParModifyReturnSameFaults mode result_exn)
+                     else if emptyTheta then (ProcProcParModifyReturnNoAbr mode result_exn)
+                          else (ProcProcParModifyReturnNoAbrSameFaults mode result_exn)));
 
           val to_prove_prem = (case cmode of Static => 0 | Parameter => 1);
           val spec_goal = if is_abr then i + mxprem - 5 else i + mxprem - 6
 
           val mods_nrm = modif_spec_nrm |> get_modifies |> get_updates;
           val return' = modify_return mods_nrm return;
 (*
           val return' = if is_abr
                         then let val mods_abr =
                                    modif_spec_abr |> get_modifies |> get_updates;
                              in modify_return mods_abr return end
                         else return;*)
 
           val cret = Thm.cterm_of ctxt' return';
-          val (_,_,return'_var,_,_,_) = nth (Thm.prems_of ModRet) to_prove_prem
+          val (_,_,return'_var,_,_,_,_) = nth (Thm.prems_of ModRet) to_prove_prem
                                                   |> dest_hoare |> #2 |> dest_call;
 
           val ModRet' = infer_instantiate ctxt' [(#1 (dest_Var return'_var), cret)] ModRet;
           val modifies_thm_partial = if modif_spec_mode = Total
                                      then @{thm HoareTotal.hoaret_to_hoarep'} OF [modifies_thm] else modifies_thm;
 
           fun solve_modifies_tac i =
                 (clarsimp_tac ((ctxt'
                   |> put_claset (claset_of @{theory_context Set})
                   |> put_simpset (simpset_of @{theory_context Set}))
-                  addsimps ([@{thm Hoare.mex_def},@{thm Hoare.meq_def},@{thm StateSpace.upd_globals_def}]@K_convs)
-                  addsimprocs (state_upd_simproc Record::(state_simprocs state_kind))
+                  addsimps ([@{thm Hoare.mex_def},@{thm Hoare.meq_def}]@K_convs@
+                             (Named_Theorems.get ctxt @{named_theorems "state_simp"}))
+                  addsimprocs (state_upd_simprocs ctxt Record @ state_simprocs ctxt state_kind)
                   |> fold Simplifier.add_cong K_congs) i)
                 THEN_MAYBE
                 EVERY [trace_tac ctxt' "modify_tac: splitting record",
                        state_split_simp_tac ctxt' [] state_space i];
           val cnt = i + mxprem;
 
         in
             EVERY[trace_tac ctxt' "call_tac -- modifies_tac --",
                   resolve_tac ctxt' [ModRet'] i,
                   solve_spec ctxt' (AugmentContext Partial) (AsmUN Partial)
                      (AugmentEmptyFaults Partial) Partial Static
                      (SOME Partial) (SOME modifies_thm_partial) spec_goal,
                   if is_abr then
                    EVERY [trace_tac ctxt' "call_tac -- Solving abrupt modifies --",
                           solve_modifies_tac (cnt - 6)]
                   else all_tac,
                   trace_tac ctxt' "call_tac -- Solving Modifies --",
                   solve_modifies_tac (cnt - 7),
                   basic_tac ctxt' spec (cnt - 8),
                   if cmode = Parameter
                   then EVERY [resolve_tac ctxt' [subset_refl] (cnt - 8),
                               simp_tac (put_simpset HOL_basic_ss ctxt'
                                 addsimps (@{thm Hoare.CollectInt_iff} :: @{thms simp_thms})) 1]
                   else all_tac]
         end) ()
       |> (fn SOME res => res
            | NONE => raise TERM ("get_call_tac.modify_tac: no proper modifies spec", []));
 
-  fun specs_of_assms_tac ({context = ctxt', prems, ...}: Subgoal.focus) =
+  fun specs_of_assms_tac ({context = ctxt', prems, ...}: Subgoal.focus)  =
        (case get_spec pname is_spec_clause prems of
           SOME (_,spec) => (case get_spec pname is_modifies_clause prems of
                               SOME (_,modifies_thm) => modify_tac ctxt' (SOME spec) modifies_thm 1
                             | NONE => basic_tac ctxt' (SOME spec) 1)
         | NONE => (warning ("no proper specification for procedure " ^pname^
                            " in assumptions"); all_tac));
 
   val test_modify_in_ctxt_tac =
     let val mname = (suffix modifysfx pname');
         val mspec = (case try (Proof_Context.get_thm ctxt) mname of
                       SOME s => SOME s
                      | NONE => (case AList.lookup (op =) asms pname of
                                  SOME s => if is_modifies_clause (Thm.concl_of s)
                                            then SOME s else NONE
                                 | NONE => NONE));
 
     in (case mspec of
            NONE => basic_tac ctxt spec
          | SOME modifies_thm =>
              (case check_spec pname is_modifies_clause modifies_thm of
                 SOME _ => modify_tac ctxt spec modifies_thm
               | NONE => (warning ("ignoring theorem " ^ (suffix modifysfx pname') ^
                                   "; no proper modifies specification for procedure "^pname');
                          basic_tac ctxt spec)))
     end;
 
-  fun inline_bdy_tac has_args i =
+  fun inline_bdy_tac has_args result_exn i =
     (case try (Proof_Context.get_thm ctxt) (suffix bodyP pname') of
        NONE => no_tac
      | SOME impl =>
         (case try (Proof_Context.get_thm ctxt) (suffix (body_def_sfx^"_def") pname') of
            NONE => no_tac
          | SOME bdy =>
             (tracing ("No specification found for procedure \"" ^ pname' ^
                                 "\". Inlining procedure!");
              if has_args then
                 EVERY [trace_tac ctxt "inline_bdy_tac args",
-                       resolve_tac ctxt [CallBody mode] i,
+                       resolve_tac ctxt [CallBody mode result_exn] i,
                        resolve_tac ctxt [impl] (i+3),
                        resolve_tac ctxt [allI] (i+2),
                        resolve_tac ctxt [allI] (i+2),
                        in_assertion_simp_tac ctxt state_kind [] (i+2),
                        cont_tac ctxt (i+2),
                        resolve_tac ctxt [allI] (i+1),in_assertion_simp_tac ctxt state_kind [bdy] (i+1),
                        cont_tac ctxt (i+1),
                        in_assertion_simp_tac ctxt state_kind [@{thm StateSpace.upd_globals_def}] i]
               else EVERY [trace_tac ctxt "inline_bdy_tac no args",
                           resolve_tac ctxt [ProcBody mode] i,
                           resolve_tac ctxt [impl] (i+2),
                           simp_tac (put_simpset HOL_basic_ss ctxt addsimps [bdy]) (i+1),
                           cont_tac ctxt (i+1)])));
 
   in
     (case cmode of
        Static => if get_recursive pname ctxt = SOME false
                  andalso is_none spec
-                 then inline_bdy_tac has_args
+                 then inline_bdy_tac has_args result_exn
                  else test_modify_in_ctxt_tac
      | Parameter =>
          (case spec of
-            NONE => (tracing "no spec found!"; Subgoal.FOCUS specs_of_assms_tac ctxt)
+            NONE => (trace_msg ctxt "no spec found!"; Subgoal.FOCUS specs_of_assms_tac ctxt)
           | SOME spec =>
-              (tracing "found spec!"; case check_spec pname is_spec_clause spec of
+              (trace_msg ctxt "found spec!"; case check_spec pname is_spec_clause spec of
                  SOME _ => test_modify_in_ctxt_tac
                | NONE => (warning ("ignoring theorem " ^ (suffix spec_sfx pname') ^
                           "; no proper specification for procedure " ^pname');
                           Subgoal.FOCUS specs_of_assms_tac ctxt))))
   end;
 
 fun call_tac cont_tac mode state_kind state_space ctxt asms spec_sfx t =
   let
-     val (_,c,_,_,_,_,_,F) = dest_hoare (Logic.strip_assums_concl t);
-     fun gen_tac (_,pname,return,c,cmode,has_args) =
+     val (_,c,_,_,_,_,_,F) = dest_hoare t;
+     fun gen_tac (_,pname,return,c,cmode,has_args,result_exn) =
            gen_call_tac cont_tac mode cmode state_kind state_space ctxt asms spec_sfx
-                         (proc_name cmode pname) return has_args F;
+                         (proc_name ctxt cmode pname) return has_args result_exn F;
   in gen_tac (dest_call c) end
   handle TERM _ => K no_tac;
 
 fun solve_in_Faults_tac ctxt i =
     resolve_tac ctxt [UNIV_I, @{thm in_insert_hd}] i
     ORELSE
     SELECT_GOAL (SOLVE (simp_tac (put_simpset (simpset_of @{theory_context Set}) ctxt) 1)) i;
 
 local
 fun triv_simp ctxt = merge_assertion_simp_tac ctxt [mem_Collect_eq] THEN'
          simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms}
            |> fold Simplifier.add_cong [@{thm conj_cong}, @{thm imp_cong}]);
     (* a guarded while produces stupid things, since the guards are
           put at the end of the body and in the invariant (rule WhileAnnoG):
          - guard: g /\ g
          - guarantee: g --> g *)
 in
 fun guard_tac ctxt strip cont_tac mode (t,i) =
   let
     val (_,c,_,_,_,_,_,F) = dest_hoare (Logic.strip_assums_concl t);
     val (_,_,_,doStrip) = dest_Guard c;
     val guarantees = if strip orelse doStrip
                      then [GuardStrip mode, GuaranteeStrip mode]
                      else [Guarantee mode]
 
     fun basic_tac i =
           EVERY [resolve_tac ctxt [Guard mode, GuaranteeAsGuard mode] i,
                  trace_tac ctxt "Guard", cont_tac ctxt (i+1),
                  triv_simp ctxt i]
 
 
     fun guarantee_tac i =
           EVERY [resolve_tac ctxt guarantees i,
                  solve_in_Faults_tac ctxt (i+2),
                  cont_tac ctxt (i+1),
                  triv_simp ctxt i]
+
   in if is_empty_set F then EVERY [trace_tac ctxt "Guard: basic_tac", basic_tac i]
     else EVERY [trace_tac ctxt "Guard: trying guarantee_tac", guarantee_tac i ORELSE basic_tac i]
   end handle TERM _ => no_tac
 end;
 
 fun wf_tac ctxt =
   simp_tac (put_simpset HOL_basic_ss ctxt
     addsimps [@{thm Wellfounded.wf_measure},@{thm Wellfounded.wf_lex_prod},@{thm Wfrec.wf_same_fst}, @{thm Hoare.wf_measure_lex_prod},@{thm Wellfounded.wf_inv_image}]);
 
 fun in_rel_simp ctxt =
   simp_tac (put_simpset HOL_basic_ss ctxt
     addsimps [@{thm Hoare.in_measure_iff},@{thm Hoare.in_lex_iff},@{thm Hoare.in_mlex_iff},@{thm Hoare.in_inv_image_iff}, @{thm split_conv}]);
 
-fun while_annotate_tac ctxt inv i st =
+fun while_annotate_tac ctxt inv state_space i st =
   let
     val annotateWhile = Thm.lift_rule (Thm.cprem_of st i) @{thm HoarePartial.reannotateWhileNoGuard};
-    val lifted_inv = fold_rev Term.abs (Logic.strip_params (Logic.get_goal (Thm.prop_of st) i)) inv;
+    val params = Logic.strip_params (Logic.get_goal (Thm.prop_of st) i)
+    val first_state_idx = find_index (fn x => state_space (Free x) <> 0) (rev params)
+    val inv = if first_state_idx > 0 then incr_boundvars first_state_idx inv else inv
+    val lifted_inv = fold_rev Term.abs params inv;
     val invVar = (#1 o strip_comb o #3 o dest_whileAnno o #2 o dest_hoare)
                   (List.last (Thm.prems_of annotateWhile));
     val annotate =
       infer_instantiate ctxt [(#1 (dest_Var invVar), Thm.cterm_of ctxt lifted_inv)] annotateWhile;
- in  ((trace_tac ctxt ("annotating While with: " ^ Syntax.string_of_term ctxt lifted_inv ))
+ in  ((trace_tac ctxt ("try annotating While with: " ^ Syntax.string_of_term ctxt lifted_inv ))
        THEN
        compose_tac ctxt (false,annotate,1) i) st
  end;
 
-fun cond_annotate_tac ctxt inv mode (_,i) st =
+fun cond_annotate_tac ctxt inv mode state_space (_,i) st =
   let
     val annotateCond = Thm.lift_rule (Thm.cprem_of st i) (CondInv' mode);
-    val lifted_inv = fold_rev Term.abs (Logic.strip_params (Logic.get_goal (Thm.prop_of st) i)) inv;
+    val params = Logic.strip_params (Logic.get_goal (Thm.prop_of st) i)
+    val first_state_idx = find_index (fn x => state_space (Free x) <> 0) (rev params)
+    val inv = if first_state_idx > 0 then incr_boundvars first_state_idx inv else inv
+    val lifted_inv = fold_rev Term.abs params inv;
     val invVar = List.last (Thm.prems_of annotateCond) |> dest_hoare |> #3 |> strip_comb |> #1;
     val annotate =
       infer_instantiate ctxt [(#1 (dest_Var invVar), Thm.cterm_of ctxt lifted_inv)] annotateCond;
-  in  ((trace_tac ctxt ("annotating Cond with: "^ Syntax.string_of_term ctxt lifted_inv))
+  in  ((trace_tac ctxt ("try annotating Cond with: "^ Syntax.string_of_term ctxt lifted_inv))
        THEN
        compose_tac ctxt (false,annotate,5) i) st
  end;
 
 fun basic_while_tac ctxt state_kind cont_tac tac mode i =
   let
     fun common_tac i =
          EVERY[if mode=Total then wf_tac ctxt (i+3) else all_tac,
                BasicSimpTac ctxt state_kind true [] tac (i+2),
                if mode=Total
                then in_rel_simp ctxt (i+1) THEN (resolve_tac ctxt [allI] (i+1))
                else all_tac,
                cont_tac ctxt (i+1)
                ]
 
     fun basic_tac i =
           EVERY [resolve_tac ctxt [While mode] i,
                  common_tac i]
   in
      EVERY [trace_tac ctxt "basic_while_tac: basic_tac", basic_tac i]
   end;
 
-fun while_tac ctxt state_kind inv cont_tac tac mode t i=
+fun while_tac ctxt state_kind state_space inv cont_tac tac mode t i=
     let
       val basic_tac  = basic_while_tac ctxt state_kind cont_tac tac mode;
     in
         (case inv of
            NONE => basic_tac i
-         | SOME I => EVERY [while_annotate_tac ctxt I i, basic_tac i])
+         | SOME I => EVERY [while_annotate_tac ctxt I state_space i, basic_tac i])
 
     end
     handle TERM _ => no_tac
 
 fun dest_split (Abs (x,T,t)) =
      let val (vs,recomb,bdy) = dest_split t;
      in ((x,T)::vs,fn t' => Abs (x,T,recomb t'),bdy) end
   | dest_split (c as Const (@{const_name case_prod},_)$Abs(x,T,t)) =
      let val (vs,recomb,bdy) = dest_split t;
      in ((x,T)::vs,fn t' => c$Abs (x,T,recomb t'),bdy) end
   | dest_split t = ([],I,t);
 
 fun whileAnnoG_tac ctxt strip_guards mode t i st =
   let
     val (_,c,_,_,_,_,_,F) = dest_hoare (Logic.strip_assums_concl t);
     val (SOME grds,_,I,_,_,fix) = dest_whileAnno c;
     val Rule = if fix then WhileAnnoGFix mode else WhileAnnoG mode;
     fun extract_faults (Const (@{const_name Set.insert}, _) $ t $ _) = [t]
       | extract_faults _ = [];
     fun leave_grd fs (Const (@{const_name Pair}, _) $ f $ g) =
           if member (op =) fs f andalso strip_guards then NONE else SOME g
       | leave_grd fs (Const (@{const_name Language.guaranteeStripPair}, _) $ f $ g) =
           if member (op =) fs f then NONE else SOME g
       | leave_grd fs _ = NONE;
     val (I_vs,I_recomb,I') = dest_split I;
     val grds' = map_filter (leave_grd (extract_faults F)) (HOLogic.dest_list grds);
     val pars = (Logic.strip_params (Logic.get_goal (Thm.prop_of st) i));
     val J = fold_rev Term.abs pars (I_recomb (fold_rev (mk_Int (map snd (pars@I_vs))) grds' I'));
     val WhileG = Thm.lift_rule (Thm.cprem_of st i) Rule;
     val invVar = (fst o strip_comb o #3 o dest_whileAnno o (fn xs => nth xs 1) o snd
       o strip_comb o #2 o dest_hoare) (List.last (Thm.prems_of WhileG));
     val WhileGInst = infer_instantiate ctxt [(#1 (dest_Var invVar), Thm.cterm_of ctxt J)] WhileG;
   in ((trace_tac ctxt ("WhileAnnoG, adding guards to invariant: " ^ Syntax.string_of_term ctxt J))
       THEN compose_tac ctxt (false,WhileGInst,1) i) st
   end
   handle TERM _ => no_tac st
        | Bind   => no_tac st
 
 (* renames bound state variable according to name given in goal,
  * before rule specAnno is applied, and solves sidecondition *)
 
 fun gen_Anno_tac dest rules tac cont_tac ctxt state_kind (t,i) st =
   let
     val vars = (dest o #2 o dest_hoare) (Logic.strip_assums_concl t);
     val rules' = (case (List.filter (not o null) (map dest_splits vars)) of
                     [] => rules
                   |(xs::_) => adapt_aux_var ctxt false (map fst xs) (map get_aux_tvar rules));
   in EVERY [resolve_tac ctxt rules' i,
             tac,
             simp_tac (put_simpset HOL_basic_ss ctxt addsimps ([@{thm split_conv}, refl, @{thm Hoare.triv_All_eq}]@anno_defs)
                       addsimprocs [@{simproc case_prod_beta}]) (i+2),
             simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm split_conv}]) (i+1),
             simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm split_conv}]) i,
             REPEAT (resolve_tac ctxt [allI] (i+1)),
             cont_tac ctxt (i+1),
             conseq_simp_tac ctxt state_kind [] i] st
   end
   handle TERM _ => no_tac st;
 
 
 fun specAnno_tac ctxt state_kind cont_tac mode =
   let
     fun dest_specAnno (Const (@{const_name Language.specAnno},_)$P$c$Q$A) = [P,c,Q,A]
       | dest_specAnno t = raise TERM ("dest_specAnno",[t]);
 
     val rules = [SpecAnnoNoAbrupt mode,SpecAnno mode];
   in gen_Anno_tac dest_specAnno rules all_tac cont_tac ctxt state_kind end;
 
 fun whileAnnoFix_tac ctxt state_kind cont_tac mode (t,i) =
   let
     fun dest (Const (@{const_name Language.whileAnnoFix},_)$b$I$V$c) = [I,V,c]
       | dest t = raise TERM ("dest_whileAnnoFix",[t]);
 
     val rules = [WhileAnnoFix mode];
     fun wf_tac' i = EVERY [REPEAT (resolve_tac ctxt [allI] i),
                            simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm split_conv}]) i,
                            wf_tac ctxt i];
     val tac = if mode=Total
               then EVERY [wf_tac' (i+3),in_rel_simp ctxt (i+1)]
               else all_tac
   in gen_Anno_tac dest rules tac cont_tac ctxt state_kind (t,i) end;
 
 fun lemAnno_tac ctxt state_kind mode (t,i) st =
   let
 
     fun dest_name (Const (x,_)) = x
       | dest_name (Free (x,_)) = x
       | dest_name t = raise TERM ("dest_name",[t]);
 
     fun dest_lemAnno (Const (@{const_name Language.lem},_)$n$c) =
       let val x = Long_Name.base_name (dest_name n);
       in
          (case try (Proof_Context.get_thm ctxt) x of
             NONE => error ("No lemma: '" ^ x ^ "' found.")
           | SOME spec => (strip_qnt_vars @{const_name All}
                            (HOLogic.dest_Trueprop (Thm.concl_of spec)),spec))
       end
       | dest_lemAnno t = raise TERM ("dest_lemAnno",[t]);
 
     val (vars,spec) = dest_lemAnno (#2 (dest_hoare t));
     val rules = [LemAnnoNoAbrupt mode,LemAnno mode];
     val rules' = (case vars of
                     [] => rules
                   | xs => adapt_aux_var ctxt true (map fst xs) (map get_aux_tvar rules));
 
   in EVERY [resolve_tac ctxt rules' i,
             resolve_tac ctxt [spec] (i+1),
             conseq_simp_tac ctxt state_kind [] i] st
   end
   handle TERM _ => no_tac st;
 
 fun prems_tac ctxt i = TRY (resolve_tac ctxt (Assumption.all_prems_of ctxt) i);
 
 
 
-fun mk_proc_assoc thms =
+fun mk_proc_assoc ctxt thms =
   let
-    fun name (_,p,_,_,cmode,_) = proc_name cmode p;
+    fun name (_,p,_,_,cmode,_,_) = proc_name ctxt cmode p;
     fun proc_name thm = thm |> Thm.concl_of |> dest_hoare |> #2 |> dest_call |> name;
   in map (fn thm => (proc_name thm,thm)) thms end;
 
 
 fun mk_hoare_tac cont ctxt mode i (name,tac) =
      EVERY [trace_tac ctxt ("trying: " ^ name),tac cont ctxt mode i];
 
 
 (* the main hoare tactic *)
 fun HoareTac annotate_inv exspecs
              strip_guards mode state_kind state_space
              spec_sfx ctxt tac st =
  let
      val (P,c,Q,A,_,G,T,F) = dest_hoare (Logic.strip_assums_concl
                                        (Logic.get_goal (Thm.prop_of st) 1));
-     val wp_tacs = #wp_tacs (get_data ctxt);
+     val solve_modifies = spec_sfx = modifysfx andalso annotate_inv andalso mode = Partial andalso
+            is_modifies_assertion Q andalso is_modifies_assertion A
+
+
      val hoare_tacs = #hoare_tacs (get_data ctxt);
      val params = (strip_vars (Logic.get_goal (Thm.prop_of st) 1));
      val Inv = (if annotate_inv
                 then (* Take the postcondition of the triple as invariant for all *)
                      (* while loops (makes sense for the modifies clause)         *)
                      SOME Q
                 else NONE);
      val exspecthms = map (Proof_Context.get_thm ctxt) exspecs;
      val asms =
        try (fn () =>
-         mk_proc_assoc (gen_context_thms ctxt mode params G T F @ exspecthms)) ()
+         mk_proc_assoc ctxt (gen_context_thms ctxt mode params G T F @ exspecthms)) ()
        |> the_default [];
 
      fun while_annoG_tac (t,i) =
            whileAnnoG_tac ctxt (annotate_inv orelse strip_guards) mode t i;
      fun WlpTac tac i = (* WlpTac does not end with subset_refl *)
          FIRST
-         ([EVERY [resolve_tac ctxt [Seq mode] i,trace_tac ctxt "Seq",HoareRuleTac tac false ctxt (i+1)],
-          EVERY [resolve_tac ctxt [Catch mode] i,trace_tac ctxt "Catch",HoareRuleTac tac false ctxt (i+1)],
-          EVERY [resolve_tac ctxt [CondCatch mode] i,trace_tac ctxt "CondCatch",HoareRuleTac tac false ctxt (i+1)],
-          EVERY [resolve_tac ctxt [BSeq mode] i,trace_tac ctxt "BSeq",HoareRuleTac tac false ctxt (i+1)],
+
+         ([EVERY [resolve_tac ctxt [Seq mode solve_modifies]  i,trace_tac ctxt "Seq", HoareRuleTac tac false ctxt (i+1)],
+          EVERY [resolve_tac ctxt [Catch mode solve_modifies] i,trace_tac ctxt "Catch",HoareRuleTac tac false ctxt (i+1)],
+          EVERY [resolve_tac ctxt [CondCatch mode solve_modifies] i,trace_tac ctxt "CondCatch",HoareRuleTac tac false ctxt (i+1)],
+          EVERY [resolve_tac ctxt [BSeq mode solve_modifies] i,trace_tac ctxt "BSeq",HoareRuleTac tac false ctxt (i+1)],
           EVERY [resolve_tac ctxt [FCall mode] i,trace_tac ctxt "FCall"],
           EVERY [resolve_tac ctxt [GuardsNil mode] i,trace_tac ctxt "GuardsNil"],
           EVERY [resolve_tac ctxt [GuardsConsGuaranteeStrip mode] i,
                  trace_tac ctxt "GuardsConsGuaranteeStrip"],
           EVERY [resolve_tac ctxt [GuardsCons mode] i,trace_tac ctxt "GuardsCons"],
           EVERY [SUBGOAL while_annoG_tac i]
-          ]
-         @
-         map (mk_hoare_tac (fn p => HoareRuleTac tac p ctxt) ctxt mode i) wp_tacs)
+          ])
 
      and HoareRuleTac tac pre_cond ctxt i st =
-         let fun call (t,i) = call_tac (HoareRuleTac tac false)
+         let
+             val _ = if Config.get ctxt hoare_trace > 1 then
+                       print_tac ctxt ("HoareRuleTac (" ^ @{make_string} (pre_cond, i) ^ "):") st
+                     else all_tac st
+             fun call (t,i) = call_tac (HoareRuleTac tac false)
                                 mode state_kind state_space ctxt asms spec_sfx t i
 
              fun cond_tac i =  if annotate_inv andalso Config.get ctxt use_cond_inv_modifies then
-                                 EVERY[SUBGOAL (cond_annotate_tac ctxt (the Inv) mode) i,
+                                 EVERY[SUBGOAL (cond_annotate_tac ctxt (the Inv) mode state_space) i,
                                        HoareRuleTac tac false ctxt (i+4),
                                        HoareRuleTac tac false ctxt (i+3),
                                        BasicSimpTac ctxt state_kind true [] tac (i+2),
                                        BasicSimpTac ctxt state_kind true [] tac (i+1)
                                       ]
                                else
                                  EVERY[resolve_tac ctxt [Cond mode] i,trace_tac ctxt "Cond",
                                        HoareRuleTac tac false ctxt (i+2),
                                        HoareRuleTac tac false ctxt (i+1)];
              fun switch_tac i = EVERY[resolve_tac ctxt [SwitchNil mode] i, trace_tac ctxt "SwitchNil"]
                                 ORELSE
                                 EVERY[resolve_tac ctxt [SwitchCons mode] i,trace_tac ctxt "SwitchCons",
                                      HoareRuleTac tac false ctxt (i+2),
                                      HoareRuleTac tac false ctxt (i+1)];
-            fun while_tac' (t,i) = while_tac ctxt state_kind Inv
+            fun while_tac' (t,i) = while_tac ctxt state_kind state_space Inv
                                       (HoareRuleTac tac true) tac mode t i;
          in st |>
            ( (WlpTac tac i THEN HoareRuleTac tac pre_cond ctxt i)
              ORELSE
-             (FIRST([EVERY[resolve_tac ctxt [Skip mode] i,trace_tac ctxt "Skip"],
+              (TRY (FIRST([EVERY[resolve_tac ctxt [Skip mode] i, trace_tac ctxt "Skip"],
                     EVERY[resolve_tac ctxt [BasicCond mode] i, trace_tac ctxt "BasicCond",
                           assertion_simp_tac ctxt state_kind [] i],
                     (resolve_tac ctxt [Basic mode] i THEN trace_tac ctxt "Basic")
                         THEN_MAYBE (assertion_simp_tac ctxt state_kind [] i),
                           (* we don't really need simplificaton here. The question is
                              if it is better to simplify the assertion after each Basic step,
                              so that intermediate assertions stay "small", or if we just
                              accumulate the raw assertions and leave the simplification to
                              the final BasicSimpTac *)
                     EVERY[resolve_tac ctxt [Throw mode] i, trace_tac ctxt "Throw"],
                     (resolve_tac ctxt [Raise mode] i THEN trace_tac ctxt "Raise")
                         THEN_MAYBE (assertion_string_eq_simp_tac ctxt state_kind [] i),
-                    cond_tac i,
-                    switch_tac i,
+                    EVERY[cond_tac i],
+                    EVERY[switch_tac i],
                     EVERY[resolve_tac ctxt [Block mode] i, trace_tac ctxt "Block",
                           resolve_tac ctxt [allI] (i+2),
                           resolve_tac ctxt [allI] (i+2),
                           HoareRuleTac tac false ctxt (i+2),
                           resolve_tac ctxt [allI] (i+1),
                           in_assertion_simp_tac ctxt state_kind [] (i+1),
                           HoareRuleTac tac false ctxt (i+1)],
                     SUBGOAL while_tac' i,
                     SUBGOAL (guard_tac ctxt (annotate_inv orelse strip_guards)
-                                       (HoareRuleTac tac false) mode) i,
+                               (HoareRuleTac tac false) mode THEN' (K (trace_tac ctxt "guard_tac succeeded"))) i,
                     EVERY[SUBGOAL (specAnno_tac ctxt state_kind
                                      (HoareRuleTac tac true) mode) i],
                     EVERY[SUBGOAL (whileAnnoFix_tac ctxt state_kind
                                      (HoareRuleTac tac true) mode) i],
                     EVERY[resolve_tac ctxt [SpecIf mode] i, trace_tac ctxt "SpecIf",
                           assertion_simp_tac ctxt state_kind [] i],
                     (resolve_tac ctxt [Spec mode] i THEN trace_tac ctxt "Spec")
                         THEN_MAYBE (assertion_simp_tac ctxt state_kind [@{thm split_conv}] i),
                     EVERY[resolve_tac ctxt [BindR mode] i, trace_tac ctxt "Bind",
                       resolve_tac ctxt [allI] (i+1),
                       HoareRuleTac tac false ctxt (i+1)],
                     EVERY[resolve_tac ctxt [DynCom mode] i, trace_tac ctxt "DynCom"],
                     EVERY[trace_tac ctxt "calling call_tac",SUBGOAL call i],
                     EVERY[trace_tac ctxt "LemmaAnno",SUBGOAL (lemAnno_tac ctxt state_kind mode) i]]
                     @
-                    map (mk_hoare_tac (fn p => HoareRuleTac tac p ctxt) ctxt mode i) hoare_tacs)
-              THEN (if pre_cond
-                    then EVERY [trace_tac ctxt "pre_cond",
-                                TRY (BasicSimpTac ctxt state_kind true [] tac i),
-                                             (* FIXME: Do we need TRY *)
-                                trace_tac ctxt "after BasicSimpTac"]
+                    map (mk_hoare_tac (fn p => HoareRuleTac tac p ctxt) ctxt mode i) hoare_tacs))
+              THEN (if pre_cond orelse solve_modifies
+                    then EVERY [trace_tac ctxt ("pre_cond / solve_modfies: " ^ @{make_string} (pre_cond, solve_modifies)),
+                                TRY (BasicSimpTac ctxt state_kind true (Named_Theorems.get ctxt @{named_theorems "state_simp"}) tac i),
+                                trace_tac ctxt ("after BasicSimpTac " ^ string_of_int i)]
                     else (resolve_tac ctxt [subset_refl] i))))
          end;
  in ((K (EVERY [REPEAT (resolve_tac ctxt [allI] 1), HoareRuleTac tac true ctxt 1]))
      THEN_ALL_NEW (prems_tac ctxt)) 1 st
       (*Procedure specifications may have an locale assumption as premise. These are
         accumulated by the vcg and are be solved afterward by prems_tac
       *)
  end;
 
 fun prefer_tac i = (Tactic.defer_tac i THEN PRIMITIVE (Thm.permute_prems 0 ~1));
 
 fun HoareStepTac strip_guards mode state_kind state_space spec_sfx ctxt tac st =
  let
      val asms =
        try (fn () =>
          let val (_,_,_,_,_,G,T,F) = dest_hoare (Logic.strip_assums_concl
                                                 (Logic.get_goal (Thm.prop_of st) 1));
              val params = (strip_vars (Logic.get_goal (Thm.prop_of st) 1));
-         in mk_proc_assoc (gen_context_thms ctxt mode params G T F)
+         in mk_proc_assoc ctxt (gen_context_thms ctxt mode params G T F)
          end) ()
        |> the_default [];
 
      fun result_tac ctxt' i = TRY (EVERY [resolve_tac ctxt' [Basic mode] i,
          resolve_tac ctxt' [subset_refl] i]);
      fun call (t,i) = call_tac result_tac mode state_kind state_space ctxt asms spec_sfx t i
 
      fun final_simp_tac i =
           EVERY [full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps [mem_Collect_eq]) i,
                  REPEAT (eresolve_tac ctxt [conjE] i),
                  TRY (hyp_subst_tac_thin true ctxt i),
                  BasicSimpTac ctxt state_kind true [] tac i]
      fun while_annoG_tac (t,i) = whileAnnoG_tac ctxt strip_guards mode t i;
-
- in st |>
+     val hoare_tacs = #hoare_tacs (get_data ctxt);
+ in st |> CHANGED (
     (REPEAT (resolve_tac ctxt [allI] 1)
      THEN
-     FIRST [resolve_tac ctxt [subset_refl] 1,
+     FIRST ([resolve_tac ctxt [subset_refl] 1,
            EVERY[resolve_tac ctxt [Skip mode] 1,TRY (BasicSimpTac ctxt state_kind false [] tac 1)],
            EVERY[resolve_tac ctxt [BasicCond mode] 1,trace_tac ctxt "BasicCond",
                  TRY (BasicSimpTac ctxt state_kind false [] tac 1)],
            EVERY[resolve_tac ctxt [Basic mode] 1,TRY (BasicSimpTac ctxt state_kind false [] tac 1)],
            EVERY[resolve_tac ctxt [Throw mode] 1,TRY (BasicSimpTac ctxt state_kind false [] tac 1)],
            EVERY[resolve_tac ctxt [Raise mode] 1,TRY (assertion_string_eq_simp_tac ctxt state_kind [] 1)],
            resolve_tac ctxt [SeqSwap mode] 1
-             THEN_MAYBE HoareStepTac strip_guards mode state_kind state_space spec_sfx
-                          ctxt tac,
-           EVERY[resolve_tac ctxt [BSeq mode] 1,
+             THEN_MAYBE TRY (HoareStepTac strip_guards mode state_kind state_space spec_sfx
+                          ctxt tac),
+           EVERY[resolve_tac ctxt [BSeq mode false] 1,
                  prefer_tac 2
                  THEN_MAYBE HoareStepTac strip_guards mode state_kind state_space spec_sfx
                               ctxt tac],
            resolve_tac ctxt [CondSwap mode] 1,
            resolve_tac ctxt [SwitchNil mode] 1,
            resolve_tac ctxt [SwitchCons mode] 1,
            EVERY [SUBGOAL while_annoG_tac 1],
            EVERY[resolve_tac ctxt [While mode] 1,
                  if mode=Total then wf_tac ctxt 4 else all_tac,
                  BasicSimpTac ctxt state_kind false [] tac 3,
                  if mode=Total then in_rel_simp ctxt 2 THEN (resolve_tac ctxt [allI] 2) else all_tac,
                  BasicSimpTac ctxt state_kind false [] tac 1],
            resolve_tac ctxt [CatchSwap mode] 1,
            resolve_tac ctxt [CondCatchSwap mode] 1,
            EVERY[resolve_tac ctxt [BlockSwap mode] 1, resolve_tac ctxt [allI] 1,
               resolve_tac ctxt [allI] 1,
               resolve_tac ctxt [allI] 2,
               BasicSimpTac ctxt state_kind false [] tac 2],
            resolve_tac ctxt [GuardsNil mode] 1,
            resolve_tac ctxt [GuardsConsGuaranteeStrip mode] 1,
            resolve_tac ctxt [GuardsCons mode] 1,
            SUBGOAL (guard_tac ctxt strip_guards (K (K all_tac)) mode) 1,
            EVERY[SUBGOAL (specAnno_tac ctxt state_kind (K (K all_tac)) mode) 1],
            EVERY[SUBGOAL (whileAnnoFix_tac ctxt state_kind (K (K all_tac)) mode) 1],
            EVERY[resolve_tac ctxt [SpecIf mode] 1,trace_tac ctxt "SpecIf",
                  TRY (BasicSimpTac ctxt state_kind false [] tac 1)],
            EVERY[resolve_tac ctxt [Spec mode] 1,
                  TRY (BasicSimpTac ctxt state_kind false [@{thm split_conv}] tac 1)],
            EVERY[resolve_tac ctxt [BindR mode] 1,
              resolve_tac ctxt [allI] 2, prefer_tac 2],
            EVERY[resolve_tac ctxt [FCall mode] 1],
            EVERY[resolve_tac ctxt [DynCom mode] 1],
            EVERY[SUBGOAL call 1, BasicSimpTac ctxt state_kind false [] tac 1],
            EVERY[SUBGOAL (lemAnno_tac ctxt state_kind mode) 1,
-                 BasicSimpTac ctxt state_kind false [] tac 1],
-           final_simp_tac 1
-           ])
+                 BasicSimpTac ctxt state_kind false [] tac 1]
+
+           ]  @
+           map (mk_hoare_tac (K (K all_tac)) ctxt mode 1) hoare_tacs @
+           [final_simp_tac 1])))
  end;
 
 (*****************************************************************************)
 (**  Generalise verification condition                                      **)
 (*****************************************************************************)
 
 structure RecordSplitState : SPLIT_STATE =
 struct
 
 val globals = @{const_name StateSpace.state.globals};
 
-fun isState (Const _$Abs (s,T,t)) =
+fun isState _ (Const _$Abs (s,T,t)) =
       (case (state_hierarchy T) of
         ((n,_)::_) => n = "StateSpace.state.state" andalso
           is_none (try dest_hoare_raw (strip_qnt_body @{const_name All} t))
       | _ => false)
-  | isState _ = false;
+  | isState _ _ = false;
 
 fun isFreeState (Free (_,T)) =
      (case (state_hierarchy T) of
         ((n,_)::_) => n = "StateSpace.state.state"
       | _ => false)
   | isFreeState _ = false;
 
-val abs_state = Option.map snd o first_subterm isFreeState;
+fun abs_state _ = Option.map snd o first_subterm isFreeState;
 
 
 fun sel_eq (Const (x,_)$_) y = (x=y)
   | sel_eq t y = raise TERM ("RecordSplitState.sel_eq",[t]);
 
 val sel_idx = idx sel_eq;
 
 fun bound xs (t as (Const (x,_)$_)) =
      let val i = sel_idx xs x
      in if i < 0 then (length xs, xs@[t]) else (i,xs) end
   | bound xs t = raise TERM ("RecordSplitState.bound",[t]);
 
-fun abs_var _ (Const (x,T)$_) =
-     (remdeco' (Long_Name.base_name x),range_type T)
+fun abs_var ctxt (Const (x,T)$_) =
+     (remdeco' ctxt (Long_Name.base_name x),range_type T)
   | abs_var _ t = raise TERM ("RecordSplitState.abs_var",[t]);
 
 fun fld_eq (x, _) y = (x = y)
 
 fun fld_idx xs x = idx fld_eq xs x;
 
 fun sort_vars ctxt T vars =
   let
     val thy = Proof_Context.theory_of ctxt;
     val (flds,_) = Record.get_recT_fields thy T;
     val gT = the (AList.lookup (fn (x:string,y) => x=y) flds globals);
     val (gflds,_) = (Record.get_recT_fields thy gT
                      handle TYPE _ => ([],("",dummyT)));
 
     fun compare (Const _$Free _, Const _$(Const _$Free _)) = GREATER
       | compare (Const (s1,_)$Free _, Const (s2,_)$Free _) =
            int_ord (fld_idx flds s1, fld_idx flds s2)
       | compare (Const (s1,_)$(Const _$Free _), Const (s2,_)$(Const _$Free _)) =
            int_ord (fld_idx gflds s1, fld_idx gflds s2)
       | compare _ = LESS;
   in sort (rev_order o compare) vars end;
 
 
 fun fold_state_prop loc glob app abs other inc s res (t as (Const (sel,_)$Free (s',_))) =
          if s'=s
          then if is_state_var sel
               then loc inc res t
               else raise TERM ("RecordSplitState.fold_state_prop",[t])
          else other res t
   | fold_state_prop loc glob app abs other inc s res
       (t as ((t1 as (Const (sel,_)))$(t2 as (Const (glb,_)$Free (s',_))))) =
          if s'=s andalso is_state_var sel andalso (glb=globals)
          then glob inc res t
          else let val res1 = fold_state_prop loc glob app abs other inc s res t1
                   val res2 = fold_state_prop loc glob app abs other inc s res1 t2
               in app res1 res2
               end
   | fold_state_prop loc glob app abs other inc s res (t as (Free (s',_))) =
          if s'=s then raise TERM ("RecordSplitState.fold_state_prop",[t])
          else other res t
   | fold_state_prop loc glob app abs other inc s res (t1$t2) =
          let val res1 = fold_state_prop loc glob app abs other inc s res t1
              val res2 = fold_state_prop loc glob app abs other inc s res1 t2
          in app res1 res2 end
   | fold_state_prop loc glob app abs other inc s res (Abs (x,T,t)) =
          let val res1 = fold_state_prop loc glob app abs other (inc+1) s res t
          in abs x T res1
          end
   | fold_state_prop loc glob app abs other inc s res t = other res t
 
 fun collect_vars s t =
   let
     fun loc _ vars t  = snd (bound vars t);
     fun glob _ vars t = snd (bound vars t);
     fun app _ vars2 = vars2;
     fun abs _ _ vars = vars;
     fun other vars _ = vars;
   in fold_state_prop loc glob app abs other 0 s [] t end;
 
 fun abstract_vars vars s t =
   let
     fun loc inc _ t  = let val i = fst (bound vars t) in Bound (i+inc) end;
     fun glob inc _ t = let val i = fst (bound vars t) in Bound (i+inc) end;
     fun app t1 t2 = t1$t2;
     fun abs x T t = Abs (x,T,t);
     fun other _ t = t;
     val dummy = Bound 0;
   in fold_state_prop loc glob app abs other 0 s dummy t end;
 
 fun split_state ctxt s T t =
   let
     val vars  = collect_vars s t;
     val vars' = if Config.get ctxt sort_variables then sort_vars ctxt T vars else vars;
   in (abstract_vars vars' s t,rev vars') end;
 
-fun ex_tac ctxt _ st = Record.split_simp_tac ctxt @{thms simp_thms} (K ~1) 1 st;
+fun ex_tac ctxt _ i = Record.split_simp_tac ctxt @{thms simp_thms} (K ~1) i;
 
 end;
 
 structure FunSplitState : SPLIT_STATE =
 struct
 
 val full_globalsN = @{const_name StateSpace.state.globals};
 
-fun isState (Const _$Abs (s,T,t)) =
+fun isState _ (Const _$Abs (s,T,t)) =
       (case (state_hierarchy T) of
         ((n,_)::_) => n = "StateSpace.state.state" andalso
           is_none (try dest_hoare_raw (strip_qnt_body @{const_name All} t))
       | _ => false)
-  | isState _ = false;
+  | isState _ _ = false;
 
 fun isFreeState (Free (_,T)) =
       (case (state_hierarchy T) of
         ((n,_)::_) => n = "StateSpace.state.state"
       | _ => false)
   | isFreeState _ = false;
 
-val abs_state = Option.map snd o first_subterm isFreeState;
+fun abs_state _ = Option.map snd o first_subterm isFreeState;
 
 fun comp_name t =
-    case try (implode o dest_string) t of
+    case try dest_string t of
       SOME str => str
     | NONE => (case t of
                  Free (s,_) => s
                | Const (s,_) => s
                | t => raise TERM ("FunSplitState.comp_name",[t]))
 
 fun sel_name (Const _$_$name$_) = comp_name name
   | sel_name t = raise TERM ("FunSplitState.sel_name",[t]);
 
 fun sel_raw_name (Const _$_$name$_) = name
   | sel_raw_name t = raise TERM ("FunSplitState.sel_raw_name",[t]);
 
 fun component_type (Const _$_$_$(sel$_)) = range_type (fastype_of sel)
   | component_type t = raise TERM ("FunSplitState.component_type",[t]);
 
 fun component_name (Const _$_$_$((Const (sel,_)$_))) = sel
   | component_name t = raise TERM ("FunSplitState.component_name",[t]);
 
 fun sel_type (Const _$destr$_$_) = range_type (fastype_of destr)
   | sel_type t = raise TERM ("FunSplitState.sel_type",[t]);
 
 fun sel_destr (Const _$destr$_$_) = destr
   | sel_destr t = raise TERM ("FunSplitState.sel_destr",[t]);
 
 fun sel_eq t y = (sel_name t = y)
   | sel_eq t y = raise TERM ("FunSplitState.sel_eq",[t]);
 
 val sel_idx = idx sel_eq;
 
 fun bound xs t =
      let val i = sel_idx xs (sel_name t)
      in if i < 0 then (length xs, xs@[t]) else (i,xs) end
   | bound xs t = raise TERM ("FunSplitState.bound",[t]);
 
 fun fold_state_prop var app abs other inc s res
       (t as (Const (@{const_name StateFun.lookup},_)$destr$name$(Const _$Free (s',_)))) =
          if s'=s
          then var inc res t
          else other res t (*raise TERM ("FunSplitState.fold_state_prop",[t])*)
   | fold_state_prop var app abs other inc s res (t as (Free (s',_))) =
          if s'=s then raise TERM ("FunSplitState.fold_state_prop",[t])
          else other res t
   | fold_state_prop var app abs other inc s res (t1$t2) =
          let val res1 = fold_state_prop var app abs other inc s res t1
              val res2 = fold_state_prop var app abs other inc s res1 t2
          in app res1 res2 end
   | fold_state_prop var app abs other inc s res (Abs (x,T,t)) =
          let val res1 = fold_state_prop var app abs other (inc+1) s res t
          in abs x T res1
          end
   | fold_state_prop var app abs other inc s res t = other res t
 
 fun collect_vars s t =
   let
     fun var _ vars t  = snd (bound vars t);
     fun app _ vars2 = vars2;
     fun abs _ _ vars = vars;
     fun other vars _ = vars;
   in fold_state_prop var app abs other 0 s [] t end;
 
 fun abstract_vars vars s t =
   let
     fun var inc _ t  = let val i = fst (bound vars t) in Bound (i+inc) end;
     fun app t1 t2 = t1$t2;
     fun abs x T t = Abs (x,T,t);
     fun other _ t = t;
     val dummy = Bound 0;
   in fold_state_prop var app abs other 0 s dummy t end;
 
-fun sort_vars _ vars =
+fun sort_vars ctxt vars =
   let
     val fld_idx = idx (fn s1:string => fn s2 => s1 = s2);
     fun compare (_$_$n$(Const (s1,_)$_),_$_$m$(Const (s2,_)$_)) =
       let
-        val n' = remdeco' (comp_name n);
-        val m' = remdeco' (comp_name m);
+        val n' = remdeco' ctxt (comp_name n);
+        val m' = remdeco' ctxt (comp_name m);
       in if s1 = full_globalsN
          then if s2 = full_globalsN then
               string_ord (n',m')
               else LESS
          else if s2 = full_globalsN then GREATER
               else string_ord (n',m')
       end
       | compare (t1,t2) = raise TERM ("FunSplitState.sort_vars.compare",[t1,t2]);
   in sort (rev_order o compare) vars end;
 
 fun split_state ctxt s _ t =
   let
     val vars  = collect_vars s t;
     val vars' = if Config.get ctxt sort_variables then sort_vars ctxt vars else vars;
   in (abstract_vars vars' s t,rev vars') end;
 
-fun abs_var _ t = (remdeco' (sel_name t), sel_type t);
+fun abs_var ctxt t = (remdeco' ctxt (sel_name t), sel_type t);
 
 (* Proof for: EX x_1 ... x_n. P x_1 ... x_n
  *            ==> EX s. P (lookup destr_1 "x_1" s) ... (lookup destr_n "x_n" s)
  * Implementation:
  * 1. Eliminate existential quantifiers in premise
  * 2. Instantiate s with:
        (%x. undefined)("x_1" := constr_1 x_1, ..., "x_n" := constr_n x_n)
  * 3. Simplify
  *)
 
 local
 
 val ss =
   simpset_of
     (put_simpset (simpset_of @{theory_context Fun}) @{context}
       addsimps (@{thm StateFun.lookup_def} :: @{thm StateFun.id_id_cancel}
       :: @{thms list.inject list.distinct char.inject
       cong_exp_iff_simps simp_thms})
     addsimprocs [Record.simproc, StateFun.lazy_conj_simproc]
     |> fold Simplifier.add_cong @{thms block_conj_cong});
 
 in
 
-fun ex_tac ctxt vs st =
+fun ex_tac ctxt vs = SUBGOAL (fn (goal, i) =>
   let
     val vs' = rev vs;
-    val (Const (_,exT)$_) = HOLogic.dest_Trueprop
-                             (Logic.strip_imp_concl (Logic.get_goal (Thm.prop_of st) 1));
+    val (Const (_,exT)$_) = HOLogic.dest_Trueprop (Logic.strip_imp_concl goal);
     val sT = domain_type (domain_type exT);
 
     val s0 = Const (@{const_name HOL.undefined},sT);
 
     fun streq (s1:string,s2) = s1=s2 ;
     fun mk_init []      = []
       | mk_init (t::ts) =
           let
              val xs = mk_init ts;
              val n = component_name t;
              val T = component_type t;
           in if AList.defined streq xs n then xs
              else (n,(T,Const (n,sT --> component_type t)$s0))::xs
           end;
 
     fun mk_upd (i,t) xs  =
       let
         val selN = component_name t;
         val selT = component_type t;
         val (_,s) = the (AList.lookup streq xs selN);
         val strT = domain_type selT;
         val valT = range_type selT;
         val constr = destr_to_constr (sel_destr t);
         val name = (sel_raw_name t);
         val upd =
           Const (@{const_name Fun.fun_upd}, (strT --> valT)-->strT-->valT--> (strT --> valT)) $
             s $ name $ (constr $ Bound i)
       in AList.update streq (selN,(selT,upd)) xs
       end;
 
     val upds = fold_index mk_upd vs' (mk_init vs');
 
     val upd = fold (fn (n,(T,upd)) => fn s =>
                       Const (n ^ Record.updateN, T --> sT --> sT)$upd$s)
                 upds
                 s0;
 
     val inst = fold_rev (Term.abs o (fn t => (sel_name t, sel_type t))) vs upd;
     fun lift_inst_ex_tac i st =
       let
         val rule  = Thm.lift_rule (Thm.cprem_of st i) (Drule.incr_indexes st exI);
         val (_$x) = HOLogic.dest_Trueprop (Logic.strip_assums_concl (hd (Thm.prems_of rule)));
         val inst_rule =
           infer_instantiate ctxt [(#1 (dest_Var (head_of x)), Thm.cterm_of ctxt inst)] rule;
       in (compose_tac ctxt (false,inst_rule, Thm.nprems_of exI) i st) end;
 
 
-  in EVERY [REPEAT_DETERM_N (length vs) (eresolve_tac ctxt [exE] 1),
-            lift_inst_ex_tac 1,
-            simp_tac (put_simpset ss ctxt) 1
-           ] st end
+  in EVERY
+       [REPEAT_DETERM_N (length vs) (eresolve_tac ctxt [exE] i),
+        lift_inst_ex_tac i,
+        simp_tac (put_simpset ss ctxt) i
+       ]
+  end
+)
+
 end
 (* Test: What happens when there are no lookups., EX s. True *)
 
 
 
 end;
 
-structure GeneraliseRecord = GeneraliseFun (structure SplitState=RecordSplitState);
-structure GeneraliseStateFun = GeneraliseFun (structure SplitState=FunSplitState);
-
-fun generalise Record = GeneraliseRecord.GENERALISE
-  | generalise Function = GeneraliseStateFun.GENERALISE;
+structure GeneraliseRecord = Generalise (structure SplitState=RecordSplitState);
+structure GeneraliseStateFun = Generalise (structure SplitState=FunSplitState);
+
+fun generalise _ Record = GeneraliseRecord.GENERALISE
+  | generalise _ Function = GeneraliseStateFun.GENERALISE
+  | generalise ctxt (Other i) = the (generalise_other ctxt i);
 
 (*****************************************************************************)
 (** record_vanish_tac splits up the records of a verification condition,    **)
 (** trying to generate a predicate without records.                         **)
 (** A typical verification condition with a procedure call will have the    **)
 (** form "!!s Z. s=Z ==> ..., where s and Z are records                     **)
 (*****************************************************************************)
 
-(* FIXME: Check out if removing the useless vars is a performance issue.
+(* fixme: Check out if removing the useless vars is a performance issue.
    If so, maybe we can remove all useless vars at once (no iterated simplification)
    or try to avoid introducing them.
    Bevore splitting the gaol we can simplifiy the goal with state_simproc this may leed
    to better performance...
 *)
 fun record_vanish_tac ctxt state_kind state_space i =
   if Config.get ctxt record_vanish then
     let
         val rem_useless_vars_simps = [Drule.triv_forall_equality,@{thm Hoare.triv_All_eq},@{thm Hoare.triv_Ex_eq}];
         val rem_useless_vars_simpset = empty_simpset ctxt addsimps rem_useless_vars_simps;
         fun no_spec (t as (Const (@{const_name All},_)$_)) =
               is_none (try dest_hoare_raw (strip_qnt_body @{const_name All} t))
           | no_spec _ = true;
         fun state_space_no_spec t = if state_space t <> 0 andalso no_spec t then
                                     ~1 else 0;
+        val state_split_tac = state_split_simp_tac ctxt rem_useless_vars_simps state_space_no_spec i
+        fun generalise_tac split_record st =
+          DETERM (generalise ctxt state_kind ctxt i) st
+          handle (exn as (TERM _)) =>
+            let
+              val _ = warning ("record_vanish_tac: generalise subgoal " ^ string_of_int i ^
+                        " failed" ^ (if split_record then ", fallback to record split:\n " else "") ^
+                        Runtime.exn_message (Runtime.exn_context (SOME ctxt) exn));
+            in
+              if split_record then
+                EVERY [
+                  state_split_tac,
+                  full_simp_tac (ctxt
+                    addsimprocs (state_simprocs ctxt state_kind @
+                      state_upd_simprocs ctxt state_kind)
+                    addsimps (Named_Theorems.get ctxt @{named_theorems "state_simp"})) i,
+                  trace_subgoal_tac ctxt "after record split and simp" i,
+                  generalise_tac false,
+                  trace_subgoal_tac ctxt "after 'generalise_tac false'" i
+                ] st
+              else all_tac st
+            end;
+
     in EVERY [trace_tac ctxt "record_vanish_tac -- START --",
               REPEAT (eresolve_tac ctxt [conjE] i),
               trace_tac ctxt "record_vanish_tac -- hyp_subst_tac ctxt --",
               TRY (hyp_subst_tac_thin true ctxt i),
               full_simp_tac rem_useless_vars_simpset i,
                (* hyp_subst_tac may have made some state variables unnecessary. We do not
                   want to split them to avoid naming conflicts and increase performance *)
               trace_tac ctxt "record_vanish_tac -- Splitting records --",
               if Config.get ctxt use_generalise orelse state_kind = Function
-              then generalise state_kind ctxt i
-              else state_split_simp_tac ctxt rem_useless_vars_simps state_space_no_spec i
-              (*THEN_MAYBE
-              EVERY [trace_tac ctxt "record_vanish_tac -- removing useless vars --",
-                     full_simp_tac rem_useless_vars_simpset i,
-                     trace_tac ctxt "record_vanish_tac -- STOP --"]*)
+              then EVERY [generalise_tac true]
+              else state_split_tac
               ]
     end
   else
     all_tac;
 
 (* solve_modifies_tac tries to solve modifies-clauses automatically;
  * The following strategy is followed:
  * After clar-simplifying the modifies clause we remain with a goal of the form
  *
  *  EX a b. s(|A := x|) = s(|A:=a,B:=b|)
  *
  * (or because of conditional statements conjunctions of these kind of goals)
  * We split up the state-records and simplify (record_vanish_tac) and get to a goal of the form:
  *
  * EX a b. (|A=x,B=B|) = (|A=a,B=b|).
  *
  * If the modifies clause was correct we just have to introduce the existential quantifies
  * and apply reflexivity.
  * If not we just simplify the goal.
 *)
 
 
 local
 
 val state_fun_update_ss =
   simpset_of (put_simpset HOL_basic_ss @{context}
     addsimps ([@{thm StateFun.update_def}, @{thm id_def}, @{thm fun_upd_apply}, @{thm if_True}, @{thm if_False}]
       @ @{thms list.inject list.distinct char.inject
       cong_exp_iff_simps simp_thms} @ K_fun_convs)
     addsimprocs [DistinctTreeProver.distinct_simproc ["distinct_fields", "distinct_fields_globals"]]
-    |> Simplifier.add_cong @{thm imp_cong} (* K_fun_congs  FIXME: Stefan fragen*)
+    |> Simplifier.add_cong @{thm imp_cong}
     |> Splitter.add_split @{thm if_split});
 
 in
 
 fun solve_modifies_tac ctxt state_kind state_space i st =
   let
     val thy = Proof_Context.theory_of ctxt;
     fun is_split_state (trm as (Const (@{const_name Pure.all},_)$Abs(x,T,t))) =
       if state_space trm <> 0 then
         try (fn () =>
           let
             fun seed (_ $ v $ st) = seed st
               | seed (_ $ t) = (1,t) (* split only state pair *)
               | seed t = (~1,t) (* split globals completely *)
             val all_vars = strip_qnt_vars @{const_name Pure.all} t;
             val concl = HOLogic.dest_Trueprop (Logic.strip_assums_concl t);
             val ex_vars = strip_qnt_vars @{const_name Ex} concl;
             val state = Bound (length all_vars + length ex_vars);
             val (Const (@{const_name HOL.eq},_)$x_upd$x_upd') = strip_qnt_body @{const_name Ex} concl;
             val (split,sd) = seed x_upd;
           in if sd = state then split else 0 end) ()
         |> the_default 0
       else 0
       | is_split_state t = 0;
     val simp_ctxt = put_simpset HOL_ss ctxt addsimps (@{thm Ex_True} :: @{thm Ex_False} :: Record.get_extinjects thy);
-      fun try_solve Record i = (*(SOLVE*)
-          (((fn k => (TRY (REPEAT_ALL_NEW (resolve_tac ctxt [conjI, impI, allI]) k)))
-            THEN_ALL_NEW
-          (fn k => EVERY [state_split_simp_tac ctxt [] is_split_state k,
-                          simp_tac simp_ctxt k THEN_MAYBE rename_goal ctxt remdeco' k
-                          ])) i) (*)*)
-        | try_solve _ i =
+      fun try_solve Function i =
            ((fn k => (TRY (REPEAT_ALL_NEW (resolve_tac ctxt [conjI, impI, allI]) k)))
              THEN_ALL_NEW
             (fn k => REPEAT (resolve_tac ctxt [exI] k) THEN
                      resolve_tac ctxt [ext] k THEN
                      simp_tac (put_simpset state_fun_update_ss ctxt) k
                      THEN_MAYBE
                      (REPEAT_ALL_NEW (resolve_tac ctxt [conjI,impI,refl]) k))) i
+       |  try_solve _ i = (*(SOLVE*) (* Record and Others *)
+            (((fn k => (TRY (REPEAT_ALL_NEW (resolve_tac ctxt [conjI, impI, allI]) k)))
+              THEN_ALL_NEW
+            (fn k => EVERY [state_split_simp_tac ctxt [] is_split_state k,
+                            simp_tac simp_ctxt k THEN_MAYBE rename_goal ctxt (remdeco' ctxt) k
+                           ])) i) (*)*)
   in
     ((trace_tac ctxt "solve_modifies_tac" THEN
      clarsimp_tac ((ctxt
         |> put_claset (claset_of @{theory_context HOL})
         |> put_simpset (simpset_of @{theory_context Set}))
-        addsimps ([@{thm Hoare.mex_def},@{thm Hoare.meq_def}]@K_convs)
-        addsimprocs (state_upd_simproc Record::(state_simprocs Record))
+        addsimps (@{thms Hoare.mex_def Hoare.meq_def} @K_convs@(Named_Theorems.get ctxt @{named_theorems "state_simp"}))
+        addsimprocs (state_upd_simprocs ctxt Record @ state_simprocs ctxt Record)
         |> fold Simplifier.add_cong K_congs) i)
     THEN_MAYBE
-     try_solve state_kind i) st
+     (try_solve state_kind i)) st
   end;
 end
 
 fun proc_lookup_simp_tac ctxt i st =
   try (fn () =>
     let
       val name = (Logic.concl_of_goal (Thm.prop_of st) i)
             |> dest_hoare |> #2 |> strip_comb |> #2 |> last |> strip_comb |> #2 |> last;
             (* the$(Gamma$name) or the$(strip$Gamma$name) *)
-      val pname = (unsuffix proc_deco (dest_string' name));
+      val pname = chopsfx proc_deco (dest_string' name);
       val thms =  map_filter I (map (try (Proof_Context.get_thm ctxt))
                               [suffix bodyP pname,
                                suffix (body_def_sfx^"_def") pname,
                                suffix procL pname^"."^ (suffix (body_def_sfx^"_def") pname)]);
     in simp_tac (put_simpset HOL_basic_ss ctxt addsimps thms @ strip_simps @ @{thms option.sel}) i st end) ()
   |> the_default (Seq.single st);
 
 fun proc_lookup_in_dom_simp_tac ctxt i st =
   try (fn () =>
     let
       val _$name$_  = (HOLogic.dest_Trueprop (Logic.concl_of_goal (Thm.prop_of st) i));
           (* name : Gamma *)
-      val pname = (unsuffix proc_deco (dest_string' name));
+      val pname = chopsfx proc_deco (dest_string' name);
       val thms =  map_filter I (map (try (Proof_Context.get_thm ctxt))
-                                 [suffix bodyP pname]);
+                                 [suffix bodyP pname, suffix "_def" pname]);
     in
       simp_tac (put_simpset HOL_basic_ss ctxt
         addsimps (@{thm Hoare.lookup_Some_in_dom} :: @{thm dom_strip} :: thms)) i st end) ()
   |> the_default (Seq.single st);
 
 
 fun HoareRuleTac ctxt insts fixes st =
   let
     val annotate_simp_tac =
       simp_tac (put_simpset HOL_basic_ss ctxt
         addsimps (anno_defs@normalize_simps)
         addsimprocs [@{simproc case_prod_beta}]);
     fun is_com_eq (Const (@{const_name Trueprop},_)$(Const (@{const_name HOL.eq},T)$_$_)) =
           (case (binder_types T) of
              (Type (@{type_name Language.com},_)::_) => true
            | _ => false)
        | is_com_eq _ = false;
     fun annotate_tac i st =
         if is_com_eq (Logic.concl_of_goal (Thm.prop_of st) i)
         then annotate_simp_tac i st
         else all_tac st;
   in
     ((fn i => REPEAT (resolve_tac ctxt [allI] i)) THEN'
       Rule_Insts.res_inst_tac ctxt insts fixes st)
       THEN_ALL_NEW annotate_tac
   end;
 
 fun HoareCallRuleTac state_kind state_space ctxt thms i st =
   let
     fun dest_All (Const (@{const_name All},_)$t) = SOME t
       | dest_All _ = NONE;
 
     fun auxvars t =
          (case (map_filter ((first_subterm is_hoare) o snd) (max_subterms_dest dest_All t)) of
              ((vars,_)::_) => vars
            | _ => []);
 
     fun auxtype rule =
          (case (auxvars (Thm.prop_of rule)) of
            [] => NONE
           | vs => (case (last vs) of
                      (_,TVar (z,_)) => SOME (z,rule)
                    | _ => NONE));
 
     val thms' =
       let val auxvs = map fst (auxvars (Logic.concl_of_goal (Thm.prop_of st) i));
           val tvar_thms = map_filter auxtype thms
       in if length thms = length tvar_thms
          then adapt_aux_var ctxt true auxvs tvar_thms
          else thms
       end;
     val is_sidecondition = not o can dest_hoare;
     fun solve_sidecondition_tac (t,i) =
         if is_sidecondition t
         then FIRST
                [CHANGED_PROP (wf_tac ctxt i),
                 (*init_conforms_tac state_kind state_space i,*)
                 post_conforms_tac ctxt state_kind i THEN_MAYBE
                  (if is_modifies_clause t
                   then solve_modifies_tac ctxt state_kind state_space i
                   else all_tac),
                 proc_lookup_in_dom_simp_tac ctxt i
                 ]
         else in_rel_simp ctxt i THEN
              simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm Un_empty_left},@{thm Un_empty_right}]) i THEN
              proc_lookup_simp_tac ctxt i
 
     fun basic_tac i = (((resolve_tac ctxt thms')
                        THEN_ALL_NEW
-                       (fn k => (SUBGOAL solve_sidecondition_tac k))) i)
+                       (fn k =>
+                          (SUBGOAL solve_sidecondition_tac k))) i)
   in  (basic_tac
         ORELSE'
        (fn k =>
          (REPEAT (resolve_tac ctxt [allI] k))
            THEN EVERY [resolve_tac ctxt thms' k])) i st
   end;
 
 (* vcg_polish_tac tries to solve modifies-clauses automatically; for other specifications the
  * records are only splitted and simplified.
 *)
 fun vcg_polish_tac solve_modifies ctxt state_kind state_space i =
     if solve_modifies
     then solve_modifies_tac ctxt state_kind state_space i
     else record_vanish_tac ctxt state_kind state_space i
-         THEN_MAYBE EVERY [rename_goal ctxt remdeco' i(*,
+         THEN_MAYBE EVERY [rename_goal ctxt (remdeco' ctxt) i(*,
                            simp_tac (HOL_basic_ss addsimps @{thms simp_thms})) i*)];
 
 fun is_funtype (Type ("fun", _)) = true
   | is_funtype _ = false;
 
+fun get_state_kind_extension ctxt T =
+  let
+    val sps = #state_spaces (Hoare_Data.get (Context.Proof ctxt))
+  in
+    case find_first (fn (n, sp) => (#is_state_type sp) ctxt T) sps of
+      SOME (n, sp) => SOME n
+    | NONE => NONE
+  end
+
 fun state_kind_of ctxt T =
   let
     val thy = Proof_Context.theory_of ctxt;
     val (s,sT) = nth (fst (Record.get_recT_fields thy T)) 1;
-  in if Long_Name.base_name s = "locals" andalso is_funtype sT then Function else Record end
+  in
+    case get_state_kind_extension ctxt T of
+      SOME n => Other n
+    | _ => if Long_Name.base_name s = "locals" andalso is_funtype sT then
+             Function
+           else
+             Record
+  end
   handle Subscript => Record;
 
 fun find_state_space_in_triple ctxt t =
   try (fn () =>
     (case first_subterm is_hoare t of
        NONE => NONE
      | SOME (abs_vars,triple) =>
         let
            val (_,com,_,_,mode,_,_,_) = dest_hoare_raw triple;
            val T = fastype_of1 (map snd abs_vars,com)
            val Type(_,state_spaceT::_) = T;
            val SOME Tids = stateT_ids state_spaceT;
         in SOME (Tids,mode, state_kind_of ctxt state_spaceT)
         end)) ()
   |> Option.join;
 
 fun get_state_space_in_subset_eq ctxt t =
   (* get state type from the following kind of terms: P <= Q, s: P *)
   try (fn () =>
     let
       val (subset_eq,_) =
         (strip_comb o HOLogic.dest_Trueprop o strip_qnt_body @{const_name Pure.all}) t;
       val Ts = map snd (strip_vars t);
       val T = fastype_of1 (Ts,subset_eq);
       val Type (_, [_,Type (_, [Type (_, [state_spaceT]), _])]) = T;
               (* also works for "in": x : P *)
       val SOME Tids = stateT_ids state_spaceT;
     in (Tids,Partial, state_kind_of ctxt state_spaceT) end) ();
 
 fun get_state_space ctxt i st =
   (case try (Logic.concl_of_goal (Thm.prop_of st)) i of
      SOME t => (case find_state_space_in_triple ctxt t of
                   SOME sp => SOME sp
                 | NONE => get_state_space_in_subset_eq ctxt t)
    | NONE => NONE);
 
 fun mk_hoare_tac hoare_tac finish_tac annotate_inv exnames
                  strip_guards spec_sfx ctxt i st =
     case get_state_space ctxt i st of
        SOME (Tids,mode,kind)
        => SELECT_GOAL
             (hoare_tac annotate_inv exnames strip_guards mode kind (is_state_space_var Tids)
                    spec_sfx ctxt (finish_tac kind (is_state_space_var Tids))) i st
      | NONE => no_tac st
 
 fun vcg_tac spec_sfx strip_guards exnames ctxt i st =
   mk_hoare_tac HoareTac (vcg_polish_tac (spec_sfx="_modifies") ctxt)
       (spec_sfx="_modifies") exnames (strip_guards="true") spec_sfx ctxt i st;
 
 fun hoare_tac spec_sfx strip_guards _ ctxt i st =
   let fun tac state_kind state_space i = if spec_sfx="_modifies"
                then solve_modifies_tac ctxt state_kind state_space i
                else all_tac;
 
   in mk_hoare_tac HoareTac tac (spec_sfx="_modifies") []
                   (strip_guards="true") spec_sfx ctxt i st
   end;
 
 fun hoare_raw_tac spec_sfx strip_guards exnames ctxt i st =
   mk_hoare_tac HoareTac (K (K (K all_tac)))
      (spec_sfx="_modifies") [] (strip_guards="true") spec_sfx
      ctxt i st;
 
 
 fun hoare_step_tac spec_sfx strip_guards exnames ctxt i st =
   mk_hoare_tac (K (K HoareStepTac)) (vcg_polish_tac (spec_sfx="_modifies")
      ctxt) false [] (strip_guards="true") spec_sfx ctxt i st;
 
 fun hoare_rule_tac ctxt thms i st = SUBGOAL (fn _ =>
     (case get_state_space ctxt i st of
        SOME (Tids,_,kind) => HoareCallRuleTac kind (is_state_space_var Tids) ctxt thms i
      | NONE => error "could not find proper state space type (structure or record) in goal")) i st;
 
 
 (*** Methods ***)
 
 val hoare_rule = Rule_Insts.method HoareRuleTac hoare_rule_tac;
 
 val argP = Args.name --| @{keyword "="} -- Args.name
 val argsP = Scan.repeat argP
 val default_args = [("spec","spec"),("strip_guards","false")]
 
 val vcg_simp_modifiers =
   [Args.add -- Args.colon >> K (Method.modifier vcg_simp_add \<^here>),
    Args.del -- Args.colon >> K (Method.modifier vcg_simp_del \<^here>)];
 
 fun assocs2 key = map snd o filter (curry (op =) key o fst);
 
 fun gen_simp_method tac =
   Scan.lift (argsP >> (fn args => args @ default_args)) --|
   Method.sections vcg_simp_modifiers >>
     (fn args => fn ctxt => Method.SIMPLE_METHOD'
       (tac ("_" ^ the (AList.lookup (op =) args "spec"))
         (the (AList.lookup (op =) args "strip_guards"))
         (assocs2 "exspec" args) ctxt));
 
 val hoare = gen_simp_method hoare_tac;
 val hoare_raw = gen_simp_method hoare_raw_tac;
 val vcg = gen_simp_method vcg_tac;
 val vcg_step = gen_simp_method hoare_step_tac;
 
 
 val trace_hoare_users = Unsynchronized.ref false
 
-fun print_subgoal_tac ctxt s i =
-    SUBGOAL (fn (prem, _) => trace_tac ctxt (s ^ (Syntax.string_of_term ctxt prem))) i
-
 fun mk_hoare_thm thm _ ctxt _ i =
-    EVERY [resolve_tac ctxt [thm] i,
-      if !trace_hoare_users then print_subgoal_tac ctxt "Tracing: " i
+    EVERY [resolve_tac ctxt [Thm.transfer' ctxt thm] i,
+      if !trace_hoare_users then trace_subgoal_tac ctxt "Tracing: " i
       else all_tac]
 
 val vcg_hoare_add =
-    Thm.declaration_attribute (fn thm => add_hoare_tacs [(Thm.derivation_name thm, mk_hoare_thm thm)])
+  let
+    fun get_name thm =
+      case Properties.get (Thm.get_tags thm) Markup.nameN of
+        SOME n => n
+      | NONE => error ("theorem with attribute 'vcg_hoare' must have a name")
+  in
+    Thm.declaration_attribute (fn thm =>
+      add_hoare_tacs [(get_name thm, mk_hoare_thm (Thm.trim_context thm))])
+  end
 
 exception UNDEF
 val vcg_hoare_del =
     Thm.declaration_attribute (fn _ => fn _ => raise UNDEF)
 
 
 (* setup theory *)
 
 val _ =
   Theory.setup
     (Attrib.setup @{binding vcg_simp} (Attrib.add_del vcg_simp_add vcg_simp_del)
       "declaration of Simplifier rule for vcg"
     #>
     Attrib.setup @{binding vcg_hoare} (Attrib.add_del vcg_hoare_add vcg_hoare_del)
       "declaration of wp rule for vcg")
-    (*#> add_wp_tacs initial_wp_tacs*)
 
 end;
diff --git a/thys/Simpl/hoare_syntax.ML b/thys/Simpl/hoare_syntax.ML
--- a/thys/Simpl/hoare_syntax.ML
+++ b/thys/Simpl/hoare_syntax.ML
@@ -1,1625 +1,1743 @@
 (*  Title:      hoare_syntax.ML
     Author:     Norbert Schirmer, TU Muenchen
 
 Copyright (C) 2004-2007 Norbert Schirmer
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as
-published by the Free Software Foundation; either version 2.1 of the
-License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright (c) 2022 Apple Inc. All rights reserved.
 *)
 
-(* FIXME: Adapt guard generation to new syntax of op + etc. *)
+(* fixme: Adapt guard generation to new syntax of op + etc. *)
 
 signature HOARE_SYNTAX =
 sig
   val antiquoteCur: string
   val antiquoteOld: string
   val antiquoteOld_tr: Proof.context -> term list -> term
   val antiquote_applied_only_to: (term -> bool) -> term -> bool
   val antiquote_varname_tr: string -> term list -> term
   val app_quote_tr': Proof.context -> term -> term list -> term
   val assert_tr': Proof.context -> term list -> term
   val assign_tr': Proof.context -> term list -> term
   val assign_tr: Proof.context -> term list -> term
   val basic_assigns_tr: Proof.context -> term list -> term
   val basic_tr': Proof.context -> term list -> term
   val basic_tr: Proof.context -> term list -> term
   val bexp_tr': string -> Proof.context -> term list -> term
   val bind_tr': Proof.context -> term list -> term
-  val call_ass_tr: bool -> bool -> Proof.context -> term list -> term
+  val call_ass_tr: bool -> bool -> term list -> Proof.context -> term list -> term
   val call_tr': Proof.context -> term list -> term
-  val call_tr: bool -> bool -> Proof.context -> term list -> term
+  val call_exn_tr': Proof.context -> term list -> term
+  val call_tr: bool -> bool -> term list -> Proof.context -> term list -> term
   val dyn_call_tr': Proof.context -> term list -> term
+  val dyn_call_exn_tr': Proof.context -> term list -> term
   val fcall_tr': Proof.context -> term list -> term
   val fcall_tr: Proof.context -> term list -> term
   val guarded_Assign_tr: Proof.context -> term list -> term
   val guarded_Cond_tr: Proof.context -> term list -> term
   val guarded_NNew_tr: Proof.context -> term list -> term
   val guarded_New_tr: Proof.context -> term list -> term
   val guarded_WhileFix_tr: Proof.context -> term list -> term
   val guarded_While_tr: Proof.context -> term list -> term
   val guards_tr': Proof.context -> term list -> term
   val hide_guards: bool Config.T
   val init_tr': Proof.context -> term list -> term
   val init_tr: Proof.context -> term list -> term
   val loc_tr': Proof.context -> term list -> term
   val loc_tr: Proof.context -> term list -> term
   val new_tr : Proof.context -> term list -> term
   val new_tr': Proof.context -> term list -> term
   val nnew_tr : Proof.context -> term list -> term
   val nnew_tr': Proof.context -> term list -> term
   val proc_ass_tr: Proof.context -> term list -> term
   val proc_tr': Proof.context -> term list -> term
   val proc_tr: Proof.context -> term list -> term
   val quote_mult_tr': Proof.context -> (term -> bool) -> string -> string -> term -> term
   val quote_tr': Proof.context -> string -> term -> term
   val quote_tr: Proof.context -> string -> term -> term
   val raise_tr': Proof.context -> term list -> term
   val raise_tr: Proof.context -> term list -> term
   val switch_tr': Proof.context -> term list -> term
-  val update_comp: Proof.context -> string list -> bool -> bool -> xstring -> term -> term -> term
+  val update_comp: Proof.context -> Hoare.lense option -> string list -> bool -> bool -> xstring -> term -> term -> term
   val use_call_tr': bool Config.T
   val whileAnnoGFix_tr': Proof.context -> term list -> term
   val whileAnnoG_tr': Proof.context -> term list -> term
 end;
 
 structure Hoare_Syntax: HOARE_SYNTAX =
 struct
 
 val use_call_tr' = Attrib.setup_config_bool @{binding hoare_use_call_tr'} (K true);
 val hide_guards = Attrib.setup_config_bool @{binding hoare_hide_guards} (K false);
 
 val globalsN = "globals";
 val localsN = "locals";
 val globals_updateN = suffix Record.updateN globalsN;
 val locals_updateN = suffix Record.updateN localsN;
-val upd_globalsN = "upd_globals";   (* FIXME authentic syntax !? *)
+val upd_globalsN = "upd_globals";   (* fixme authentic syntax !? *)
 val allocN = "alloc_'";
 val freeN = "free_'";
 
-val Null = Syntax.free "Simpl_Heap.Null";   (* FIXME ?? *)
+val Null = Syntax.free "Simpl_Heap.Null";   (* fixme ?? *)
 
 
 (** utils **)
 
 (* transpose [[a,b],[c,d],[e,f]] = [[a,c,d],[b,d,f]] *)
 fun transpose [[]] = [[]]
   | transpose ([]::xs) = []
   | transpose ((y::ys)::xs) = (y::map hd xs)::transpose (ys::map tl xs)
 
 fun maxprefix eq ([], ys) = []
   | maxprefix eq (xs, []) = []
   | maxprefix eq ((x::xs),(y::ys)) = if eq (x,y)
                                      then x::maxprefix eq (xs,ys)
                                      else []
 
 fun maxprefixs eq [] = []
   | maxprefixs eq [[]] = []
   | maxprefixs eq xss = foldr1 (maxprefix eq) xss;
 
 fun mk_list [] = Syntax.const @{const_syntax Nil}
   | mk_list (x::xs) = Syntax.const @{const_syntax Cons} $ x $ mk_list xs;
 
 (* convert Fail to Match, useful for print translations *)
 fun unsuffix' sfx a = unsuffix sfx a handle Fail _ => raise Match;
 fun unsuffixI sfx a = unsuffix sfx a handle Fail _ => a;
 
 fun is_prefix_or_suffix s t =
   can (unprefix s) t orelse can (unsuffix s) t;
 
 
+fun is_other ctxt = case Hoare.get_default_state_kind ctxt of Hoare.Other _ => true | _ => false
+
 (** hoare data **)
 
 fun is_global_comp ctxt name =
-  (case StateSpace.get_comp (Context.Proof ctxt) name of
-    SOME (_, ln) => is_prefix_or_suffix "globals" (Long_Name.base_name ln)
-  | NONE => false);
-
+  let
+    val res = case Hoare.get_default_state_space ctxt of
+                SOME {is_defined, ...} => not (is_defined ctxt name)
+              | _ =>
+                (case StateSpace.get_comp' (Context.Proof ctxt) name of
+                  SOME (_, lns) => forall (fn ln => is_prefix_or_suffix "globals" (Long_Name.base_name ln)) lns
+                | NONE => false)
+  in
+    res
+  end
 
 (** parsing and printing **)
 
 (* quote/antiquote *)
 
 val antiquoteCur = @{syntax_const "_antiquoteCur"};
 val antiquoteOld = @{syntax_const "_antiquoteOld"};
 
 fun intern_const_syntax consts =
   Consts.intern_syntax consts #> perhaps Long_Name.dest_hidden;
 
 fun is_global ctxt name =
   let
     val thy = Proof_Context.theory_of ctxt;
     val consts = Proof_Context.consts_of ctxt;
   in
     (case Sign.const_type thy (intern_const_syntax consts name) of
       NONE => is_global_comp ctxt name
     | SOME T => String.isPrefix globalsN (Long_Name.base_name (fst (dest_Type (domain_type T)))))
     handle Match => false
   end;
 
 exception UNDEFINED of string
 
-(* FIXME: if is_state_var etc. is reimplemented, rethink about when adding the deco to
+(* fixme: if is_state_var etc. is reimplemented, rethink about when adding the deco to
    the records *)
 
 fun first_successful_tr _ [] = raise TERM ("first_successful_tr: no success",[])
   | first_successful_tr f [x] = f x
   | first_successful_tr f (x::xs) = f x handle TERM _ => first_successful_tr f xs;
 
 fun statespace_lookup_tr ctxt ps s n =
-  let
-    val cn = map Hoare.clique_name (#active_procs (Hoare.get_data ctxt));
-    val procs = ps @ cn;
-    val names =
-      n :: map (fn p => (suffix (Hoare.par_deco p) (unsuffixI Hoare.deco n))) procs;
-  in first_successful_tr (StateSpace.gen_lookup_tr ctxt s) names
-  end;
+  case Hoare.get_default_state_space ctxt of
+    SOME {lookup_tr, ...} => lookup_tr ctxt n $ s
+  | _ =>
+      let
+        val cn = map Hoare.clique_name (#active_procs (Hoare.get_data ctxt));
+        val procs = ps @ cn;
+        val names =
+          (Hoare.name_tr ctxt true n) :: map (fn p => (suffix (Hoare.par_deco p) (unsuffixI Hoare.deco n))) procs;
+      in
+        first_successful_tr (StateSpace.gen_lookup_tr ctxt s) names
+      end
 
-fun statespace_update_tr ctxt ps id n v s =
-  let
-    val cn = map Hoare.clique_name (#active_procs (Hoare.get_data ctxt));
-    val procs = ps @ cn;
-    val names =
-      n :: map (fn p => (suffix (Hoare.par_deco p) (unsuffixI Hoare.deco n))) procs;
-  in first_successful_tr (fn n => StateSpace.gen_update_tr id ctxt n v s) names
-  end;
+fun K_rec_syntax v = Abs ("_", dummyT, incr_boundvars 1 v);
+
+fun statespace_update_tr ctxt NONE ps id n v =
+      (case Hoare.get_default_state_space ctxt of
+        SOME {update_tr, ...} => update_tr ctxt n $ K_rec_syntax v
+      | _ =>
+        let
+          fun gen_update_tr id ctxt n v =
+            StateSpace.gen'_update_tr true id ctxt n v (Bound 0) |> dest_comb |> fst
+
+          val cn = map Hoare.clique_name (#active_procs (Hoare.get_data ctxt));
+          val procs = ps @ cn;
+          val names =
+            (Hoare.name_tr ctxt true n) :: map (fn p => (suffix (Hoare.par_deco p) (unsuffixI Hoare.deco n))) procs;
+        in first_successful_tr (fn n => gen_update_tr id ctxt n v) names
+        end)
+  | statespace_update_tr ctxt (SOME {lookup, update}) ps id n v =
+      update $ K_rec_syntax v
+
 
 local
   fun is_record_sel ctxt nm =
     let
-      val consts = Proof_Context.consts_of ctxt;
-      val exists_const = can (Consts.the_const consts) o intern_const_syntax consts;
-      val exists_abbrev = can (Consts.the_abbreviation consts) o intern_const_syntax consts;
-    in (exists_const nm) orelse (exists_abbrev nm) end;
+      val SOME (Const (c, T)) = try (Syntax.read_term ctxt) nm
+      val recT = domain_type T
+      val (flds, _) = Record.get_recT_fields (Proof_Context.theory_of ctxt) recT
+    in member (op =) (map fst flds) c end
+    handle TYPE _ => false
+         | Bind  => false
+         | Match => false
 in
 
 fun lookup_comp ctxt ps name =
   if is_record_sel ctxt name
   then
     if is_global ctxt name
     then (fn s => Syntax.free name $ (Syntax.free "globals" $ s))
     else (fn s => Syntax.free name $ s)
   else
     let
       val sel = Syntax.const (if is_global_comp ctxt name then "globals" else "locals");
     in (fn s => statespace_lookup_tr ctxt ps (sel $ s) name) end;
 
 (*
-FIXME:
+fixme:
 update of global and local components:
 One should generally provide functions:
 glob_upd:: ('g => 'g) => 's => 's
 loc_upd:: ('l => 'l) => 's => 's
 so that global and local updates can nicely be composed.
 loc_upd for the record implementation is vacuous.
 Right now for example an assignment of NEW to a global variable returns
 a funny repeated update of global components...
 
 This would make the composition more straightforward...
 Basically one wants the map on a component rather then the update. Maps can
 be composed nicer...
 *)
-fun K_rec_syntax v = Abs ("_", dummyT, incr_boundvars 1 v);
 
-fun update_comp ctxt ps atomic id name value =
+
+fun update_comp ctxt lense_opt ps atomic id name value =
   if is_record_sel ctxt name
   then
     let
       val upd = Syntax.free (suffix Record.updateN name) $ K_rec_syntax value;
     in
       if atomic andalso is_global ctxt name
       then (fn s =>
-        Syntax.free globals_updateN $ (K_rec_syntax (upd $ (Syntax.free globalsN $ s))) $ s)
+        Syntax.free globals_updateN $ (*(K_rec_syntax*) upd  $ s)
       else (fn s => upd $ s)
     end
   else
     let
       val reg = if is_global_comp ctxt name then "globals" else "locals";
       val upd = Syntax.free (reg ^ Record.updateN);
       val sel = Syntax.free reg;
     in
       fn s =>
         if atomic then
-          upd $ (K_rec_syntax (statespace_update_tr ctxt ps id name value (sel $ s))) $ s
-        else statespace_update_tr ctxt ps id name value s
+          upd $ statespace_update_tr ctxt lense_opt ps id name value $ s
+        else statespace_update_tr ctxt lense_opt ps id name value $ s
     end;
 
 end;
 
 fun antiquote_global_tr ctxt off i t =
   let
     fun mk n t = lookup_comp ctxt [] n (Bound (i + off n));
      (*if is_global ctxt n then t$(Free ("globals",dummyT)$Bound (i + off n))
        else t$Bound (i + off n)*)
   in
     (case t of
       Free  (n, _) => mk n t
     | Const (n, _) => mk n t
     | _ => t $ Bound i)
   end;
 
 
 fun antiquote_off_tr offset ctxt name =
   let
     fun tr i ((t as Const (c, _)) $ u) =
           if c = name then antiquote_global_tr ctxt offset i (tr i u)
           else tr i t $ tr i u
       | tr i (t $ u) = tr i t $ tr i u
       | tr i (Abs (x, T, t)) = Abs (x, T, tr (i + 1) t)
       | tr _ a = a;
   in tr 0 end;
 
 
 val antiquote_tr = antiquote_off_tr (K 0)
 
 fun quote_tr ctxt name t = Abs ("s", dummyT, antiquote_tr ctxt name (Term.incr_boundvars 1 t));
 
 fun antiquoteCur_tr ctxt t = antiquote_tr ctxt antiquoteCur (Term.incr_boundvars 1 t);
 
 
 fun antiquote_varname_tr anti [n] =
   (case n of
     Free (v, T) => Syntax.const anti $ Free (Hoare.varname v, T)
   | Const (c, T) => Syntax.const anti $ Const (Hoare.varname c, T)
   | _ => Syntax.const anti $ n);
 
 
 
 fun antiquoteOld_tr ctxt [s, n] =
   (case n of
     Free (v, T) => lookup_comp ctxt [] (Hoare.varname v) s
   | Const (c, T) => lookup_comp ctxt [] (Hoare.varname c) s
   | _ => n $ s);
 
+fun first_match [] t = raise Match
+  | first_match (f::fs) t = f t handle Match => first_match fs t
+
+fun lookup_tr' ctxt t = t |> first_match [
+  fn t =>
+    case Hoare.get_default_state_space ctxt of
+     SOME {lookup_tr', ...} => lookup_tr' ctxt t
+   | NONE => raise Match,
+  fn t => Hoare.undeco ctxt t]
+
+
 fun antiquote_tr' ctxt name =
   let
     fun is_state i t =
       (case t of
         Bound j => i = j
       | Const (g,_) $ Bound j =>
           i = j andalso member (op =) [globalsN, localsN] (Long_Name.base_name g)
       | _ => false);
     fun tr' i (t $ u) =
-       if is_state i u then Syntax.const name $ tr' i (Hoare.undeco ctxt t)
+       if is_state i u then Syntax.const name $ tr' i (lookup_tr' ctxt t)
        else tr' i t $ tr' i u
       | tr' i (Abs (x, T, t)) = Abs (x, T, tr' (i + 1) t)
       | tr' i a = if a = Bound i then raise Match else a;
   in tr' 0 end;
 
 fun quote_tr' ctxt name (Abs (_, _, t)) = Term.incr_boundvars ~1 (antiquote_tr' ctxt name t)
   | quote_tr' ctxt name (t as (Const _)) (* eta contracted *) =
       Syntax.const name $ Hoare.undeco ctxt t
   | quote_tr' _ _ _ = raise Match;
 
 
 
 local
 fun state_test (t as Const (g,_) $ u) f  =
       if member (op =) [localsN, globalsN] (Long_Name.base_name g) then f u else f t
   | state_test u f = f u;
 in
 
 fun antiquote_applied_only_to P =
   let
      fun test i (t $ u) =
        state_test u
          (fn Bound j =>
                if j=i then  P t
                else test i t andalso test i u
            | u => test i t andalso test i u)
        | test i (Abs (x, T, t)) = test (i + 1) t
        | test i _ = true;
   in test 0 end;
 
 
+
 fun antiquote_mult_tr' ctxt is_selector current old  =
   let
     fun tr' i (t $ u) =
           state_test u
             (fn Bound j =>
-                  if j = i then Syntax.const current $ tr' i (Hoare.undeco ctxt t)
+                  if j = i then Syntax.const current $ tr' i (lookup_tr' ctxt t)
                   else if is_selector t (* other quantified states *)
-                  then Syntax.const old $ Bound j $ tr' i (Hoare.undeco ctxt t)
+                  then Syntax.const old $ Bound j $ tr' i (lookup_tr' ctxt t)
                   else  tr' i t $ tr' i u
               | pre as ((Const (m,_) $ Free _)) (* pre state *) =>
                   if (m = @{syntax_const "_bound"} orelse m = @{syntax_const "_free"})
                     andalso is_selector t
-                  then Syntax.const old $ pre $ tr' i (Hoare.undeco ctxt t)
+                  then Syntax.const old $ pre $ tr' i (lookup_tr' ctxt t)
                   else tr' i t $ pre
               | pre as ((Const (m,_) $ Var _)) (* pre state *) =>
                   if m = @{syntax_const "_var"} andalso is_selector t
-                  then Syntax.const old $ pre $ tr' i (Hoare.undeco ctxt t)
+                  then Syntax.const old $ pre $ tr' i (lookup_tr' ctxt t)
                   else tr' i t $ pre
               | u => tr' i t $ tr' i u)
       | tr' i (Abs (x, T, t)) = Abs (x, T, tr' (i + 1) t)
       | tr' i a = if a = Bound i then raise Match else a;
   in tr' 0 end;
 end;
 
 fun quote_mult_tr' ctxt is_selector current old  (Abs (_, _, t)) =
       Term.incr_boundvars ~1 (antiquote_mult_tr' ctxt is_selector current old t)
   | quote_mult_tr' _ _ _ _ _ = raise Match;
 
 fun app_quote_tr' ctxt f (t :: ts) =
       Term.list_comb (f $ quote_tr' ctxt antiquoteCur t, ts)
   | app_quote_tr' _ _ _ = raise Match;
 
 fun app_quote_mult_tr' ctxt is_selector f (t :: ts) =
       Term.list_comb (f $ quote_mult_tr' ctxt is_selector antiquoteCur antiquoteOld  t, ts)
   | app_quote_mult_tr' _ _ _ _ = raise Match;
 
 
+
 fun atomic_var_tr ctxt ps name value =
-  update_comp ctxt ps true false name value;
+  update_comp ctxt NONE ps true false name value;
 
 
 fun heap_var_tr ctxt hp p value =
   let
     fun upd s =
-      update_comp ctxt [] true false hp
+      update_comp ctxt NONE [] true false hp
         (Syntax.const @{const_syntax fun_upd} $ lookup_comp ctxt [] hp s $ p $ value) s;
   in upd end;
 
 fun get_arr_var (Const (@{const_syntax List.nth},_) $ arr $ i) =
       (case get_arr_var arr of
          SOME (name,p,is) => SOME (name,p,i::is)
        | NONE => NONE)
   | get_arr_var (Const (@{syntax_const "_antiquoteCur"},_) $ Free (var,_)) =
      if Hoare.is_state_var var then SOME (var,NONE,[]) else NONE
   | get_arr_var (Const (@{syntax_const "_antiquoteCur"},_) $ Const (var,_)) =
      if Hoare.is_state_var var then SOME (var,NONE,[]) else NONE
   | get_arr_var ((Const (@{syntax_const "_antiquoteCur"},_) $ Free (hp,_)) $ p) =
      if Hoare.is_state_var hp then SOME (hp,SOME p,[]) else NONE
   | get_arr_var ((Const (@{syntax_const "_antiquoteCur"},_) $ Const (hp,_)) $ p) =
      if Hoare.is_state_var hp then SOME (hp,SOME p,[]) else NONE
   | get_arr_var _ = NONE
 
 
 fun arr_var_tr ctxt ps name arr pos value idxs  =
   let
     fun sel_tr [] = arr
       | sel_tr (i::is) = Syntax.const @{const_syntax nth} $ sel_tr is $ i;
 
     fun lupd_tr value [] _ = value
       | lupd_tr value (i::is) idxs  =
           Syntax.const @{const_syntax list_update} $ sel_tr idxs $ i $ lupd_tr value is (i::idxs);
 
 
     val value' = lupd_tr value idxs [];
   in case pos of
        NONE   => atomic_var_tr ctxt ps name value'
      | SOME p => heap_var_tr ctxt name p value'
   end;
 
 fun get_arr_mult_var (Const (@{syntax_const "_antiquoteCur"},_) $ Free (var,_)) =
      if Hoare.is_state_var var then SOME (var,NONE) else NONE
   | get_arr_mult_var (Const (@{syntax_const "_antiquoteCur"},_) $ Const (var,_)) =
      if Hoare.is_state_var var then SOME (var,NONE) else NONE
   | get_arr_mult_var ((Const (@{syntax_const "_antiquoteCur"},_) $ Free (hp,_)) $ p) =
      if Hoare.is_state_var hp then SOME (hp,SOME p) else NONE
   | get_arr_mult_var ((Const (@{syntax_const "_antiquoteCur"},_) $ Const (hp,_)) $ p) =
      if Hoare.is_state_var hp then SOME (hp,SOME p) else NONE
   | get_arr_mult_var _ = NONE
 
 fun arr_mult_var_tr ctxt ps name arr pos vals idxs  =
   let
     val value' = Syntax.const @{const_syntax list_multupd} $ arr $ idxs $ vals;
   in
     case pos of
       NONE => atomic_var_tr ctxt ps name value'
     | SOME p => heap_var_tr ctxt name p value'
   end;
 
 fun update_tr ctxt ps off_var off_val e
         (v as Const (@{syntax_const "_antiquoteCur"},_) $ Free (var,_)) =
       if Hoare.is_state_var var then atomic_var_tr ctxt ps var e
       else raise TERM ("no proper lvalue", [v])
   | update_tr ctxt ps off_var off_val e
         ((v as Const (@{syntax_const "_antiquoteCur"},_) $ Free (hp, _)) $ p) =
       if Hoare.is_state_var hp
       then heap_var_tr ctxt hp (antiquote_off_tr off_val ctxt antiquoteCur p) e
       else raise TERM ("no proper lvalue",[v])
   | update_tr ctxt ps off_var off_val e
         (v as Const (@{const_syntax list_multsel}, _) $ arr $ idxs) =
       (case get_arr_mult_var arr of
          SOME (var, pos) =>
             let
               val pos' = Option.map (antiquote_off_tr off_val ctxt antiquoteCur) pos;
               val var' = lookup_comp ctxt ps var (Bound (off_var var));
               val arr' = case pos' of NONE => var' | SOME p => var' $ p;
               val idxs' = antiquote_off_tr off_val ctxt antiquoteCur idxs;
             in arr_mult_var_tr ctxt ps var arr' pos' e idxs' end
        | NONE =>  raise TERM ("no proper lvalue", [v]))
   | update_tr ctxt ps off_var off_val e v =
       (case get_arr_var v of
         SOME (var,pos,idxs) =>
           let
             val pos' = Option.map (antiquote_off_tr off_val ctxt antiquoteCur) pos;
             val var' = lookup_comp ctxt ps var (Bound (off_var var));
             val arr' = case pos' of NONE => var' | SOME p => var' $ p;
             val idxs' = rev (map (antiquote_off_tr off_val ctxt antiquoteCur) idxs);
           in arr_var_tr ctxt ps var arr' pos' e idxs' end
       | NONE => raise TERM ("no proper lvalue", [v]))
   | update_tr _ _ _ _ e t = raise TERM ("update_tr", [t])
 
 
 fun app_assign_tr f ctxt [v, e] =
       let
         fun offset _ = 0;
       in f $ Abs ("s", dummyT, update_tr ctxt [] offset offset (antiquoteCur_tr ctxt e) v (Bound 0))
       end
   | app_assign_tr _ _ ts = raise TERM ("assign_tr", ts);
 
 
 val assign_tr = app_assign_tr (Syntax.const @{const_syntax Basic});
 val raise_tr = app_assign_tr (Syntax.const @{const_syntax raise});
 
 
 fun basic_assign_tr ctxt (ts as [v, e]) =
       let
         fun offset v = 0;
       in update_tr ctxt [] offset offset (antiquoteCur_tr ctxt e) v
       end
   | basic_assign_tr _ ts = raise TERM ("basic_assign_tr", ts);
 
 fun basic_assigns_tr ctxt [t] =
       let
         fun dest_basic (Const (@{syntax_const "_BAssign"}, _) $ v $ e) =
               basic_assign_tr ctxt [v,e]
           | dest_basic _ = raise Match;
 
         fun dest_basics (Const (@{syntax_const "_basics"}, _) $ x $ xs) =
               dest_basic x :: dest_basics xs
           | dest_basics (t as Const (@{syntax_const "_BAssign"}, _) $_ $ _) =
               [dest_basic t]
           | dest_basics _ = []
         val upds = dest_basics t;
       in Abs ("s", dummyT, fold (fn upd => fn s => upd s) upds (Bound 0))
       end
   | basic_assigns_tr _ ts = raise TERM ("basic_assigns_tr", ts);
 
 fun basic_tr ctxt [t] =
   Syntax.const @{const_syntax Basic} $
     (Abs ("s", dummyT,
       antiquote_tr ctxt @{syntax_const "_antiquoteCur"} (Term.incr_boundvars 1 t) $ Bound 0));
 
 fun init_tr ctxt [Const (var,_),comp,value] =
       let
         fun dest_set (Const (@{const_syntax Set.empty}, _)) = []
           | dest_set (Const (@{const_syntax insert}, _) $ x $ xs) = x :: dest_set xs;
 
         fun dest_list (Const (@{const_syntax Nil}, _)) = []
           | dest_list (Const (@{const_syntax Cons}, _) $ Free (x, _) $ xs) = x :: dest_list xs;
 
         fun dest_val_list (Const (@{const_syntax Nil}, _)) = []
           | dest_val_list (Const (@{const_syntax Cons},_) $ x $ xs) =
               dest_set x :: dest_val_list xs
           | dest_val_list t = [dest_set t];
 
         val values =
           (case value of
             Const (@{const_syntax Cons}, _) $ _ $ _ =>
               map mk_list (transpose (dest_val_list value))
           | Const (@{const_syntax insert}, _) $ _ $ _ =>
               dest_set value
           | _ => raise TERM ("unknown variable initialization", []))
         val comps = dest_list comp;
         fun mk_upd var c v =
           Syntax.free (suffix Record.updateN (Hoare.varname (suffix ("_" ^ c) var))) $ v;
         val upds = map2 (mk_upd var) comps values;
         val app_upds = fold (fn upd => fn s => upd $ s) upds;
         val upd =
           if is_global ctxt (Hoare.varname (suffix ("_" ^ hd comps) var)) then
             Syntax.free (suffix Record.updateN globalsN) $
               app_upds (Syntax.free globalsN $ Bound 0) $ Bound 0
           else app_upds (Bound 0)
       in
         Syntax.const @{const_syntax Basic} $ Abs ("s", dummyT, upd)
       end
   | init_tr _ _ = raise Match;
 
 
 fun new_tr ctxt (ts as [var,size,init]) =
       let
         fun offset v = 0;
         fun dest_init (Const (@{syntax_const "_newinit"}, _) $ Const (var, _) $ v) = (var, v)
           | dest_init _ = raise Match;
 
         fun dest_inits (Const (@{syntax_const "_newinits"}, _) $ x $ xs) =
               dest_init x :: dest_inits xs
           | dest_inits (t as (Const (@{syntax_const "_newinit"}, _) $_ $ _)) = [dest_init t]
           | dest_inits _ = raise Match;
 
         val g = Syntax.free globalsN $ Bound 0;
         val alloc = lookup_comp ctxt [] allocN (Bound 0);
-        val new = Syntax.free "new" $ (Syntax.const @{const_syntax set} $ alloc);  (* FIXME new !? *)
+        val new = Syntax.free "new" $ (Syntax.const @{const_syntax set} $ alloc);  (* fixme new !? *)
 
         fun mk_upd (var,v) =
           let
             val varn = Hoare.varname var;
             val var' = lookup_comp ctxt [] varn (Bound 0);
           in
-            update_comp ctxt [] false false varn
+            update_comp ctxt NONE [] false false varn
               (Syntax.const @{const_syntax fun_upd} $ var' $ new $ v)
           end;
 
         val inits = map mk_upd (dest_inits init);
         val free = lookup_comp ctxt [] freeN (Bound 0);
         val freetest = Syntax.const @{const_syntax Orderings.less_eq} $ size $ free;
 
         val alloc_upd =
-          update_comp ctxt [] false false allocN
+          update_comp ctxt NONE [] false false allocN
             (Syntax.const @{const_syntax Cons} $ new $ alloc);
         val free_upd =
-          update_comp ctxt [] false false freeN
+          update_comp ctxt NONE [] false false freeN
             (Syntax.const @{const_syntax Groups.minus} $ free $ size);
 
         val g' =
           Syntax.free (suffix Record.updateN globalsN) $
             K_rec_syntax (fold (fn upd => fn s => upd s) (alloc_upd :: free_upd :: inits) g) $
             Bound 0;
         val cond =
           Syntax.const @{const_syntax If} $ freetest $
             update_tr ctxt [] offset offset new var g' $
             update_tr ctxt [] offset offset Null var (Bound 0);
 
       in Syntax.const @{const_syntax Basic} $ Abs ("s", dummyT, cond)
       end
   | new_tr _ ts = raise TERM ("new_tr",ts);
 
 fun nnew_tr ctxt (ts as [var,size,init]) =
       let
         fun offset v = 0;
         fun dest_init (Const (@{syntax_const "_newinit"}, _) $ Const (var, _) $ v) = (var, v)
           | dest_init _ = raise Match;
 
         fun dest_inits (Const (@{syntax_const "_newinits"}, _) $ x $ xs) =
               dest_init x :: dest_inits xs
           | dest_inits (t as (Const (@{syntax_const "_newinit"}, _) $ _ $ _)) =
               [dest_init t]
           | dest_inits _ = raise Match;
 
         val g = Syntax.free globalsN $ Bound 0;
         val alloc = lookup_comp ctxt [] allocN (Bound 0);
-        val new = Syntax.free "new" $ (Syntax.const @{const_syntax set} $ alloc);  (* FIXME new !? *)
+        val new = Syntax.free "new" $ (Syntax.const @{const_syntax set} $ alloc);  (* fixme new !? *)
 
         fun mk_upd (var,v) =
           let
             val varn = Hoare.varname var;
             val var' = lookup_comp ctxt [] varn (Bound 0);
           in
-            update_comp ctxt [] false false varn
+            update_comp ctxt NONE [] false false varn
               (Syntax.const @{const_syntax fun_upd} $ var' $ new $ v)
           end;
 
         val inits = map mk_upd (dest_inits init);
         val free = lookup_comp ctxt [] freeN (Bound 0);
         val freetest = Syntax.const @{const_syntax Orderings.less_eq} $ size $ free;
 
         val alloc_upd =
-          update_comp ctxt [] false false allocN
+          update_comp ctxt NONE [] false false allocN
             (Syntax.const @{const_syntax Cons} $ new $ alloc);
         val free_upd =
-          update_comp ctxt [] false false freeN
+          update_comp ctxt NONE [] false false freeN
             (Syntax.const @{const_syntax Groups.minus} $ free $ size);
 
         val g' =
           Syntax.free (suffix Record.updateN globalsN) $
             K_rec_syntax (fold (fn upd => fn s => upd s) (alloc_upd :: inits @ [free_upd]) g) $
             Bound 0;
         val cond =
           Syntax.const @{const_syntax if_rel} $ Abs ("s", dummyT, freetest) $
             Abs ("s", dummyT, update_tr ctxt [] offset offset new var g') $
             Abs ("s", dummyT, update_tr ctxt [] offset offset Null var (Bound 0)) $
             Abs ("s", dummyT, update_tr ctxt [] offset offset new var g');
 
       in Syntax.const @{const_syntax Spec} $ cond
       end
   | nnew_tr _ ts = raise TERM ("nnew_tr", ts);
 
 fun loc_tr ctxt (ts as [init, bdy]) =
   let
     fun dest_init (Const (@{syntax_const "_locinit"}, _) $ Const (var,_) $ v) = (var, v)
       | dest_init (Const (@{syntax_const "_locnoinit"}, _) $ Const (var, _)) =
            (var, Syntax.const antiquoteCur $ Syntax.free (Hoare.varname var))
-           (* FIXME could skip this dummy initialisation v := v s and
+           (* fixme: could skip this dummy initialisation v := v s and
               derive non init variables in the print translation from
               the return function instead the init function *)
       | dest_init _ = raise Match;
 
     fun dest_inits (Const (@{syntax_const "_locinits"}, _) $ x $ xs) = dest_init x :: dest_inits xs
       | dest_inits (t as (Const (@{syntax_const "_locinit"}, _) $ _ $ _)) = [dest_init t]
       | dest_inits (t as (Const (@{syntax_const "_locnoinit"}, _) $ _)) = [dest_init t]
       | dest_inits _ = raise Match;
 
     fun mk_init_upd (var, v) =
-      update_comp ctxt [] true false var (antiquoteCur_tr ctxt v);
+      update_comp ctxt NONE [] true false var (antiquoteCur_tr ctxt v);
 
     fun mk_ret_upd var =
-      update_comp ctxt [] true false var (lookup_comp ctxt [] var (Bound 1));
+      update_comp ctxt NONE [] true false var (lookup_comp ctxt [] var (Bound 1));
 
     val var_vals = map (apfst Hoare.varname) (dest_inits init);
     val ini = Abs ("s", dummyT, fold mk_init_upd var_vals (Bound 0));
     val ret = Abs ("s",dummyT, Abs ("t",dummyT, fold (mk_ret_upd o fst) var_vals (Bound 0)));
     val c = Abs ("i", dummyT, Abs ("t", dummyT, Syntax.const @{const_syntax Skip}));
 
   in Syntax.const @{const_syntax block} $ ini $ bdy $ ret $ c end
 
 infixr 9 &;
 
 fun (NONE & NONE) = NONE
   | ((SOME x) & NONE) = SOME x
   | (NONE & (SOME x)) = SOME x
   | ((SOME x) & (SOME y)) = SOME (Syntax.const @{const_syntax HOL.conj} $ x $ y);
 
 fun mk_imp (l,SOME r) = SOME (HOLogic.mk_imp (l, r))
   | mk_imp (l,NONE) = NONE;
 
 
 local
 
 fun le l r =
   Syntax.const @{const_syntax Orderings.less} $ l $ r;
 
-fun in_range t = Syntax.free "in_range" $ t;   (* FIXME ?? *)
+fun in_range t = Syntax.free "in_range" $ t;   (* fixme ?? *)
 
 fun not_zero t =
   Syntax.const @{const_syntax Not} $
     (Syntax.const @{const_syntax HOL.eq} $ t $ Syntax.const @{const_syntax Groups.zero});
 
 fun not_Null t =
   Syntax.const @{const_syntax Not} $
-    (Syntax.const @{const_syntax HOL.eq} $ t $ Syntax.free "Simpl_Heap.Null");   (* FIXME ?? *)
+    (Syntax.const @{const_syntax HOL.eq} $ t $ Syntax.free "Simpl_Heap.Null");   (* fixme ?? *)
 
 fun in_length i l =
   Syntax.const @{const_syntax Orderings.less} $ i $
     (Syntax.const @{const_syntax size} $ l);
 
 fun is_pos t =
   Syntax.const @{const_syntax Orderings.less_eq} $ Syntax.const @{const_syntax Groups.zero} $ t;
 
 
 fun infer_type ctxt t =
   Syntax.check_term ctxt (Exn.release (#2 (Syntax_Phases.decode_term ctxt ([], Exn.Res t))));
 
 
 (* NOTE: operations on actual terms *)
 
 fun is_arr (Const (@{const_name List.nth},_) $ l $ e) = is_arr l
   | is_arr (Const (a, _) $ Bound 0) = Hoare.is_state_var a
   | is_arr (Const (a,_) $ (Const (globals,_) $ Bound 0)) = Hoare.is_state_var a
   | is_arr ((Const (hp,_) $ (Const (globals,_) $ Bound 0)) $ p) = Hoare.is_state_var hp
   | is_arr _ = false;
 
 fun dummyfyT (TFree x) = TFree x
   | dummyfyT (TVar x) = dummyT
   | dummyfyT (Type (c, Ts)) =
      let
        val Ts' = map dummyfyT Ts;
      in if exists (fn T => T = dummyT) Ts' then dummyT else Type (c, Ts') end;
 
 fun guard ctxt Ts (add as (Const (@{const_name Groups.plus},_) $ l $ r)) =
       guard ctxt Ts l & guard ctxt Ts r & SOME (in_range add)
   | guard ctxt Ts (sub as (Const (@{const_name Groups.minus},_) $ l $ r)) =
       let
         val g =
           (if fastype_of1 (Ts,sub) = HOLogic.natT then le r l else in_range sub)
             handle TERM _ => error ("guard generation, cannot determine type of: " ^
               Syntax.string_of_term ctxt sub);
       in guard ctxt Ts l & guard ctxt Ts r & SOME g end
   | guard ctxt Ts (mul as (Const (@{const_name Groups.times},_) $ l $r)) =
       guard ctxt Ts l & guard ctxt Ts r & SOME (in_range mul)
   | guard ctxt Ts (Const (@{const_name HOL.conj},_) $ l $ r) =
       guard ctxt Ts l & mk_imp (l,guard ctxt Ts r)
   | guard ctxt Ts (Const (@{const_name HOL.disj},_) $ l $ r) =
       guard ctxt Ts l & mk_imp (HOLogic.Not $ l,guard ctxt Ts r)
   | guard ctxt Ts (dv as (Const (@{const_name Rings.divide},_) $ l $ r)) =
-      guard ctxt Ts l & guard ctxt Ts r & SOME (not_zero r) & SOME (in_range dv) (* FIXME: Make more concrete guard...*)
+      guard ctxt Ts l & guard ctxt Ts r & SOME (not_zero r) & SOME (in_range dv) (* fixme: Make more concrete guard...*)
   | guard ctxt Ts (Const (@{const_name Rings.modulo},_) $ l $ r) =
       guard ctxt Ts l & guard ctxt Ts r & SOME (not_zero r)
   | guard ctxt Ts (un as (Const (@{const_name Groups.uminus},_) $ n)) =
       guard ctxt Ts n & SOME (in_range un)
   | guard ctxt Ts (Const (@{const_name Int.nat},_) $ i) =
       guard ctxt Ts i & SOME (is_pos i)
   | guard ctxt Ts (i as (Const (@{const_abbrev Int.int},_) $ n)) =
       guard ctxt Ts n & SOME (in_range i)
   | guard ctxt Ts (Const (@{const_name List.nth},_) $ l $ e) =
       if is_arr l then guard ctxt Ts l & guard ctxt Ts e & SOME (in_length e l)
       else NONE (*oder default?*)
   | guard ctxt Ts (Const (hp,_) $ (Const (globals,_) $ Bound 0) $ p) =
       if Hoare.is_state_var hp then guard ctxt Ts p & SOME (not_Null p)(*& SOME (in_alloc p)*)
       else guard ctxt Ts p
 
 (*  | guard (Const (@{const_name "list_update"},_)$l$i$e) =
       if is_arr l then guard i & SOME (in_length i l) & guard e else NONE*) (* oder default?*)
 (*  | guard (Const (upd,_)$e$s) = for procedure parameters,like default but left to right
       if is_some (try (unsuffix updateN) upd) then guard s & guard e else guard e & guard s *)
   | guard ctxt Ts t =
       fold_rev (fn l => fn r => guard ctxt Ts l & r) (snd (strip_comb t)) NONE (* default *)
   | guard _ _ _ = NONE;
 
 in
 
  fun mk_guard ctxt t =
    let
       (* We apply type inference first, so that we can generate different guards,
          depending on the type, e.g. int vs. nat *)
       val Abs (_, T, t') = map_types dummyfyT (infer_type ctxt (Abs ("s", dummyT, t)));
    in guard ctxt [T] t' end;
 
 end;
-(* FIXME: make guard function a parameter of all parse-translations that need it.*)
+(* fixme: make guard function a parameter of all parse-translations that need it.*)
 
 val _ = Theory.setup (Context.theory_map (Hoare.install_generate_guard mk_guard));
 
 
 fun mk_singleton_guard f g =
   Syntax.const @{const_syntax Cons} $
     (Syntax.const @{const_syntax Pair} $ Syntax.const f $
       (Syntax.const @{const_syntax Collect} $ Abs ("s", dummyT, g))) $
     Syntax.const @{const_syntax Nil};
 
 fun guarded_Assign_tr ctxt (ts as [v, e]) =
       let
         val ass = assign_tr ctxt [v, e];
         val guard = Hoare.generate_guard ctxt;
         (* By the artificial "=" between left and right-hand side we get a bigger term and thus
            more information for type-inference *)
       in
         case guard (Syntax.const @{const_syntax HOL.eq} $
             antiquoteCur_tr ctxt v $ antiquoteCur_tr ctxt e) of
           NONE => ass
         | SOME g =>
             Syntax.const @{const_syntax guards} $ mk_singleton_guard @{const_syntax False} g $ ass
       end
   | guarded_Assign_tr _ ts = raise Match;
 
 fun guarded_New_tr ctxt (ts as [var, size, init]) =
       let
         val new = new_tr ctxt [var, size, init];
         val guard = Hoare.generate_guard ctxt;
       in
         case guard (antiquoteCur_tr ctxt var) of
           NONE => new
         | SOME g =>
             Syntax.const @{const_syntax guards} $ mk_singleton_guard @{const_syntax False} g $ new
       end
   | guarded_New_tr _ ts = raise TERM ("guarded_New_tr", ts);
 
 fun guarded_NNew_tr ctxt (ts as [var, size, init]) =
       let
         val new = nnew_tr ctxt [var, size, init];
         val guard = Hoare.generate_guard ctxt;
       in
         case guard (antiquoteCur_tr ctxt var) of
           NONE => new
         | SOME g =>
             Syntax.const @{const_syntax guards} $ mk_singleton_guard @{const_syntax False} g $ new
       end
   | guarded_NNew_tr _ ts = raise TERM ("guarded_NNew_tr", ts);
 
 
 fun guarded_While_tr ctxt (ts as [b,I,V,c]) =
       let
         val guard = Hoare.generate_guard ctxt;
         val cnd as Abs (_, _, b') = quote_tr ctxt antiquoteCur b;
         val b'' = Syntax.const @{const_syntax Collect} $ cnd;
       in
         case guard b' of
           NONE => Syntax.const @{const_syntax whileAnno} $ b'' $ I $ V $ c
         | SOME g =>
             Syntax.const @{const_syntax whileAnnoG} $
               mk_singleton_guard @{const_syntax False} g $ b'' $ I $ V $ c
       end
   | guarded_While_tr _ ts = raise Match;
 
 fun guarded_WhileFix_tr ctxt (ts as [b as (_ $ Abs (_, _, b')), I, V, c]) =
       let
         val guard = Hoare.generate_guard ctxt;
       in
         case guard b' of
           NONE => Syntax.const @{const_syntax whileAnnoFix} $ b $ I $ V $ c
         | SOME g =>
             Syntax.const @{const_syntax whileAnnoGFix} $
               mk_singleton_guard @{const_syntax False} g $ b $ I $ V $ c
       end
   | guarded_WhileFix_tr _ ts = raise Match;
 
 fun guarded_Cond_tr ctxt (ts as [b, c, d]) =
       let
         val guard = Hoare.generate_guard ctxt;
         val cnd as Abs (_, _, b') = quote_tr ctxt @{syntax_const "_antiquoteCur"} b;
         val cond =
           Syntax.const @{const_syntax Cond} $ (Syntax.const @{const_syntax Collect} $ cnd) $ c $ d;
       in
         case guard b' of
           NONE => cond
         | SOME g =>
             Syntax.const @{const_syntax guards} $ mk_singleton_guard @{const_syntax False} g $ cond
       end
   | guarded_Cond_tr _ ts = raise Match;
 
 
 (* parsing procedure calls *)
 
 fun dest_pars (Const (@{syntax_const "_par"}, _) $ p) = [p]
   | dest_pars (Const (@{syntax_const "_pars"}, _) $ p $ ps) = dest_pars p @ dest_pars ps
   | dest_pars t = raise TERM ("dest_pars", [t]);
 
 fun dest_actuals (Const (@{syntax_const "_actuals_empty"}, _)) = []
   | dest_actuals (Const (@{syntax_const "_actuals"}, _) $ pars) = dest_pars pars
   | dest_actuals t = raise TERM ("dest_actuals", [t]);
 
 
-fun mk_call_tr ctxt grd Call formals pn pt actuals has_args cont =
+fun mk_call_tr ctxt grd Call formals pn pt actuals has_args result_exn cont =
   let
     val fcall = cont <> NONE;
     val state_kind =
       the_default (Hoare.get_default_state_kind ctxt)
         (Hoare.get_state_kind pn ctxt);
-    fun init_par_tr name arg =
-      update_comp ctxt [] false false name (antiquoteCur_tr ctxt arg);
+    fun init_par_tr name lense_opt arg =
+      update_comp ctxt lense_opt [] false false name (antiquoteCur_tr ctxt arg);
 
     fun result_par_tr name arg =
       let
         fun offset_old n = 2;
         fun offset n = if is_global ctxt n then 0 else 2;
+        val lookup = lookup_comp ctxt [] name (Bound 1)
       in
-        update_tr ctxt [pn] offset offset_old
-          (lookup_comp ctxt [] name (Bound 1)) arg
+        update_tr ctxt [pn] offset offset_old lookup arg
       end;
 
     val _ = if not (Config.get ctxt StateSpace.silent) andalso
                ((not fcall andalso length formals <> length actuals)
                  orelse
                 (fcall andalso length formals <> length actuals + 1))
             then raise
                 TERM ("call_tr: number of formal (" ^ string_of_int (length formals) ^
                       ") and actual (" ^ string_of_int (length actuals) ^
                       ") parameters for \"" ^ unsuffix Hoare.proc_deco pn ^
                       "\" do not match.", [])
             else ();
 
     val globals =
       [Syntax.const globals_updateN $ (K_rec_syntax (Const (globalsN, dummyT) $ Bound 0))];
     val ret = Abs ("s", dummyT, Abs ("t", dummyT, Library.foldr (op $) (globals, Bound 1)));
 
-    val val_formals = filter (fn (kind, _) => kind = Hoare.In) formals;
-    val res_formals = filter (fn (kind, _) => kind = Hoare.Out) formals;
+    val val_formals = filter (fn (kind, _, _) => kind = Hoare.In) formals;
+    val res_formals = filter (fn (kind, _, _) => kind = Hoare.Out) formals;
 
     val (val_actuals, res_actuals) = chop (length val_formals) actuals;
     val init_bdy =
       let
         val state =
           (case state_kind of
             Hoare.Record => Bound 0
-          | Hoare.Function => Syntax.const localsN $ Bound 0);
-        val upds = fold2 (fn (_, name) => init_par_tr name) val_formals val_actuals state;
+          | _ => Syntax.const localsN $ Bound 0);
+        val upds = fold2 (fn (_, name, lense_opt) => init_par_tr name lense_opt) val_formals val_actuals state;
       in
         (case state_kind of
           Hoare.Record => upds
-        | Hoare.Function => Syntax.const locals_updateN $ K_rec_syntax upds $ Bound 0)
+        | _ => Syntax.const locals_updateN $ K_rec_syntax upds $ Bound 0)
       end;
     val init = Abs ("s", dummyT, init_bdy);
 
 
     val call =
       (case cont of
         NONE => (* Procedure call *)
             let
               val results =
-                map (fn ((_, name), arg) => result_par_tr name arg)
+                map (fn ((_, name, _), arg) => result_par_tr name arg)
                   (rev (res_formals ~~ res_actuals));
               val res =
                 Abs ("i", dummyT, Abs ("t", dummyT,
                     Syntax.const @{const_syntax Basic} $
                       Abs ("s", dummyT, fold_rev (fn f => fn s => f s) results (Bound 0))));
-            in if has_args then Call $init $ pt $ ret $ res else Call $ pt end
+              val args = [init, pt, ret] @ result_exn @ [res]
+            in if has_args then list_comb (Call, args) else Call $ pt end
         | SOME c => (* Function call *)
             let
               val res =
                 (case res_formals of
-                  [(_, n)] => Abs ("s", dummyT, lookup_comp ctxt [] n (Bound 0))
+                  [(_, n, _)] => Abs ("s", dummyT, lookup_comp ctxt [] n (Bound 0))
                 | _ =>
                     if Config.get ctxt StateSpace.silent
                     then Abs ("s", dummyT, lookup_comp ctxt [] "dummy" (Bound 0))
                     else raise TERM ("call_tr: function " ^ pn ^ "may only have one result parameter", []));
             in Call $ init $ pt $ ret $ res $ c end)
     val guard = Hoare.generate_guard  ctxt;
   in
     if grd
     then
       (case fold_rev (fn arg => fn g => guard (antiquoteCur_tr ctxt arg) & g)
           (res_actuals @ val_actuals) NONE of
         NONE => call
       | SOME g =>
           Syntax.const @{const_syntax guards} $ mk_singleton_guard @{const_syntax False} g $ call)
     else call
   end;
 
 
-(* FIXME: What is prfx for, maybe unused *)
-fun dest_procname ctxt prfx false (Const (p, _)) =
-      (prfx ^ suffix Hoare.proc_deco p, HOLogic.mk_string p)
-  | dest_procname ctxt prfx false (t as Free (p, T)) =
-      (prfx ^ suffix Hoare.proc_deco p, Free (suffix Hoare.proc_deco p, T))
-  | dest_procname ctxt prfx false (Const (@{syntax_const "_free"},_) $ Free (p,T)) =
-      (prfx ^ suffix Hoare.proc_deco p, Free (suffix Hoare.proc_deco p, T))
-  | dest_procname ctxt prfx false (t as (Const (@{syntax_const "_antiquoteCur"},_) $ Const (p, _))) =
-      (prfx ^ Hoare.resuffix Hoare.deco Hoare.proc_deco p, t)
-  | dest_procname ctxt prfx false (t as (Const (@{syntax_const "_antiquoteCur"}, _) $ Free (p, _))) =
-      (prfx ^ Hoare.resuffix Hoare.deco Hoare.proc_deco p, t)
-  | dest_procname ctxt prfx false (t as Const (p, _) $ _) =
-      (prfx ^ Hoare.resuffix Hoare.deco Hoare.proc_deco p, t) (* antiquoteOld *)
-  | dest_procname ctxt prfx false (t as Free (p,_)$_)  =
-      (prfx ^ Hoare.resuffix Hoare.deco Hoare.proc_deco p, t) (* antiquoteOld *)
-  | dest_procname ctxt prfx false (t as Const (@{syntax_const "_antiquoteOld"}, _) $ _ $ Const (p, _)) =
-      (prfx ^ suffix Hoare.proc_deco p, t)
-  | dest_procname ctxt prfx false (t as Const (@{syntax_const "_antiquoteOld"}, _) $ _ $ Free (p,_)) =
-      (prfx ^ suffix Hoare.proc_deco p, t)
-  (* FIXME StateFun.lookup !? *)
-  | dest_procname ctxt prfx false (t as Const (@{const_name "StateFun.lookup"}, _) $ _ $ Free (p, _) $ _) =
-      (prfx ^ suffix Hoare.proc_deco (Hoare.remdeco' p), t) (* antiquoteOld *)
+fun dest_procname ctxt false (Const (p, _)) =
+      (suffix Hoare.proc_deco p, HOLogic.mk_string p)
+  | dest_procname ctxt false (t as Free (p, T)) =
+      (case Hoare.get_default_state_space ctxt of
+        SOME {read_function_name, ...} => (p, read_function_name ctxt p)
+      | _ => (suffix Hoare.proc_deco p, Free (suffix Hoare.proc_deco p, T)))
+  | dest_procname ctxt false (Const (@{syntax_const "_free"},_) $ Free (p,T)) =
+      (suffix Hoare.proc_deco p, Free (suffix Hoare.proc_deco p, T))
+  | dest_procname ctxt false (t as (Const (@{syntax_const "_antiquoteCur"},_) $ Const (p, _))) =
+      (Hoare.resuffix Hoare.deco Hoare.proc_deco p, t)
+  | dest_procname ctxt false (t as (Const (@{syntax_const "_antiquoteCur"}, _) $ Free (p, _))) =
+      (Hoare.resuffix Hoare.deco Hoare.proc_deco p, t)
+  | dest_procname ctxt false (t as Const (p, _) $ _) =
+      (Hoare.resuffix Hoare.deco Hoare.proc_deco p, t) (* antiquoteOld *)
+  | dest_procname ctxt false (t as Free (p,_)$_)  =
+      (Hoare.resuffix Hoare.deco Hoare.proc_deco p, t) (* antiquoteOld *)
+  | dest_procname ctxt false (t as Const (@{syntax_const "_antiquoteOld"}, _) $ _ $ Const (p, _)) =
+      (suffix Hoare.proc_deco p, t)
+  | dest_procname ctxt false (t as Const (@{syntax_const "_antiquoteOld"}, _) $ _ $ Free (p,_)) =
+      (suffix Hoare.proc_deco p, t)
+  | dest_procname ctxt false (t as Const (@{const_name "StateFun.lookup"}, _) $ _ $ Free (p, _) $ _) =
+      (suffix Hoare.proc_deco (Hoare.remdeco' ctxt p), t) (* antiquoteOld *)
 
-  | dest_procname ctxt prfx false t = (prfx, t)
-  | dest_procname ctxt prfx true t =
+  | dest_procname ctxt false t = ("", t)
+  | dest_procname ctxt true t =
       let fun quote t = Abs ("s", dummyT, antiquoteCur_tr ctxt t)
       in
         (case quote t of
           (t' as Abs (_, _, Free (p, _) $ Bound 0)) =>
-            (prfx ^ Hoare.resuffix Hoare.deco Hoare.proc_deco p, t')
-        (* FIXME StateFun.lookup !? *)
+            (Hoare.resuffix Hoare.deco Hoare.proc_deco p, t')
         | (t' as Abs (_, _, Const (@{const_name "StateFun.lookup"}, _) $ _ $ Free (p, _) $ (_ $ Bound 0))) =>
-            (prfx ^ suffix Hoare.proc_deco (Hoare.remdeco' p), t')
-        | t' => (prfx, t'))
+            (suffix Hoare.proc_deco (Hoare.remdeco' ctxt p), t')
+        | t' => ("", t'))
       end
 
-fun gen_call_tr prfx dyn grd ctxt p actuals has_args cont =
+fun gen_call_tr dyn grd ctxt p actuals has_args result_exn cont =
   let
-    fun Call false true NONE = Const (@{const_syntax call}, dummyT)
-      | Call false false NONE = Const (@{const_syntax Call}, dummyT)
-      | Call true true NONE = Const (@{const_syntax dynCall}, dummyT)
-      | Call false true (SOME c) = Const (@{const_syntax fcall}, dummyT)
-      | Call _ _ _ = raise TERM ("gen_call_tr: no proper procedure call", []);
+    fun Call false true [] NONE = Const (@{const_syntax call}, dummyT)
+      | Call false true _ NONE = Const (@{const_syntax call_exn}, dummyT)
+      | Call false false [] NONE = Const (@{const_syntax Call}, dummyT)
+      | Call true true [] NONE = Const (@{const_syntax dynCall}, dummyT)
+      | Call true true _ NONE = Const (@{const_syntax dynCall_exn}, dummyT)
+      | Call false true [] (SOME c) = Const (@{const_syntax fcall}, dummyT)
+      | Call _ _ _ _ = raise TERM ("gen_call_tr: no proper procedure call", []);
 
-    val (pn, pt) = dest_procname ctxt prfx dyn (Term_Position.strip_positions p);
+    val (pn, pt) = dest_procname ctxt dyn (Term_Position.strip_positions p);
   in
     (case Hoare.get_params pn ctxt of
       SOME formals =>
-        mk_call_tr ctxt grd (Call dyn has_args cont) formals pn pt actuals has_args cont
+        mk_call_tr ctxt grd (Call dyn has_args result_exn cont) formals pn pt actuals has_args result_exn cont
     | NONE =>
         if Config.get ctxt StateSpace.silent
-        then mk_call_tr ctxt grd (Call dyn has_args cont) [] pn pt [] has_args cont
+        then mk_call_tr ctxt grd (Call dyn has_args result_exn cont) [] pn pt [] has_args result_exn cont
         else raise TERM ("gen_call_tr: procedure " ^ quote pn ^ " not defined", []))
   end;
 
-fun call_tr dyn grd ctxt [p, actuals] =
-      gen_call_tr "" dyn grd ctxt p (dest_actuals actuals) true NONE
-  | call_tr _ _ _  t = raise TERM ("call_tr", t);
+fun call_tr dyn grd result_exn ctxt [p, actuals] =
+      gen_call_tr dyn grd ctxt p (dest_actuals actuals) true result_exn NONE
+  | call_tr _ _ _ _ t = raise TERM ("call_tr", t);
 
-fun call_ass_tr dyn grd ctxt [l, p, actuals] =
-      gen_call_tr "" dyn grd ctxt p (dest_actuals actuals @ [l]) true NONE
-  | call_ass_tr  _ _ _ t = raise TERM ("call_ass_tr", t);
+fun call_ass_tr dyn grd result_exn ctxt [l, p, actuals] =
+      gen_call_tr dyn grd ctxt p (dest_actuals actuals @ [l]) true result_exn NONE
+  | call_ass_tr  _ _ _ _ t = raise TERM ("call_ass_tr", t);
 
 fun proc_tr ctxt [p, actuals] =
-      gen_call_tr "" false false ctxt p (dest_actuals actuals) false NONE
+      gen_call_tr false false ctxt p (dest_actuals actuals) false [] NONE
   | proc_tr _  t = raise TERM ("proc_tr", t);
 
 fun proc_ass_tr ctxt [l, p, actuals] =
-      gen_call_tr "" false false ctxt p (dest_actuals actuals @ [l]) false NONE
+      gen_call_tr false false ctxt p (dest_actuals actuals @ [l]) false [] NONE
   | proc_ass_tr _ t = raise TERM ("proc_ass_tr", t);
 
 fun fcall_tr ctxt [p, actuals, c] =
-      gen_call_tr "" false false ctxt p (dest_actuals actuals) true (SOME c)
+      gen_call_tr false false ctxt p (dest_actuals actuals) true [] (SOME c)
   | fcall_tr _ t = raise TERM ("fcall_tr", t);
 
 
 (* printing procedure calls *)
 
 fun upd_tr' ctxt (x_upd, T) =
   (case try (unsuffix' Record.updateN) x_upd of
     SOME x =>
       (Hoare.chopsfx Hoare.deco (Hoare.extern ctxt x),
        if T = dummyT then T else Term.domain_type T)
   | NONE =>
       (case try (unsuffix Hoare.deco) x_upd of
         SOME _ => (Hoare.remdeco ctxt x_upd, T)
       | NONE => raise Match));
 
 
 fun update_name_tr' ctxt (Free x) = Const (upd_tr' ctxt x)
   | update_name_tr' ctxt ((c as Const (@{syntax_const "_free"}, _)) $ Free x) =
       (*c $*) Const (upd_tr' ctxt x)
   | update_name_tr' ctxt (Const x) = Const (upd_tr' ctxt x)
-  | update_name_tr' _ _ = raise Match;
+  | update_name_tr' ctxt t =
+     (case Hoare.get_default_state_space ctxt of
+       SOME {update_tr',...} => update_tr' ctxt t
+     | NONE => raise Match);
+
 
 fun term_name_eq (Const (x, _)) (Const (y, _)) = (x = y)
   | term_name_eq (Free (x, _)) (Free (y, _)) = (x = y)
   | term_name_eq (Var (x, _)) (Var (y, _)) = (x = y)
   | term_name_eq (a $ b) (c $ d) = term_name_eq a c andalso term_name_eq b d
   | term_name_eq (Abs (s, _, a)) (Abs (t, _, b)) = (s = t) andalso term_name_eq a b
   | term_name_eq _ _ = false;
 
 fun list_update_tr' l (r as Const (@{const_syntax list_update},_) $ l' $ i $ e) =
       if term_name_eq l l'
       then
         let
           fun sel_arr a [i] (Const (@{const_syntax nth},_) $ a' $ i') =
                 term_name_eq a a' andalso i = i'
             | sel_arr a (i::is) (Const (@{const_syntax nth},_) $ sel $ i') =
                 i = i' andalso sel_arr a is sel
             | sel_arr _ _ _ = false;
 
           fun tr' a idxs (e as Const (@{const_syntax list_update}, _) $ sel $ i $ e') =
                 if sel_arr a idxs sel then tr' a (i :: idxs) e'
                 else (idxs, e)
             | tr' _ idxs e = (idxs, e);
 
           val (idxs, e') = tr' l [i] e;
           val lft = fold_rev (fn i => fn arr => Syntax.const @{const_syntax nth} $ arr $ i) idxs l;
         in (lft,e') end
       else (l, r)
   | list_update_tr' l r  = (l, r);
 
 fun list_mult_update_tr' l (r as Const (@{const_syntax list_multupd},_) $ var $ idxs $ values) =
       (Syntax.const @{const_syntax list_multsel} $ var $ idxs, values)
   | list_mult_update_tr' l r = (l, r);
 
-fun update_tr' l (r as Const (@{const_syntax fun_upd}, _) $
+fun update_tr' ctxt l (r as Const (@{const_syntax fun_upd}, _) $
         (hp as (Const (@{syntax_const "_antiquoteCur"}, _) $ _)) $ p $ value) =
       if term_name_eq l hp then
         (case value of
           (Const (@{const_syntax list_update}, _) $ _ $ _ $ _) => list_update_tr' (l $ p) value
         | (Const (@{const_syntax list_multupd},_) $ _ $ _ $ _) => list_mult_update_tr' (l $ p) value
         | _ => (l $ p, value))
       else (l, r)
-  | update_tr' l (r as Const (@{const_syntax list_update},_) $
+  | update_tr' ctxt l (r as Const (@{const_syntax list_update},_) $
         (var as (Const (@{syntax_const "_antiquoteCur"}, _) $ _)) $ i $ value) =
       if term_name_eq l var then list_update_tr' l r else (l, r)
-  | update_tr' l (r as Const (@{const_syntax list_multupd}, _) $
+  | update_tr' ctxt l (r as Const (@{const_syntax list_multupd}, _) $
         (var as (Const (@{syntax_const "_antiquoteCur"}, _) $ _)) $ idxs $ values) =
       if term_name_eq l var then list_mult_update_tr' l r else (l, r)
-  | update_tr' l r = (l, r);
+  | update_tr' ctxt l r = (l, r);
 
 
-fun dest_K_rec (Abs (_, _, v)) =
-      if member (op =) (loose_bnos v) 0 then NONE else SOME (incr_boundvars ~1 v)
-  | dest_K_rec (Abs (_, _, Abs (_, _, v) $ Bound 0)) = (* eta expanded version *)
+fun dest_K_rec (Abs (_, _, Abs (_, _, v) $ Bound 0)) = (* eta expanded version *)
       let val lbv = loose_bnos v;
       in if member (op =) lbv 0 orelse member (op =) lbv 1
          then NONE else SOME (incr_boundvars ~2 v)
       end
+  | dest_K_rec (Abs (_, _, v)) =
+      if member (op =) (loose_bnos v) 0 then NONE else SOME (incr_boundvars ~1 v)
+  | dest_K_rec (Const (@{const_syntax K_statefun}, _) $ v) = SOME v
   | dest_K_rec _ = NONE;
 
+fun the_Match (SOME x) = x
+  | the_Match (NONE) = raise Match
+
+fun dest_update ctxt (upd' $ dest $ constr $ n $ v $ s) =
+      (n, v, SOME s)
+  | dest_update ctxt (upd' $ dest $ constr $ n $ v) =
+      (n, v, NONE)
+  | dest_update ctxt t =
+     case Hoare.get_default_state_space ctxt of
+       SOME {dest_update_tr', ...} => dest_update_tr' ctxt t
+     | NONE => raise Match
+
 local
-fun uncover (upd,v) =
-  (case (upd, v) of
-    (Const (cupd, _), upd' $ dest $ constr $ n $ (Const (@{const_syntax K_statefun}, _) $ v') $ s) =>
+fun uncover ctxt (upd,v) = (upd, v) |> first_match [
+  fn (Const (cupd, _), t) =>
       if member (op =) [globals_updateN, locals_updateN] (Long_Name.base_name cupd)
-      then (case s of (Const (g, _) $ _) =>
-               if member (op =) [localsN, globalsN] (Long_Name.base_name g)
-               then (n, v')
-               else raise Match
-             | _ => raise Match)
-       else (upd, v)
-  | (Const (gupd, _), upd' $ k $ s) =>
-      (case dest_K_rec k of
-        SOME v' =>
-          if Long_Name.base_name gupd = globals_updateN
-          then
-            (case s of
-              Const (gl, _) $ _ =>
-                if Long_Name.base_name gl = globalsN (* assignment *)
-                then (upd',v')
-                else raise Match
-            | _ => raise Match)
+      then case dest_update ctxt t of
+             (n, v', SOME s) => (case s of (Const (g, _) $ _) =>
+                                   if member (op =) [localsN, globalsN] (Long_Name.base_name g)
+                                   then (n, the_Match (dest_K_rec v'))
+                                   else raise Match
+                                 | _ => raise Match)
+           | (n, v', NONE) => (n, the_Match (dest_K_rec v'))
+      else (upd, v),
+  fn (upd, v ) =>
+    (case (upd, v) of
+      (Const (gupd, _), t as (upd' $ k $ s)) =>
+        (case dest_K_rec k of
+          SOME v' =>
+            if Long_Name.base_name gupd = globals_updateN
+            then
+              (case s of
+                Const (gl, _) $ _ =>
+                  if Long_Name.base_name gl = globalsN (* assignment *)
+                  then (upd',v')
+                  else raise Match
+              | _ => raise Match)
+            else (upd, v)
+        | _ => (upd, v))
+    | (Const (upd_glob, _), upd' $ v') =>
+        if Long_Name.base_name upd_glob = upd_globalsN (* result parameter *)
+        then (upd', v')
+        else if Long_Name.base_name upd_glob = globals_updateN
+          then (case dest_K_rec v' of
+                  SOME v'' => (upd',v'')
+                | _ => (upd, v))
           else (upd, v)
-      | _ => (upd, v))
-  | (Const (upd_glob, _), upd' $ v') =>
-      if Long_Name.base_name upd_glob = upd_globalsN (* result parameter *)
-      then (upd', v') else (upd, v)
-  | _ => (upd, v));
+    | _ => (upd, v))]
 in
 
-fun global_upd_tr' upd k =
+fun global_upd_tr' ctxt upd k =
   (case dest_K_rec k of
-    SOME v => uncover (upd, v)
-  | NONE => uncover (upd, k));
-
+    SOME v => uncover ctxt (upd, v)
+  | NONE => uncover ctxt (upd, k))
 end;
 
-
-fun dest_updates (t as (upd as Const (u, _)) $ k $ state) =
+fun dest_updates ctxt t = t |> first_match [
+  fn (t as (upd as Const (u, _)) $ k $ state) =>
       (case dest_K_rec k of
         SOME value =>
           if member (op =) [globals_updateN, locals_updateN] (Long_Name.base_name u)
-          then dest_updates value
+          then dest_updates ctxt value
           else if can (unsuffix Record.updateN) u orelse Long_Name.base_name u = upd_globalsN
-          then (upd,value)::dest_updates state
+          then (upd,value)::dest_updates ctxt state
           else raise Match
-      | NONE => raise Match)
-  | dest_updates (t as (upd as Const (u,_))$k) =
+      | NONE => raise Match (*dest_updates ctxt k @ dest_updates ctxt state*) (* check for nested update (e.g. locals-stack) *)
+                (*handle Match => []*)), (* t could be just (globals $ s) *)
+  fn (t as (upd as Const (u,_))$k) =>
       (case dest_K_rec k of
         SOME value =>
           if member (op =) [globals_updateN, locals_updateN] (Long_Name.base_name u)
-          then dest_updates value
+          then dest_updates ctxt value
           else if can (unsuffix Record.updateN) u orelse Long_Name.base_name u = upd_globalsN
           then [(upd,value)]
           else if Long_Name.base_name u = globalsN then [] else raise Match
-      | NONE => []) (* t could be just (globals $ s) *)
-  | dest_updates ((Const (u, _)) $ _ $ _ $ n $ (Const (@{const_syntax K_statefun},_) $ value) $ state) =
+      | NONE => dest_updates ctxt k (* check for nested update (e.g. locals-stack) *)
+                handle Match => []), (* t could be just (globals $ s) *)
+  fn ((Const (u, _)) $ _ $ _ $ n $ k $ state) =>
       if Long_Name.base_name u = Long_Name.base_name StateFun.updateN
-      then (n, value) :: dest_updates state
-      else raise Match
-  | dest_updates t = [];
+      then case dest_K_rec k of SOME value => (n, value) :: dest_updates ctxt state | _ => raise Match
+      else raise Match,
+  fn ((Const (u, _)) $ _ $ _ $ n $ k) =>
+      if Long_Name.base_name u = Long_Name.base_name StateFun.updateN
+      then case dest_K_rec k of SOME value => [(n, value)] | _ => raise Match
+      else raise Match,
+  fn t =>
+       (case Hoare.get_default_state_space ctxt of
+          SOME {dest_update_tr', ...} =>
+            (case dest_update_tr' ctxt t of
+               (n, v, SOME s) => (n, the_Match (dest_K_rec v))::dest_updates ctxt s
+             | (n, v, NONE) => [(n, the_Match (dest_K_rec v))])
+        | NONE => raise Match),
+  fn t => []]
 
-(* FIXME: externalize names properly before removing decoration! *)
+fun dest_updates ctxt t = t |> first_match [
+  fn (t as (upd as Const (u, _)) $ k $ state) =>
+       if member (op =) [globals_updateN, locals_updateN] (Long_Name.base_name u) then
+          dest_updates ctxt k @ dest_updates ctxt state
+       else if can (unsuffix Record.updateN) u orelse Long_Name.base_name u = upd_globalsN then
+          (upd, the_Match (dest_K_rec k))::dest_updates ctxt state
+       else raise Match, (* t could be just (globals $ s) *)
+  fn (t as (upd as Const (u,_))$k) =>
+       if member (op =) [globals_updateN, locals_updateN] (Long_Name.base_name u) then
+         dest_updates ctxt k
+       else if can (unsuffix Record.updateN) u orelse Long_Name.base_name u = upd_globalsN then
+         [(upd, the_Match (dest_K_rec k))]
+       (*else if Long_Name.base_name u = globalsN then [] *)
+       else raise Match,
+  fn ((Const (u, _)) $ _ $ _ $ n $ k $ state) =>
+       if Long_Name.base_name u = Long_Name.base_name StateFun.updateN then
+         (n, the_Match (dest_K_rec k)) :: dest_updates ctxt state
+       else raise Match,
+  fn ((Const (u, _)) $ _ $ _ $ n $ k) =>
+      if Long_Name.base_name u = Long_Name.base_name StateFun.updateN then
+        [(n, the_Match (dest_K_rec k))]
+      else raise Match,
+  fn t =>
+       (case Hoare.get_default_state_space ctxt of
+          SOME {dest_update_tr', ...} =>
+            (case dest_update_tr' ctxt t of
+               (n, v, SOME s) => (n, the_Match (dest_K_rec v))::dest_updates ctxt s
+             | (n, v, NONE) => [(n, the_Match (dest_K_rec v))])
+        | NONE => raise Match),
+  fn t => []]
+
+
+(* fixme: externalize names properly before removing decoration! *)
 fun init_tr' ctxt [Abs (_,_,t)] =
   let
     val upds  =
-      case dest_updates t of
+      case dest_updates ctxt t of
         us as [(Const (gupd, _), v)] =>
           if Long_Name.base_name gupd = globals_updateN
-          then dest_updates v else us
+          then dest_updates ctxt v else us
       | us => us;
 
     val comps =
       map (fn (Const (u, _)) => Symbol.explode (unsuffix (Hoare.deco ^ Record.updateN) u))
         (map fst upds);
     val prfx = maxprefixs (op =) comps;
 
     fun dest_list (Const (@{const_syntax Nil}, _)) = []
       | dest_list (Const (@{const_syntax Cons}, _) $ x $ xs) = x :: dest_list xs
       | dest_list t = [t];
 
     fun mk_set [] = Syntax.const @{const_syntax Set.empty}
       | mk_set (x :: xs) = Syntax.const @{const_syntax insert} $ x $ mk_set xs;
 
     val l = length prfx;
     val _ = if l <= 1 then raise Match else ();
     val comp = mk_list (map (Syntax.const o implode o drop l) comps);
     val vals = map mk_set (transpose (map (dest_list o snd) upds));
     val v = case vals of [v] => v | vs => mk_list vs;
   in
     Syntax.const @{syntax_const "_Init"} $
       Syntax.const (implode (fst (split_last prfx))) $ comp $ v
   end;
 
 
 local
 fun tr' ctxt c (upd,v) =
   let
     val l = Syntax.const antiquoteCur $ update_name_tr' ctxt upd;
     val r = quote_tr' ctxt antiquoteCur (Abs ("s", dummyT, v));
-    val (l', r') = update_tr' l r;
+    val (l', r') = update_tr' ctxt l r;
   in (c $ l' $ r') end;
 
 in
 fun app_assign_tr' c ctxt (Abs (s, _, upd $ v $ Bound 0) :: ts) =
-      tr' ctxt c (global_upd_tr' upd v)
+      tr' ctxt c (global_upd_tr' ctxt upd v)
   | app_assign_tr' c ctxt ((upd $ v) :: ts) =
       (case upd of
         u $ v => raise Match
-      | _ => tr' ctxt c (global_upd_tr' upd v))
+      | _ => tr' ctxt c (global_upd_tr' ctxt upd v))
   | app_assign_tr' _ _ _ = raise Match;
 end;
 
 val assign_tr' = app_assign_tr' (Syntax.const @{syntax_const "_Assign"});
 val raise_tr' = app_assign_tr' (Syntax.const @{syntax_const "_raise"});
 
 fun split_Let' ((l as Const (@{const_syntax Let'}, _)) $ x $ t) =
       let val (recomb,t') = split_Let' t
       in (fn t => l $ x $ recomb t, t') end
   | split_Let' (Abs (x, T, t)) =
      let val (recomb, t') = split_Let' t
      in if t' = t
         then (I, t') (* Get rid of last abstraction *)
         else (fn t => Abs (x, T, recomb t), t')
      end
   | split_Let' ((s as Const (@{const_syntax case_prod},_)) $ t) =
      let val (recomb, t') = split_Let' t
      in (fn t => s $ recomb t, t') end
   | split_Let' t = (I, t)
 
 fun basic_tr' ctxt [Abs (s, T, t)] =
   let
     val (has_let, t') =
       case t of
         ((t' as (Const (@{const_syntax Let'},_) $ _ $ _)) $ Bound 0) => (true, t')
       | _ => (false, t);
     val (recomb, t'') = split_Let' t';
-    val upds = dest_updates t'';
+    val upds = dest_updates ctxt t'';
     val _ = if length upds <= 1 andalso not has_let then raise Match else ();
     val ass =
       map (fn (u, v) => app_assign_tr' (Syntax.const @{syntax_const "_BAssign"}) ctxt
             [Abs ("s",dummyT,u$v$Bound 0)]) upds;
     val basics = foldr1 (fn (x, ys) => Syntax.const @{syntax_const "_basics"} $ x $ ys) (rev ass);
   in
     Syntax.const @{syntax_const "_Basic"} $
       quote_tr' ctxt @{syntax_const "_antiquoteCur"} (Abs (s, T, recomb basics))
   end;
 
 fun loc_tr' ctxt [init, bdy, return, c] =
       (let
         val upds =
           (case init of
-            Abs (_, _, t as (upd $ v $ s)) => dest_updates t
-          | upd $ v => dest_updates (upd $ v $ Bound 0)
+            Abs (_, _, t as (upd $ v $ s)) => dest_updates ctxt t
+          | upd $ v => dest_updates ctxt (upd $ v $ Bound 0)
           | _ => raise Match);
 
         fun mk_locinit c v =
           Syntax.const @{syntax_const "_locinit"} $
             Syntax.const c $ quote_tr' ctxt antiquoteCur (Abs ("s", dummyT, v));
 
         fun init_or_not c c' v =
           if c = c' then
             Syntax.const @{syntax_const "_locnoinit"} $ Syntax.const (Hoare.remdeco ctxt c')
           else mk_locinit (Hoare.remdeco ctxt c) v;
 
         fun mk_init (Const (c, _), (v as (Const (c', _) $ Bound 0))) =
               init_or_not (unsuffix' Record.updateN c) c' v
           | mk_init (Const (c, _), v) =
               mk_locinit (unsuffix' (Hoare.deco ^ Record.updateN) (Hoare.extern ctxt c)) v
           | mk_init ((f as Const (@{syntax_const "_free"}, _)) $ Free (c, _), v) =
               (case v of
                 Const (lookup, _) $ _ $
                   (Const (@{syntax_const "_free"}, _) $ Free (c', _)) $
                   (Const (locals,_) $ Bound 0) =>
                 if Long_Name.base_name lookup = Long_Name.base_name StateFun.lookupN
                   andalso Long_Name.base_name locals = localsN
                 then init_or_not c c' v
-                else mk_locinit (Hoare.remdeco' c) v
-              | _ => mk_locinit (Hoare.remdeco' c) v)
+                else mk_locinit (Hoare.remdeco' ctxt c) v
+              | _ => mk_locinit (Hoare.remdeco' ctxt c) v)
           | mk_init _ = raise Match;
 
         val inits =
           foldr1 (fn (t, u) => Syntax.const @{syntax_const "_locinits"} $ t $ u)
             (map mk_init (rev upds));
-      in Syntax.const @{syntax_const "_Loc"} $ inits $ bdy end handle Fail _ => raise Match)
+      in Syntax.const @{syntax_const "_Loc"} $ inits $ bdy end handle Fail _ => raise Match | Empty => raise Match)
   | loc_tr' _ _ = raise Match;
 
 
 fun actuals_tr' acts =
   (case acts of
     [] => Syntax.const @{syntax_const "_actuals_empty"}
   | xs => Syntax.const @{syntax_const "_actuals"} $
         foldr1 (fn (l, r) => (Syntax.const @{syntax_const "_pars"} $ l $ r)) xs);
 
 
 fun gen_call_tr' ctxt Call CallAss init p return c =
   let
-    fun get_init_updates (Abs (s, _, upds)) = dest_updates upds
-      | get_init_updates upds = dest_updates upds;
+    fun get_init_updates (Abs (s, _, upds)) = dest_updates ctxt upds
+      | get_init_updates upds = dest_updates ctxt upds;
 
     fun get_res_updates (Abs (i, _, Abs (t, _, Const (@{const_syntax Basic}, _) $ Abs (s, _, upds)))) =
-          dest_updates upds
+          dest_updates ctxt upds
       | get_res_updates (Abs (i, _, Abs (t, _, Const (@{const_syntax Basic}, _) $ upds))) =
-          dest_updates upds
+          dest_updates ctxt upds
       | get_res_updates _ = raise Match;
 
-      fun init_par_tr' par =
+    val init_upds = rev (get_init_updates init)
+    fun init_par_tr' par =
         Syntax.const @{syntax_const "_par"} $ quote_tr' ctxt antiquoteCur (Abs ("s", dummyT, par));
-      val init_actuals =
-        map (fn (_, value) => init_par_tr' value) (rev (get_init_updates init));
+    val init_actuals =
+      map (fn (_, value) => init_par_tr' value) init_upds;
 
-      fun tr' c (upd, v) =
-        let
-          val l = Syntax.const antiquoteCur $ update_name_tr' ctxt upd;
-          val r =
-            quote_tr' ctxt antiquoteCur
+    fun tr' c (upd, v) =
+      let
+        val l = Syntax.const antiquoteCur $ update_name_tr' ctxt upd;
+        val r =
+          quote_tr' ctxt antiquoteCur
+            (quote_tr' ctxt antiquoteCur
               (quote_tr' ctxt antiquoteCur
-                (quote_tr' ctxt antiquoteCur
-                  (Abs ("i", dummyT, Abs ("t", dummyT, Abs ("s", dummyT, v))))));
-          val (l', _) = update_tr' l r;
-        in c $ l' end;
+                (Abs ("i", dummyT, Abs ("t", dummyT, Abs ("s", dummyT, v))))));
+        val (l', _) = update_tr' ctxt l r;
+      in c $ l' end;
 
-      fun ret_par_tr' (upd, v) =
-        tr' (Syntax.const @{syntax_const "_par"}) (global_upd_tr' upd v);
+    fun ret_par_tr' (upd, v) =
+      tr' (Syntax.const @{syntax_const "_par"}) (global_upd_tr' ctxt upd v);
 
-      val res_updates = rev (get_res_updates c);
-      val res_actuals = map ret_par_tr' res_updates;
-  in if Config.get ctxt use_call_tr' then
+    val res_updates = rev (get_res_updates c);
+    val res_actuals = map ret_par_tr' res_updates;
+  in
+    if Config.get ctxt use_call_tr' then
         (case res_actuals of
           [l] => CallAss $ l $ p $ actuals_tr' init_actuals
          | _ => Call $ p $ actuals_tr' (init_actuals @ res_actuals))
-     else raise Match
+    else raise Match
   end;
 
 fun gen_fcall_tr' ctxt init p return result c =
   let
-    fun get_init_updates (Abs (s, _, upds)) = dest_updates upds
+    fun get_init_updates (Abs (s, _, upds)) = dest_updates ctxt upds
       | get_init_updates _ = raise Match;
 
     fun init_par_tr' par =
       Syntax.const @{syntax_const "_par"} $ quote_tr' ctxt antiquoteCur (Abs ("s", dummyT, par));
     val init_actuals =
       map (fn (_, value) => init_par_tr' value) (rev (get_init_updates init));
 
     val (v, c') =
       (case c of
         Abs abs => Syntax_Trans.atomic_abs_tr' abs
       | _ => raise Match);
   in
     if Config.get ctxt use_call_tr' then
       Syntax.const @{syntax_const "_FCall"} $ p $ actuals_tr' init_actuals $ v $ c'
     else raise Match
   end;
 
 
 fun pname_tr' ctxt ((f as Const (@{syntax_const "_free"}, _)) $ Free (p, T)) =
       (*f$*) Const (unsuffix' Hoare.proc_deco p, T)
   | pname_tr' ctxt (Free (p, T)) = Const (unsuffix' Hoare.proc_deco p, T)
   | pname_tr' ctxt p =
       let
         (* from HOL strings to ML strings *)
-        fun dest_nib c =    (* FIXME authentic syntax *)
+        fun dest_nib c =    (* fixme authentic syntax *)
           (case raw_explode c of
             ["N", "i", "b", "b", "l", "e", h] =>
               if "0" <= h andalso h <= "9" then ord h - ord "0"
               else if "A" <= h andalso h <= "F" then ord h - ord "A" + 10
               else raise Match
           | _ => raise Match);
 
         fun dest_chr (Const (@{const_syntax Char},_) $ Const (c1, _) $ Const (c2,_)) =
               let val c = Char.chr (dest_nib c1 * 16 + dest_nib c2)
               in if Char.isPrint c then c else raise Match end
           | dest_chr _ = raise Match;
 
         fun dest_string (Const (@{const_syntax Nil}, _)) = []
           | dest_string (Const (@{const_syntax Cons}, _) $ c $ cs) = dest_chr c :: dest_string cs
           | dest_string _ = raise Match;
         in
           (case try dest_string p of
             SOME name => Syntax.const (String.implode name)
           | NONE => antiquote_mult_tr' ctxt (K true) antiquoteCur antiquoteOld p)
         end;
 
 fun call_tr' ctxt [init, p, return, result] =
       gen_call_tr' ctxt
         (Const (@{syntax_const "_Call"}, dummyT))
         (Const (@{syntax_const "_CallAss"}, dummyT)) init (pname_tr' ctxt p) return result
   | call_tr' _ _ = raise Match;
 
+fun call_exn_tr' ctxt [init, p, return, result_exn, result] =
+      gen_call_tr' ctxt
+        (Const (@{syntax_const "_Call_exn"}, dummyT))
+        (Const (@{syntax_const "_CallAss_exn"}, dummyT)) init (pname_tr' ctxt p) return result
+  | call_exn_tr' _ _ = raise Match;
+
 
 fun dyn_call_tr' ctxt [init, p, return, result] =
       let val p' = quote_tr' ctxt antiquoteCur p
       in
         gen_call_tr' ctxt
           (Const (@{syntax_const "_DynCall"}, dummyT))
           (Const (@{syntax_const "_DynCallAss"}, dummyT)) init p' return result
       end
   | dyn_call_tr' _ _ = raise Match;
 
+fun dyn_call_exn_tr' ctxt [init, p, return, result_exn, result] =
+      let val p' = quote_tr' ctxt antiquoteCur p
+      in
+        gen_call_tr' ctxt
+          (Const (@{syntax_const "_DynCall_exn"}, dummyT))
+          (Const (@{syntax_const "_DynCallAss_exn"}, dummyT)) init p' return result
+      end
+  | dyn_call_exn_tr' _ _ = raise Match;
+
 fun proc_tr' ctxt [p] =
       let
         val p' = pname_tr' ctxt p;
-        val pn = fst (dest_procname ctxt "" false p');
+        val pn = fst (dest_procname ctxt false p');
         val formals = the (Hoare.get_params pn ctxt) handle Option.Option => raise Match;
-        val val_formals = map_filter (fn (Hoare.In, p) => SOME p | _ => NONE) formals;
-        val res_formals = map_filter (fn (Hoare.Out, p) => SOME p | _ => NONE) formals;
+        val val_formals = map_filter (fn (Hoare.In, p, _) => SOME p | _ => NONE) formals;
+        val res_formals = map_filter (fn (Hoare.Out, p, _) => SOME p | _ => NONE) formals;
         fun mkpar n =
           Syntax.const @{syntax_const "_par"} $
             (Syntax.const antiquoteCur $ Syntax.const (Hoare.remdeco ctxt n));
       in
         if not (print_mode_active "NoProc")
         then
           (case res_formals of
             [r] =>
               Syntax.const @{syntax_const "_ProcAss"} $
                 (Syntax.const antiquoteCur $
                   Syntax.const (Hoare.remdeco ctxt r)) $
                 p' $ actuals_tr' (map mkpar val_formals)
           | _ =>
               Syntax.const @{syntax_const "_Proc"} $ p' $
                 actuals_tr' (map mkpar (val_formals @ res_formals)))
          else raise Match
       end
   | proc_tr' _ _ = raise Match;
 
 fun fcall_tr' ctxt [init, p, return, result, c] =
       gen_fcall_tr' ctxt init (pname_tr' ctxt p) return result c
   | fcall_tr' _ _ = raise Match;
 
 
 (* misc. print translations *)
 
 fun assert_tr' ctxt ((t as Abs (_, _, p)) :: ts) =
       let
         fun selector (Const (c, T)) = Hoare.is_state_var c
           | selector (Const (l, _) $ _ $ _) =
               Long_Name.base_name l = Long_Name.base_name StateFun.lookupN
-          | selector t = false;
+          | selector t =
+              (case Hoare.get_default_state_space ctxt of
+                SOME {is_lookup,...} => is_lookup ctxt t
+              | _ => false)
 
         fun fix_state (Const (@{const_syntax HOL.eq},_) $ (Const (@{syntax_const "_free"}, _) $ _)) = true
           | fix_state (Const (@{const_syntax HOL.eq},_) $ (Const (@{syntax_const "_bound"}, _) $ _)) = true
           | fix_state (Const (@{const_syntax HOL.eq},_) $ (Const (@{syntax_const "_var"}, _) $ _)) = true
           | fix_state (Const (@{const_syntax HOL.eq},_) $ Free _) = true
           | fix_state (Const (@{const_syntax HOL.eq},_) $ Bound _) = true
           | fix_state (Const (@{const_syntax HOL.eq},_) $ Var _) = true
           | fix_state _ = false;
       in
         if antiquote_applied_only_to (fn t => selector t orelse fix_state t) p
           andalso not (print_mode_active "NoAssertion")
         then app_quote_mult_tr' ctxt selector (Syntax.const @{syntax_const "_Assert"}) (t :: ts)
         else raise Match
       end
   | assert_tr' _ _ = raise Match
 
 
 fun bexp_tr' name ctxt ((Const (@{const_syntax Collect}, _) $ t) :: ts) =
       app_quote_tr' ctxt (Syntax.const name) (t :: ts)
   | bexp_tr' _ _ _ = raise Match;
 
 
 
 fun new_tr' ctxt
         [Abs (s,_,
           Const (@{const_syntax If}, _) $
           (Const (@{const_syntax Orderings.less_eq},_) $ size $ free) $
           (upd $ new $ (gupd $ Abs (_, _, inits_free_alloc) $ Bound 0)) $
           (upd' $ null $ Bound 0))] =
       let
         fun mk_init (Const (upd, _), Const (@{const_syntax fun_upd},_) $ _ $ _ $ v) =
               let val var = unsuffix' Hoare.deco
                 (unsuffix' Record.updateN (Hoare.extern ctxt upd))
               in Syntax.const @{syntax_const "_newinit"} $ Syntax.const var $ v end
           | mk_init ((f as Const (@{syntax_const "_free"}, _)) $
                 Free (var, T), Const (@{const_syntax fun_upd},_) $ _ $ _ $ v) =
               Syntax.const @{syntax_const "_newinit"} $
-                (f $ Free (Hoare.remdeco' var, T)) $ v;
+                (f $ Free (Hoare.remdeco' ctxt var, T)) $ v;
 
-        val inits_free_allocs = dest_updates inits_free_alloc;
+        val inits_free_allocs = dest_updates ctxt inits_free_alloc;
 
         val inits = map mk_init (take (length inits_free_allocs - 2) (inits_free_allocs));
         val inits' =
           foldr1 (fn (t1, t2) => Syntax.const @{syntax_const "_newinits"} $ t1 $ t2) (rev inits);
 
         fun tr' (upd, v) =
           let
             val l = Syntax.const antiquoteCur $ update_name_tr' ctxt upd;
             val r = quote_tr' ctxt antiquoteCur (Abs (s, dummyT, v));
-            val (l', r') = update_tr' l r
+            val (l', r') = update_tr' ctxt l r
           in l' end;
 
-        val l = tr' (global_upd_tr' upd' null);
+        val l = tr' (global_upd_tr' ctxt upd' null);
 
       in Syntax.const @{syntax_const "_New"} $ l $ size $ inits' end
   | new_tr' _ _ = raise Match;
 
 fun nnew_tr' ctxt
         [Const (@{const_syntax if_rel},_) $
           (Abs (s, _, Const (@{const_syntax Orderings.less_eq}, _) $ size $ free)) $
           (Abs (_, _, upd $ new $ (gupd $ (Abs (_, _, free_inits_alloc)) $ Bound 0))) $
           (Abs (_, _, (upd' $ null $ Bound 0))) $ _] =
       let
         fun mk_init (Const (upd, _), Const (@{const_syntax fun_upd}, _) $ _ $ _ $ v) =
               let val var = unsuffix' Hoare.deco
                 (unsuffix' Record.updateN (Hoare.extern ctxt upd))
               in Syntax.const @{syntax_const "_newinit"} $ Syntax.const var $ v end
           | mk_init ((f as Const (@{syntax_const "_free"}, _)) $ Free (var, T),
                 Const (@{const_syntax fun_upd}, _) $_ $ _ $ v) =
               Syntax.const @{syntax_const "_newinit"} $
-                (f $ Free (Hoare.remdeco' var, T)) $ v;
+                (f $ Free (Hoare.remdeco' ctxt var, T)) $ v;
 
-        val free_inits_allocs = dest_updates free_inits_alloc;
+        val free_inits_allocs = dest_updates ctxt free_inits_alloc;
 
         val inits = map mk_init (take (length free_inits_allocs - 2) (tl free_inits_allocs));
         val inits' =
           foldr1 (fn (t1, t2) => Syntax.const @{syntax_const "_newinits"} $ t1 $ t2) (rev inits);
 
         fun tr' (upd, v) =
           let
             val l = Syntax.const antiquoteCur $ update_name_tr' ctxt upd;
             val r = quote_tr' ctxt antiquoteCur (Abs (s, dummyT, v));
-            val (l', r') = update_tr' l r;
+            val (l', r') = update_tr' ctxt l r;
           in l' end;
 
-        val l = tr' (global_upd_tr' upd' null);
+        val l = tr' (global_upd_tr' ctxt upd' null);
 
       in Syntax.const @{syntax_const "_NNew"} $ l $ size $ inits' end
   | nnew_tr' _ _ = raise Match;
 
 
 fun switch_tr' ctxt [v, vs] =
   let
     fun case_tr' (Const (@{const_syntax Pair}, _) $ V $ c) =
           Syntax.const @{syntax_const "_switchcase"} $ V $ c
       | case_tr' _ = raise Match;
 
     fun dest_list (Const (@{const_syntax Nil}, _)) = []
       | dest_list (Const (@{const_syntax Cons}, _) $ x $ xs) = x :: dest_list xs
       | dest_list t = raise Match;
 
     fun ltr' [] = raise Match
       | ltr' [Vc] = Syntax.const @{syntax_const "_switchcasesSingle"} $ case_tr' Vc
       | ltr' (Vc :: xs) = Syntax.const @{syntax_const "_switchcasesCons"} $ case_tr' Vc $ ltr' xs;
 
    in app_quote_tr' ctxt (Syntax.const @{syntax_const "_Switch"}) (v :: [ltr' (dest_list vs)]) end;
 
 fun bind_tr' ctxt [e, Abs abs] =
       let
         val (v, c) = Syntax_Trans.atomic_abs_tr' abs;
         val e' =
           case e of
             Abs a => e
           | t as Const _ => Abs ("s", dummyT, t $ Bound 0)
           | _ => raise Match;
       in app_quote_tr' ctxt (Syntax.const @{syntax_const "_Bind"}) [e', v, c] end
   | bind_tr' _ _ = raise Match;
 
 
 local
   fun dest_list (Const (@{const_syntax Nil}, _)) = []
     | dest_list (Const (@{const_syntax Cons}, _) $ x $ xs) = x :: dest_list xs
     | dest_list _ = raise Match;
 
   fun guard_tr' fg =
     let val (flag, g) = HOLogic.dest_prod fg
     in
       if flag aconv @{term True} then Syntax.const @{syntax_const "_guarantee"} $ g
       else if flag aconv @{term False} then g
       else fg
     end handle TERM _ => fg;
 
   fun guards_lst_tr' [fg] = guard_tr' fg
     | guards_lst_tr' (t :: ts) =
         Syntax.const @{syntax_const "_grds"} $ guard_tr' t $ guards_lst_tr' ts
     | guards_lst_tr' [] = raise Match;
 
   fun cond_guards_lst_tr' ctxt ts =
     if Config.get ctxt hide_guards then Syntax.const @{syntax_const "_hidden_grds"}
     else guards_lst_tr' ts;
 in
   fun guards_tr' ctxt [gs, c] =
         Syntax.const @{syntax_const "_guards"} $ cond_guards_lst_tr' ctxt (dest_list gs) $ c
     | guards_tr' _ _ = raise Match;
 
   fun whileAnnoG_tr' ctxt [gs, cond as (Const (@{const_syntax Collect}, _) $ b), I, V, c] =
         let
           val b' =
             (case assert_tr' ctxt [b] of
               Const (@{syntax_const "_Assert"}, _) $ b' => b'
             | _ => cond) handle Match => cond;
 
         in
           Syntax.const @{syntax_const "_While_guard_inv_var"} $
             cond_guards_lst_tr' ctxt (dest_list gs) $ b' $ I $ V $
             (Syntax.const @{syntax_const "_DoPre"} $ c)
         end
     | whileAnnoG_tr' _ _ = raise Match;
 
   fun whileAnnoGFix_tr' ctxt [gs, cond as (Const (@{const_syntax Collect}, _) $ b), I, V, c] =
     let
       val b' =
         (case assert_tr' ctxt [b] of
           Const (@{syntax_const "_Assert"}, _) $ b' => b'
         | _ => cond) handle Match => cond;
     in
       (case maps strip_abs_vars [I, V, c] of
         [] => raise Match
       | ((x, T) :: xs) =>
           let
             val (x', I') = Syntax_Trans.atomic_abs_tr' (x, T, strip_abs_body I);
             val (_ , V') = Syntax_Trans.atomic_abs_tr' (x, T, strip_abs_body V);
             val (_ , c') = Syntax_Trans.atomic_abs_tr' (x, T, strip_abs_body c);
           in
             Syntax.const @{syntax_const "_WhileFix_guard_inv_var"} $
               cond_guards_lst_tr' ctxt (dest_list gs) $ b' $ x' $ I' $ V' $
               (Syntax.const @{syntax_const "_DoPre"} $ c')
           end)
     end;
 end
 
 
 end;
diff --git a/web/entries/Catoids.html b/web/entries/Catoids.html
--- a/web/entries/Catoids.html
+++ b/web/entries/Catoids.html
@@ -1,274 +1,274 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Catoids, Categories, Groupoids - Archive of Formal Proofs</title>
     <meta name="description" content="This AFP entry formalises catoids, which are generalisations of
   single-set categories, and groupoids. More specifically, in catoids,
   the partial...">
 
   <meta property="og:title" content="Catoids, Categories, Groupoids" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Catoids.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-08-14T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-08-14T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Catoids, Categories, Groupoids"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>C</span>atoids, <span class='first'>C</span>ategories, <span class='first'>G</span>roupoids
     
   </h1>
   <div>
       <p>
         <a href="../authors/struth">Georg Struth</a> <a class="obfuscated" data="eyJob3N0IjpbInNoZWZmaWVsZCIsImFjIiwidWsiXSwidXNlciI6WyJnIiwic3RydXRoIl19">📧</a>
 
       </p>
       <p class="date">August 14, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">This AFP entry formalises catoids, which are generalisations of
   single-set categories, and groupoids. More specifically, in catoids,
   the partial composition of arrows in a category is generalised to a
   multioperation, which sends pairs of elements to sets of elements,
   and the definedness condition of arrow composition -- two arrows can
   be composed if and only the target of the first matches the source
   of the second -- is relaxed. Beyond a library of basic laws for
   catoids, single-set categories and groupoids, I formalise the facts
   that every catoid can be lifted to a modal powerset quantale, that
   every groupoid can be lifted to a Dedekind quantale and to power set
   relation algebras, a special case of a famous result of Jónsson and
   Tarski. Finally, I show that single-set categories are equivalent to
   a standard axiomatisation of categories based on a set of objects
   and a set of arrows, and compare catoids with related structures
   such as multimonoid and relational monoids (monoids in the monoidal
   category Rel).</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/mathematics/algebra">Mathematics/Algebra</a></li>
           <li><a href="../topics/mathematics/category-theory">Mathematics/Category theory</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
         <li>Cranch, J., Doherty, S., &amp; Struth, G. (2020). <i>Convolution and Concurrency</i> (Version 1). arXiv. https://doi.org/10.48550/ARXIV.2002.02321
         </li>
         <li>Calk, C., Fahrenberg, U., Johansen, C., Struth, G., & Ziemiański, K. (2021). $$\ell r$$-Multisemigroups, Modal Quantales and the Origin of Locality. Lecture Notes in Computer Science, 90–107. <a href="https://doi.org/10.1007/978-3-030-88701-8_6">https://doi.org/10.1007/978-3-030-88701-8_6</a>
 
         </li>
         <li>Fahrenberg, U., Johansen, C., Struth, G., & Ziemiański, K. (2023). Catoids and modal convolution algebras. Algebra Universalis, 84(2). <a href="https://doi.org/10.1007/s00012-023-00805-9">https://doi.org/10.1007/s00012-023-00805-9</a>
 
         </li>
-        <li>Calk, C., Malbos, P., Pous, D., &amp; Struth, G. (2023). <i>Higher Catoids, Higher Quantales and their Correspondences</i> (Version 1). arXiv. https://doi.org/10.48550/ARXIV.2307.09253
+        <li>Calk, C., Malbos, P., Pous, D., &amp; Struth, G. (2023). <i>Higher Catoids, Higher Quantales and their Correspondences</i> (Version 2). arXiv. https://doi.org/10.48550/ARXIV.2307.09253
         </li>
       </ul>
       <h3>Session Catoids</h3>
       <ul>
           <li><a href="../sessions/catoids/#Catoid">Catoid</a></li>
           <li><a href="../sessions/catoids/#Groupoid">Groupoid</a></li>
           <li><a href="../sessions/catoids/#Catoid_Lifting">Catoid_Lifting</a></li>
           <li><a href="../sessions/catoids/#Groupoid_Lifting">Groupoid_Lifting</a></li>
           <li><a href="../sessions/catoids/#Multimonoid">Multimonoid</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/KAD.html">Kleene Algebras with Domain</a></li>
               <li><a href="../entries/Quantales.html">Quantales</a></li>
               <li><a href="../entries/Quantales_Converse.html">Modal quantales, involutive quantales, Dedekind Quantales</a></li>
               <li><a href="../entries/Relation_Algebra.html">Relation Algebra</a></li>
         </ul>
       </div>
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/OmegaCatoidsQuantales.html">Higher Globular Catoids and Quantales</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Catoids/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Catoids/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Catoids/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Catoids-AFP</p>
         <pre id="copy-text">@article{Catoids-AFP,
   author  = {Georg Struth},
   title   = {Catoids, Categories, Groupoids},
   journal = {Archive of Formal Proofs},
   month   = {August},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Catoids.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Catoids-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Catoids-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Catoids-2023-08-16.tar.gz">
                 Aug 16, 2023
               </a>
               : Isabelle2022
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Combinatorics_Words.html b/web/entries/Combinatorics_Words.html
--- a/web/entries/Combinatorics_Words.html
+++ b/web/entries/Combinatorics_Words.html
@@ -1,289 +1,289 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Combinatorics on Words Basics - Archive of Formal Proofs</title>
     <meta name="description" content="We formalize basics of Combinatorics on Words. This is an extension of
 existing theories on lists. We provide additional properties related
 to prefix,...">
 
   <meta property="og:title" content="Combinatorics on Words Basics" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Combinatorics_Words.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2021-05-24T00:00:00+00:00" />
 <meta property="article:modified_time" content="2021-05-24T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Combinatorics on Words Basics"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>C</span>ombinatorics on <span class='first'>W</span>ords <span class='first'>B</span>asics
     
   </h1>
   <div>
       <p>
         <a href="../authors/holub">Štěpán Holub</a> <a href="https://www2.karlin.mff.cuni.cz/~holub/">🌐</a>, <a href="../authors/raska">Martin Raška</a> and <a href="../authors/starosta">Štěpán Starosta</a> <a href="https://staroste.pages.fit/">🌐</a>
 
       </p>
       <p class="date">May 24, 2021</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">We formalize basics of Combinatorics on Words. This is an extension of
 existing theories on lists. We provide additional properties related
 to prefix, suffix, factor, length and rotation. The topics include
 prefix and suffix comparability, mismatch, word power, total and
 reversed morphisms, border, periods, primitivity and roots. We also
 formalize basic, mostly folklore results related to word equations:
 equidivisibility, commutation and conjugation. Slightly advanced
 properties include the Periodicity lemma (often cited as the Fine and
 Wilf theorem) and the variant of the Lyndon-Schützenberger theorem for
 words, including its full parametric solution. We support the algebraic point of view which sees words as generators of submonoids of a free monoid. This leads to the concepts of the (free) hull, the (free) basis (or code). We also provide relevant proof methods and a tool to generate reverse-symmetric claims.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>History</h3>
       <dl>
         <dt>August 17, 2023</dt>
         <dd>Updated to version v1.10.1.
 </dd>
         <dt>August 24, 2022</dt>
         <dd>Many updates and additions. New theories: Border_Array, Morphisms, Equations_Basic, and Binary_Code_Morphisms.
 </dd>
       </dl>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/automata-and-formal-languages">Computer science/Automata and formal languages</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Holub, Š., &amp; Starosta, Š. (2021). Formalization of Basic Combinatorics on Words. <i>Schloss Dagstuhl - Leibniz-Zentrum Für Informatik</i>. https://doi.org/10.4230/LIPICS.ITP.2021.22
+        <li>Holub, Š., &amp; Starosta, Š. (2021). <i>Formalization of Basic Combinatorics on Words</i>. Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.ITP.2021.22
         </li>
         <li><a href="https://arxiv.org/abs/2104.11622">Producing symmetrical facts for lists induced by the list reversal mapping in Isabelle/HOL</a>
         </li>
         <li><a  href="https://gitlab.com/formalcow/combinatorics-on-words-formalized">Development repository</a>
         </li>
       </ul>
       <h3>Session Combinatorics_Words</h3>
       <ul>
           <li><a href="../sessions/combinatorics_words/#Arithmetical_Hints">Arithmetical_Hints</a></li>
           <li><a href="../sessions/combinatorics_words/#Reverse_Symmetry">Reverse_Symmetry</a></li>
           <li><a href="../sessions/combinatorics_words/#CoWBasic">CoWBasic</a></li>
           <li><a href="../sessions/combinatorics_words/#Border_Array">Border_Array</a></li>
           <li><a href="../sessions/combinatorics_words/#Submonoids">Submonoids</a></li>
           <li><a href="../sessions/combinatorics_words/#Morphisms">Morphisms</a></li>
           <li><a href="../sessions/combinatorics_words/#Periodicity_Lemma">Periodicity_Lemma</a></li>
           <li><a href="../sessions/combinatorics_words/#Lyndon_Schutzenberger">Lyndon_Schutzenberger</a></li>
           <li><a href="../sessions/combinatorics_words/#Binary_Code_Morphisms">Binary_Code_Morphisms</a></li>
           <li><a href="../sessions/combinatorics_words/#Equations_Basic">Equations_Basic</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/Binary_Code_Imprimitive.html">Binary codes that do not preserve primitivity</a>
             </li>
             <li>
               <a href="../entries/Two_Generated_Word_Monoids_Intersection.html">Intersection of two monoids generated by two element codes</a>
             </li>
             <li>
               <a href="../entries/Combinatorics_Words_Graph_Lemma.html">Graph Lemma</a>
             </li>
             <li>
               <a href="../entries/Combinatorics_Words_Lyndon.html">Lyndon words</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Combinatorics_Words/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Combinatorics_Words/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Combinatorics_Words/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Combinatorics_Words-AFP</p>
         <pre id="copy-text">@article{Combinatorics_Words-AFP,
   author  = {Štěpán Holub and Martin Raška and Štěpán Starosta},
   title   = {Combinatorics on Words Basics},
   journal = {Archive of Formal Proofs},
   month   = {May},
   year    = {2021},
   note    = {\url{https://isa-afp.org/entries/Combinatorics_Words.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Combinatorics_Words-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Combinatorics_Words-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Combinatorics_Words-2022-10-27.tar.gz">
                 Oct 27, 2022
               </a>
               : Isabelle2022
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Combinatorics_Words-2021-12-14.tar.gz">
                 Dec 14, 2021
               </a>
               : Isabelle2021-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Combinatorics_Words-2021-05-26.tar.gz">
                 May 26, 2021
               </a>
               : Isabelle2021
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Efficient_Weighted_Path_Order.html b/web/entries/Efficient_Weighted_Path_Order.html
--- a/web/entries/Efficient_Weighted_Path_Order.html
+++ b/web/entries/Efficient_Weighted_Path_Order.html
@@ -1,260 +1,260 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>A Verified Efficient Implementation of the Weighted Path Order - Archive of Formal Proofs</title>
     <meta name="description" content="The Weighted Path Order (WPO) of Yamada is a powerful technique for proving termination. In a previous AFP entry, the WPO was defined and properties of WPO...">
 
   <meta property="og:title" content="A Verified Efficient Implementation of the Weighted Path Order" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Efficient_Weighted_Path_Order.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-06-01T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-06-01T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="A Verified Efficient Implementation of the Weighted Path Order"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>A</span> <span class='first'>V</span>erified <span class='first'>E</span>fficient <span class='first'>I</span>mplementation of the <span class='first'>W</span>eighted <span class='first'>P</span>ath <span class='first'>O</span>rder
     
   </h1>
   <div>
       <p>
         <a href="../authors/thiemann">René Thiemann</a> <a href="http://cl-informatik.uibk.ac.at/users/thiemann/">🌐</a> and <a href="../authors/wenninger">Elias Wenninger</a>
 
       </p>
       <p class="date">June 1, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process"><p>The Weighted Path Order (WPO) of Yamada is a powerful technique for proving
 termination. In a previous AFP entry, the WPO was defined and properties of WPO
 have been formally verified. However, the implementation of WPO was naive,
 leading to an exponential runtime in the worst case.
 </p><p>
 Therefore, in this AFP entry we provide a poly-time implementation of WPO. The
 implementation is based on memoization. Since WPO generalizes the recursive path
 order (RPO), we also easily derive an efficient implementation of RPO.
 </p></div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/logic/rewriting">Logic/Rewriting</a></li>
           <li><a href="../topics/computer-science/algorithms">Computer science/Algorithms</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Thiemann, R., Schöpf, J., Sternagel, C., &amp; Yamada, A. (2020). Certifying the Weighted Path Order (Invited Talk). <i>Schloss Dagstuhl - Leibniz-Zentrum Für Informatik</i>. https://doi.org/10.4230/LIPICS.FSCD.2020.4
+        <li>Thiemann, R., Schöpf, J., Sternagel, C., &amp; Yamada, A. (2020). <i>Certifying the Weighted Path Order (Invited Talk)</i>. Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.FSCD.2020.4
         </li>
         <li>Yamada, A., Kusakari, K., & Sakabe, T. (2015). A unified ordering for termination proving. Science of Computer Programming, 111, 110–134. <a href="https://doi.org/10.1016/j.scico.2014.07.009">https://doi.org/10.1016/j.scico.2014.07.009</a>
 
         </li>
       </ul>
       <h3>Session Efficient_Weighted_Path_Order</h3>
       <ul>
           <li><a href="../sessions/efficient_weighted_path_order/#Indexed_Term">Indexed_Term</a></li>
           <li><a href="../sessions/efficient_weighted_path_order/#List_Memo_Functions">List_Memo_Functions</a></li>
           <li><a href="../sessions/efficient_weighted_path_order/#WPO_Approx">WPO_Approx</a></li>
           <li><a href="../sessions/efficient_weighted_path_order/#WPO_Mem_Impl">WPO_Mem_Impl</a></li>
           <li><a href="../sessions/efficient_weighted_path_order/#RPO_Unbounded">RPO_Unbounded</a></li>
           <li><a href="../sessions/efficient_weighted_path_order/#RPO_Mem_Impl">RPO_Mem_Impl</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Weighted_Path_Order.html">A Formalization of Weighted Path Orders and Recursive Path Orders</a></li>
         </ul>
       </div>
         <div>
           <h3>Auto-related entries</h3>
           <ul class="horizontal-list">
               <li><a href="../entries/Multiset_Ordering_NPC.html">The Generalized Multiset Ordering is NP-Complete</a></li>
               <li><a href="../entries/BD_Security_Compositional.html">Compositional BD Security</a></li>
               <li><a href="../entries/Hales_Jewett.html">The Hales–Jewett Theorem</a></li>
               <li><a href="../entries/Irrationals_From_THEBOOK.html">Irrational numbers from THE BOOK</a></li>
               <li><a href="../entries/Core_SC_DOM.html">The Safely Composable DOM</a></li>
           </ul>
         </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Efficient_Weighted_Path_Order/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Efficient_Weighted_Path_Order/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Efficient_Weighted_Path_Order/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Efficient_Weighted_Path_Order-AFP</p>
         <pre id="copy-text">@article{Efficient_Weighted_Path_Order-AFP,
   author  = {René Thiemann and Elias Wenninger},
   title   = {A Verified Efficient Implementation of the Weighted Path Order},
   journal = {Archive of Formal Proofs},
   month   = {June},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Efficient_Weighted_Path_Order.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Efficient_Weighted_Path_Order-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Efficient_Weighted_Path_Order-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Efficient_Weighted_Path_Order-2023-06-02.tar.gz">
                 Jun 2, 2023
               </a>
               : Isabelle2022
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Frequency_Moments.html b/web/entries/Frequency_Moments.html
--- a/web/entries/Frequency_Moments.html
+++ b/web/entries/Frequency_Moments.html
@@ -1,280 +1,280 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Formalization of Randomized Approximation Algorithms for Frequency Moments - Archive of Formal Proofs</title>
     <meta name="description" content="In 1999 Alon et. al. introduced the still active research topic of approximating the frequency moments of a data stream using randomized algorithms with...">
 
   <meta property="og:title" content="Formalization of Randomized Approximation Algorithms for Frequency Moments" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Frequency_Moments.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2022-04-08T00:00:00+00:00" />
 <meta property="article:modified_time" content="2022-04-08T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Formalization of Randomized Approximation Algorithms for Frequency Moments"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>F</span>ormalization of <span class='first'>R</span>andomized <span class='first'>A</span>pproximation <span class='first'>A</span>lgorithms for <span class='first'>F</span>requency <span class='first'>M</span>oments
     
   </h1>
   <div>
       <p>
         <a href="../authors/karayel">Emin Karayel</a> <a href="https://orcid.org/0000-0003-3290-5034">🌐</a>
 
       </p>
       <p class="date">April 8, 2022</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">In 1999 Alon et. al. introduced the still active research topic of
 approximating the frequency moments of a data stream using randomized
 algorithms with minimal space usage. This includes the problem of
 estimating the cardinality of the stream elements - the zeroth
 frequency moment. But, also higher-order frequency moments that
 provide information about the skew of the data stream. (The
 <i>k</i>-th frequency moment of a data stream is the sum
 of the <i>k</i>-th powers of the occurrence counts of each
 element in the stream.) This entry formalizes three randomized
 algorithms for the approximation of
 <i>F<sub>0</sub></i>,
 <i>F<sub>2</sub></i> and
 <i>F<sub>k</sub></i> for <i>k ≥
 3</i> based on [<a
 href="https://doi.org/10.1006/jcss.1997.1545">1</a>,
 <a
 href="https://doi.org/10.1007/3-540-45726-7_1">2</a>]
 and verifies their expected accuracy, success probability and space
 usage.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/algorithms/approximation">Computer science/Algorithms/Approximation</a></li>
           <li><a href="../topics/computer-science/algorithms/randomized">Computer science/Algorithms/Randomized</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Karayel, E. (2022). Formalization of Randomized Approximation Algorithms for Frequency Moments. <i>Schloss Dagstuhl - Leibniz-Zentrum Für Informatik</i>. https://doi.org/10.4230/LIPICS.ITP.2022.21
+        <li>Karayel, E. (2022). <i>Formalization of Randomized Approximation Algorithms for Frequency Moments</i>. Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.ITP.2022.21
         </li>
       </ul>
       <h3>Session Frequency_Moments</h3>
       <ul>
           <li><a href="../sessions/frequency_moments/#Frequency_Moments_Preliminary_Results">Frequency_Moments_Preliminary_Results</a></li>
           <li><a href="../sessions/frequency_moments/#Frequency_Moments">Frequency_Moments</a></li>
           <li><a href="../sessions/frequency_moments/#K_Smallest">K_Smallest</a></li>
           <li><a href="../sessions/frequency_moments/#Landau_Ext">Landau_Ext</a></li>
           <li><a href="../sessions/frequency_moments/#Probability_Ext">Probability_Ext</a></li>
           <li><a href="../sessions/frequency_moments/#Product_PMF_Ext">Product_PMF_Ext</a></li>
           <li><a href="../sessions/frequency_moments/#Frequency_Moment_0">Frequency_Moment_0</a></li>
           <li><a href="../sessions/frequency_moments/#Frequency_Moment_2">Frequency_Moment_2</a></li>
           <li><a href="../sessions/frequency_moments/#Frequency_Moment_k">Frequency_Moment_k</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Bertrands_Postulate.html">Bertrand&rsquo;s postulate</a></li>
               <li><a href="../entries/Equivalence_Relation_Enumeration.html">Enumeration of Equivalence Relations</a></li>
               <li><a href="../entries/Interpolation_Polynomials_HOL_Algebra.html">Interpolation Polynomials (in HOL-Algebra)</a></li>
               <li><a href="../entries/Lp.html">Lp spaces</a></li>
               <li><a href="../entries/Median_Method.html">Median Method</a></li>
               <li><a href="../entries/Prefix_Free_Code_Combinators.html">A Combinator Library for Prefix-Free Codes</a></li>
               <li><a href="../entries/Universal_Hash_Families.html">Universal Hash Families</a></li>
         </ul>
       </div>
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/Expander_Graphs.html">Expander Graphs</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Frequency_Moments/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Frequency_Moments/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Frequency_Moments/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Frequency_Moments-AFP</p>
         <pre id="copy-text">@article{Frequency_Moments-AFP,
   author  = {Emin Karayel},
   title   = {Formalization of Randomized Approximation Algorithms for Frequency Moments},
   journal = {Archive of Formal Proofs},
   month   = {April},
   year    = {2022},
   note    = {\url{https://isa-afp.org/entries/Frequency_Moments.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Frequency_Moments-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Frequency_Moments-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Frequency_Moments-2022-10-27.tar.gz">
                 Oct 27, 2022
               </a>
               : Isabelle2022
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Frequency_Moments-2022-04-19.tar.gz">
                 Apr 19, 2022
               </a>
               : Isabelle2021-1
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/HoareForDivergence.html b/web/entries/HoareForDivergence.html
--- a/web/entries/HoareForDivergence.html
+++ b/web/entries/HoareForDivergence.html
@@ -1,248 +1,248 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>A Hoare Logic for Diverging Programs - Archive of Formal Proofs</title>
     <meta name="description" content="This submission contains:   a formalisation of a small While language with support for output;  a standard total-correctness Hoare logic that has been...">
 
   <meta property="og:title" content="A Hoare Logic for Diverging Programs" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/HoareForDivergence.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-01-20T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-01-20T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="A Hoare Logic for Diverging Programs"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>A</span> <span class='first'>H</span>oare <span class='first'>L</span>ogic for <span class='first'>D</span>iverging <span class='first'>P</span>rograms
     
   </h1>
   <div>
       <p>
         <a href="../authors/pohjola">Johannes Åman Pohjola</a> <a class="obfuscated" data="eyJob3N0IjpbInVuc3ciLCJlZHUiLCJhdSJdLCJ1c2VyIjpbImoiLCJhbWFucG9oam9sYSJdfQ==">📧</a>, <a href="../authors/myreen">Magnus O. Myreen</a> <a class="obfuscated" data="eyJob3N0IjpbImNoYWxtZXJzIiwic2UiXSwidXNlciI6WyJteXJlZW4iXX0=">📧</a> and <a href="../authors/tanaka">Miki Tanaka</a> <a class="obfuscated" data="eyJob3N0IjpbInVuc3ciLCJlZHUiLCJhdSJdLCJ1c2VyIjpbIm1pa2kiLCJ0YW5ha2EiXX0=">📧</a>
 
       </p>
       <p class="date">January 20, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">This submission contains:
 <ol>
 <li> a formalisation of a small While language with support for output;</li>
 <li> a standard total-correctness Hoare logic that has been proved sound and complete; and</li>
 <li> a new Hoare logic for proofs about programs that diverge: this new logic has also been proved sound and complete.</li>
 </ol></div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/programming-languages/logics">Computer science/Programming languages/Logics</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Åman Pohjola, J., Rostedt, H., &amp; Myreen, M. O. (2019). Characteristic Formulae for Liveness Properties of Non-Terminating CakeML Programs. <i>Schloss Dagstuhl - Leibniz-Zentrum Fuer Informatik GmbH, Wadern/Saarbruecken, Germany</i>. https://doi.org/10.4230/LIPICS.ITP.2019.32
+        <li>Åman Pohjola, J., Rostedt, H., &amp; Myreen, M. O. (2019). <i>Characteristic Formulae for Liveness Properties of Non-Terminating CakeML Programs</i> (Version 1.0). Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.ITP.2019.32
         </li>
       </ul>
       <h3>Session HoareForDivergence</h3>
       <ul>
           <li><a href="../sessions/hoarefordivergence/#MiscLemmas">MiscLemmas</a></li>
           <li><a href="../sessions/hoarefordivergence/#WhileLang">WhileLang</a></li>
           <li><a href="../sessions/hoarefordivergence/#StdLogic">StdLogic</a></li>
           <li><a href="../sessions/hoarefordivergence/#WhileLangLemmas">WhileLangLemmas</a></li>
           <li><a href="../sessions/hoarefordivergence/#StdLogicSoundness">StdLogicSoundness</a></li>
           <li><a href="../sessions/hoarefordivergence/#CoinductiveLemmas">CoinductiveLemmas</a></li>
           <li><a href="../sessions/hoarefordivergence/#DivLogic">DivLogic</a></li>
           <li><a href="../sessions/hoarefordivergence/#StdLogicCompleteness">StdLogicCompleteness</a></li>
           <li><a href="../sessions/hoarefordivergence/#DivLogicCompleteness">DivLogicCompleteness</a></li>
           <li><a href="../sessions/hoarefordivergence/#DivLogicSoundness">DivLogicSoundness</a></li>
           <li><a href="../sessions/hoarefordivergence/#Examples">Examples</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Coinductive.html">Coinductive</a></li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/HoareForDivergence/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/HoareForDivergence/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/HoareForDivergence/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">HoareForDivergence-AFP</p>
         <pre id="copy-text">@article{HoareForDivergence-AFP,
   author  = {Johannes Åman Pohjola and Magnus O. Myreen and Miki Tanaka},
   title   = {A Hoare Logic for Diverging Programs},
   journal = {Archive of Formal Proofs},
   month   = {January},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/HoareForDivergence.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-HoareForDivergence-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-HoareForDivergence-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-HoareForDivergence-2023-01-23.tar.gz">
                 Jan 23, 2023
               </a>
               : Isabelle2022
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/HyperHoareLogic.html b/web/entries/HyperHoareLogic.html
--- a/web/entries/HyperHoareLogic.html
+++ b/web/entries/HyperHoareLogic.html
@@ -1,233 +1,233 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Formalization of Hyper Hoare Logic: A Logic to (Dis-)Prove Program Hyperproperties - Archive of Formal Proofs</title>
     <meta name="description" content="Hoare logics are proof systems that allow one to formally establish properties of computer programs. Traditional Hoare logics prove properties of...">
 
   <meta property="og:title" content="Formalization of Hyper Hoare Logic: A Logic to (Dis-)Prove Program Hyperproperties" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/HyperHoareLogic.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-04-03T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-04-03T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Formalization of Hyper Hoare Logic: A Logic to (Dis-)Prove Program Hyperproperties"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>F</span>ormalization of <span class='first'>H</span>yper <span class='first'>H</span>oare <span class='first'>L</span>ogic: <span class='first'>A</span> <span class='first'>L</span>ogic to (<span class='first'>D</span>is-)<span class='first'>P</span>rove <span class='first'>P</span>rogram <span class='first'>H</span>yperproperties
     
   </h1>
   <div>
       <p>
         <a href="../authors/dardinier">Thibault Dardinier</a> <a class="obfuscated" data="eyJob3N0IjpbImluZiIsImV0aHoiLCJjaCJdLCJ1c2VyIjpbInRoaWJhdWx0IiwiZGFyZGluaWVyIl19">📧</a>
 
       </p>
       <p class="date">April 3, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">Hoare logics are proof systems that allow one to formally establish properties of computer programs. Traditional Hoare logics prove properties of individual program executions (so-called trace properties, such as functional correctness). On the one hand, Hoare logic has been generalized to prove properties of multiple executions of a program (so-called hyperproperties, such as determinism or non-interference). These program logics prove the absence of (bad combinations of) executions. On the other hand, program logics similar to Hoare logic have been proposed to disprove program properties (e.g., Incorrectness Logic [8]), by proving the existence of (bad combinations of) executions. All of these logics have in common that they specify program properties using assertions over a fixed number of states, for instance, a single pre- and post-state for functional properties or pairs of pre- and post-states for non-interference.
 
 In this entry, we formalize Hyper Hoare Logic, a generalization of Hoare logic that lifts assertions to properties of arbitrary sets of states. The resulting logic is simple yet expressive: its judgments can express arbitrary trace- and hyperproperties over the terminating executions of a program. By allowing assertions to reason about sets of states, Hyper Hoare Logic can reason about both the absence and the existence of (combinations of) executions, and, thereby, supports both proving and disproving program (hyper-)properties within the same logic. In fact, we prove that Hyper Hoare Logic subsumes the properties handled by numerous existing correctness and incorrectness logics, and can express hyperproperties that no existing Hoare logic can. We also prove that Hyper Hoare Logic is sound and complete.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/programming-languages/logics">Computer science/Programming languages/Logics</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Dardinier, T., &amp; Müller, P. (2023). <i>Hyper Hoare Logic: (Dis-)Proving Program Hyperproperties (extended version)</i> (Version 2). arXiv. https://doi.org/10.48550/ARXIV.2301.10037
+        <li>Dardinier, T., &amp; Müller, P. (2023). <i>Hyper Hoare Logic: (Dis-)Proving Program Hyperproperties (extended version)</i> (Version 3). arXiv. https://doi.org/10.48550/ARXIV.2301.10037
         </li>
       </ul>
       <h3>Session HyperHoareLogic</h3>
       <ul>
           <li><a href="../sessions/hyperhoarelogic/#Language">Language</a></li>
           <li><a href="../sessions/hyperhoarelogic/#Logic">Logic</a></li>
           <li><a href="../sessions/hyperhoarelogic/#Examples">Examples</a></li>
           <li><a href="../sessions/hyperhoarelogic/#ProgramHyperproperties">ProgramHyperproperties</a></li>
           <li><a href="../sessions/hyperhoarelogic/#Expressivity">Expressivity</a></li>
       </ul>
 
     <div class="flex-wrap">
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/HyperHoareLogic/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/HyperHoareLogic/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/HyperHoareLogic/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">HyperHoareLogic-AFP</p>
         <pre id="copy-text">@article{HyperHoareLogic-AFP,
   author  = {Thibault Dardinier},
   title   = {Formalization of Hyper Hoare Logic: A Logic to (Dis-)Prove Program Hyperproperties},
   journal = {Archive of Formal Proofs},
   month   = {April},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/HyperHoareLogic.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-HyperHoareLogic-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-HyperHoareLogic-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-HyperHoareLogic-2023-04-18.tar.gz">
                 Apr 18, 2023
               </a>
               : Isabelle2022
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Hypergraph_Colourings.html b/web/entries/Hypergraph_Colourings.html
--- a/web/entries/Hypergraph_Colourings.html
+++ b/web/entries/Hypergraph_Colourings.html
@@ -1,231 +1,231 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Hypergraph Colouring Bounds - Archive of Formal Proofs</title>
     <meta name="description" content="This library includes several example applications of the probabilistic method for combinatorics to establish bounds for hypergraph colourings. This...">
 
   <meta property="og:title" content="Hypergraph Colouring Bounds" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Hypergraph_Colourings.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-09-23T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-09-23T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Hypergraph Colouring Bounds"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>H</span>ypergraph <span class='first'>C</span>olouring <span class='first'>B</span>ounds
     
   </h1>
   <div>
       <p>
         <a href="../authors/edmonds">Chelsea Edmonds</a> <a class="obfuscated" data="eyJob3N0IjpbImNhbSIsImFjIiwidWsiXSwidXNlciI6WyJjbGU0NyJdfQ==">📧</a> and <a href="../authors/paulson">Lawrence C. Paulson</a> <a class="obfuscated" data="eyJob3N0IjpbImNhbSIsImFjIiwidWsiXSwidXNlciI6WyJscDE1Il19">📧</a>
 
       </p>
       <p class="date">September 23, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">This library includes several example applications of the probabilistic method for combinatorics to establish bounds for hypergraph colourings. This focuses on Property B - the existence of a two-colouring of the vertex set of a hypergraph. A stricter bound was formalised using the Lov&aacutesz local lemma, which in turn required a surprisingly complex proof of the mutual independence principle for hypergraph edges that is often omitted on paper. The formalisation uncovered several interesting examples of circular intuition on proofs involving independence on paper. The formalisation is based on the textbook proofs from Alon and Spencer's famous textbook, <em>The Probabilistic Method</em>, further supported by notes by Zhao. The mutual independence principle proof is inspired by the less precise proof provided in Molloy and Reed's textbook on graph colourings, as it was omitted in all other sources. Additionally, this library demonstrates how locales can be used to establish a reusable probability space framework, thus minimizing the setup required for future formalisations requiring a probability space on numerous possible properties around an incidence system's vertex set.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/mathematics/combinatorics">Mathematics/Combinatorics</a></li>
           <li><a href="../topics/mathematics/probability-theory">Mathematics/Probability theory</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Molloy, M., & Reed, B. (2002). Graph Colouring and the Probabilistic Method. Algorithms and Combinatorics. <a href="https://doi.org/10.1007/978-3-642-04016-0">https://doi.org/10.1007/978-3-642-04016-0</a>
+        <li>Molloy, M., & Reed, B. (2002). Graph Colouring and the Probabilistic Method. In Algorithms and Combinatorics. Springer Berlin Heidelberg. <a href="https://doi.org/10.1007/978-3-642-04016-0">https://doi.org/10.1007/978-3-642-04016-0</a>
 
         </li>
         <li>https://dl.acm.org/doi/book/10.5555/3002498
         </li>
         <li>https://yufeizhao.com/pm/probmethod_notes.pdf
         </li>
       </ul>
       <h3>Session Hypergraph_Colourings</h3>
       <ul>
           <li><a href="../sessions/hypergraph_colourings/#Hypergraph_Colourings">Hypergraph_Colourings</a></li>
           <li><a href="../sessions/hypergraph_colourings/#Basic_Bounds_Application">Basic_Bounds_Application</a></li>
           <li><a href="../sessions/hypergraph_colourings/#LLL_Applications">LLL_Applications</a></li>
           <li><a href="../sessions/hypergraph_colourings/#Hypergraph_Colourings_Root">Hypergraph_Colourings_Root</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Card_Partitions.html">Cardinality of Set Partitions</a></li>
               <li><a href="../entries/Girth_Chromatic.html">A Probabilistic Proof of the Girth-Chromatic Number Theorem</a></li>
               <li><a href="../entries/Hypergraph_Basics.html">Hypergraphs</a></li>
               <li><a href="../entries/Lovasz_Local.html">General Probabilistic Techniques for Combinatorics and the Lovasz Local Lemma</a></li>
               <li><a href="../entries/Twelvefold_Way.html">The Twelvefold Way</a></li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Hypergraph_Colourings/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Hypergraph_Colourings/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Hypergraph_Colourings/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Hypergraph_Colourings-AFP</p>
         <pre id="copy-text">@article{Hypergraph_Colourings-AFP,
   author  = {Chelsea Edmonds and Lawrence C. Paulson},
   title   = {Hypergraph Colouring Bounds},
   journal = {Archive of Formal Proofs},
   month   = {September},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Hypergraph_Colourings.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Hypergraph_Colourings-current.tar.gz"
          download>Download latest</a>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/List_Update.html b/web/entries/List_Update.html
--- a/web/entries/List_Update.html
+++ b/web/entries/List_Update.html
@@ -1,321 +1,321 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Analysis of List Update Algorithms - Archive of Formal Proofs</title>
     <meta name="description" content=" These theories formalize the quantitative analysis of a number of classical algorithms for the list update problem: 2-competitiveness of move-to-front,...">
 
   <meta property="og:title" content="Analysis of List Update Algorithms" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/List_Update.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2016-02-17T00:00:00+00:00" />
 <meta property="article:modified_time" content="2016-02-17T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Analysis of List Update Algorithms"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>A</span>nalysis of <span class='first'>L</span>ist <span class='first'>U</span>pdate <span class='first'>A</span>lgorithms
     
   </h1>
   <div>
       <p>
         <a href="../authors/haslbeckm">Maximilian P. L. Haslbeck</a> <a href="http://in.tum.de/~haslbema/">🌐</a> and <a href="../authors/nipkow">Tobias Nipkow</a> <a href="https://www.in.tum.de/~nipkow/">🌐</a>
 
       </p>
       <p class="date">February 17, 2016</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process"><p>
 These theories formalize the quantitative analysis of a number of classical algorithms for the list update problem: 2-competitiveness of move-to-front, the lower bound of 2 for the competitiveness of deterministic list update algorithms and 1.6-competitiveness of the randomized COMB algorithm, the best randomized list update algorithm known to date.
 The material is based on the first two chapters of <i>Online Computation
 and Competitive Analysis</i> by Borodin and El-Yaniv.
 </p>
 <p>
 For an informal description see the FSTTCS 2016 publication
 <a href="http://www21.in.tum.de/~nipkow/pubs/fsttcs16.html">Verified Analysis of List Update Algorithms</a>
 by Haslbeck and Nipkow.
 </p></div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/algorithms/online">Computer science/Algorithms/Online</a></li>
           <li><a href="../topics/computer-science/algorithms/randomized">Computer science/Algorithms/Randomized</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Haslbeck, M. P. L., &amp; Nipkow, T. (2016). Verified Analysis of List Update Algorithms. <i>Schloss Dagstuhl - Leibniz-Zentrum Fuer Informatik GmbH, Wadern/Saarbruecken, Germany</i>. https://doi.org/10.4230/LIPICS.FSTTCS.2016.49
+        <li>Haslbeck, M. P. L., &amp; Nipkow, T. (2016). <i>Verified Analysis of List Update Algorithms</i>. Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.FSTTCS.2016.49
         </li>
       </ul>
       <h3>Session List_Update</h3>
       <ul>
           <li><a href="../sessions/list_update/#Inversion">Inversion</a></li>
           <li><a href="../sessions/list_update/#Swaps">Swaps</a></li>
           <li><a href="../sessions/list_update/#On_Off">On_Off</a></li>
           <li><a href="../sessions/list_update/#Prob_Theory">Prob_Theory</a></li>
           <li><a href="../sessions/list_update/#Competitive_Analysis">Competitive_Analysis</a></li>
           <li><a href="../sessions/list_update/#Move_to_Front">Move_to_Front</a></li>
           <li><a href="../sessions/list_update/#Bit_Strings">Bit_Strings</a></li>
           <li><a href="../sessions/list_update/#MTF2_Effects">MTF2_Effects</a></li>
           <li><a href="../sessions/list_update/#BIT">BIT</a></li>
           <li><a href="../sessions/list_update/#Partial_Cost_Model">Partial_Cost_Model</a></li>
           <li><a href="../sessions/list_update/#RExp_Var">RExp_Var</a></li>
           <li><a href="../sessions/list_update/#OPT2">OPT2</a></li>
           <li><a href="../sessions/list_update/#Phase_Partitioning">Phase_Partitioning</a></li>
           <li><a href="../sessions/list_update/#List_Factoring">List_Factoring</a></li>
           <li><a href="../sessions/list_update/#TS">TS</a></li>
           <li><a href="../sessions/list_update/#BIT_pairwise">BIT_pairwise</a></li>
           <li><a href="../sessions/list_update/#BIT_2comp_on2">BIT_2comp_on2</a></li>
           <li><a href="../sessions/list_update/#Comb">Comb</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/List-Index.html">List Index</a></li>
               <li><a href="../entries/Regular-Sets.html">Regular Sets and Expressions</a></li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/List_Update/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/List_Update/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/List_Update/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">List_Update-AFP</p>
         <pre id="copy-text">@article{List_Update-AFP,
   author  = {Maximilian P. L. Haslbeck and Tobias Nipkow},
   title   = {Analysis of List Update Algorithms},
   journal = {Archive of Formal Proofs},
   month   = {February},
   year    = {2016},
   note    = {\url{https://isa-afp.org/entries/List_Update.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-List_Update-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2022-10-27.tar.gz">
                 Oct 27, 2022
               </a>
               : Isabelle2022
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2021-12-14.tar.gz">
                 Dec 14, 2021
               </a>
               : Isabelle2021-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2021-02-23.tar.gz">
                 Feb 23, 2021
               </a>
               : Isabelle2021
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2020-04-20.tar.gz">
                 Apr 20, 2020
               </a>
               : Isabelle2020
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2019-06-11.tar.gz">
                 Jun 11, 2019
               </a>
               : Isabelle2019
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2018-08-16.tar.gz">
                 Aug 16, 2018
               </a>
               : Isabelle2018
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2017-10-10.tar.gz">
                 Oct 10, 2017
               </a>
               : Isabelle2017
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2016-12-17.tar.gz">
                 Dec 17, 2016
               </a>
               : Isabelle2016-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2016-10-15.tar.gz">
                 Oct 15, 2016
               </a>
               : Isabelle2016
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2016-02-23.tar.gz">
                 Feb 23, 2016
               </a>
               : Isabelle2016
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-List_Update-2016-02-22.tar.gz">
                 Feb 22, 2016
               </a>
               : Isabelle2016
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/OmegaCatoidsQuantales.html b/web/entries/OmegaCatoidsQuantales.html
--- a/web/entries/OmegaCatoidsQuantales.html
+++ b/web/entries/OmegaCatoidsQuantales.html
@@ -1,249 +1,249 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Higher Globular Catoids and Quantales - Archive of Formal Proofs</title>
     <meta name="description" content="We formalise strict 2-catoids, 2-categories, 2-Kleene algebras
   and 2-quantales, as well as their omega-variants. Due to
   strictness, the cells of these...">
 
   <meta property="og:title" content="Higher Globular Catoids and Quantales" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/OmegaCatoidsQuantales.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2024-01-24T00:00:00+00:00" />
 <meta property="article:modified_time" content="2024-01-24T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Higher Globular Catoids and Quantales"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>H</span>igher <span class='first'>G</span>lobular <span class='first'>C</span>atoids and <span class='first'>Q</span>uantales
     
   </h1>
   <div>
       <p>
         <a href="../authors/calk">Cameron Calk</a> and <a href="../authors/struth">Georg Struth</a> <a class="obfuscated" data="eyJob3N0IjpbInNoZWZmaWVsZCIsImFjIiwidWsiXSwidXNlciI6WyJnIiwic3RydXRoIl19">📧</a>
 
       </p>
       <p class="date">January 24, 2024</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">We formalise strict 2-catoids, 2-categories, 2-Kleene algebras
   and 2-quantales, as well as their omega-variants. Due to
   strictness, the cells of these higher categories have globular
   shape. We use a single-set approach, generalised to catoids and
   based on type classes. The higher Kleene algebras and quantales
   introduced extend features of modal and concurrent Kleene algebras
   and quantales. They arise for instance as powerset extensions of
   higher catoids, and have been used in algebraic confluence proofs in
   higher-dimensional rewriting. Details are described in two companion
   articles.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/mathematics/category-theory">Mathematics/Category theory</a></li>
           <li><a href="../topics/mathematics/algebra">Mathematics/Algebra</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
         <li>Calk, C., Goubault, E., Malbos, P., & Struth, G. (2022). Algebraic coherent confluence and higher globular Kleene algebras. Logical Methods in Computer Science, Volume 18, Issue 4. https://doi.org/10.46298/lmcs-18(4:9)2022
 
         </li>
-        <li>Calk, C., Malbos, P., Pous, D., &amp; Struth, G. (2023). <i>Higher Catoids, Higher Quantales and their Correspondences</i> (Version 1). arXiv. https://doi.org/10.48550/ARXIV.2307.09253
+        <li>Calk, C., Malbos, P., Pous, D., &amp; Struth, G. (2023). <i>Higher Catoids, Higher Quantales and their Correspondences</i> (Version 2). arXiv. https://doi.org/10.48550/ARXIV.2307.09253
         </li>
       </ul>
       <h3>Session OmegaCatoidsQuantales</h3>
       <ul>
           <li><a href="../sessions/omegacatoidsquantales/#Two_Catoid">Two_Catoid</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Two_Kleene_Algebra">Two_Kleene_Algebra</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Two_Quantale">Two_Quantale</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Two_Catoid_Lifting">Two_Catoid_Lifting</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Two_Catoid_Collapse">Two_Catoid_Collapse</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Omega_Catoid">Omega_Catoid</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Omega_Kleene_Algebra">Omega_Kleene_Algebra</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Omega_Quantale">Omega_Quantale</a></li>
           <li><a href="../sessions/omegacatoidsquantales/#Omega_Catoid_Lifting">Omega_Catoid_Lifting</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Catoids.html">Catoids, Categories, Groupoids</a></li>
         </ul>
       </div>
         <div>
           <h3>Auto-related entries</h3>
           <ul class="horizontal-list">
               <li><a href="../entries/ZFC_in_HOL.html">Zermelo Fraenkel Set Theory in Higher-Order Logic</a></li>
               <li><a href="../entries/Quaternions.html">Quaternions</a></li>
               <li><a href="../entries/Tycon.html">Type Constructor Classes and Monad Transformers</a></li>
           </ul>
         </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/OmegaCatoidsQuantales/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/OmegaCatoidsQuantales/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/OmegaCatoidsQuantales/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">OmegaCatoidsQuantales-AFP</p>
         <pre id="copy-text">@article{OmegaCatoidsQuantales-AFP,
   author  = {Cameron Calk and Georg Struth},
   title   = {Higher Globular Catoids and Quantales},
   journal = {Archive of Formal Proofs},
   month   = {January},
   year    = {2024},
   note    = {\url{https://isa-afp.org/entries/OmegaCatoidsQuantales.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-OmegaCatoidsQuantales-current.tar.gz"
          download>Download latest</a>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Polygonal_Number_Theorem.html b/web/entries/Polygonal_Number_Theorem.html
--- a/web/entries/Polygonal_Number_Theorem.html
+++ b/web/entries/Polygonal_Number_Theorem.html
@@ -1,246 +1,246 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Polygonal Number Theorem - Archive of Formal Proofs</title>
     <meta name="description" content="We formalize the proofs of Cauchy&#39;s and Legendre&#39;s Polygonal Number Theorems given in Melvyn B. Nathanson&#39;s book &#34;Additive Number Theory: The Classical...">
 
   <meta property="og:title" content="Polygonal Number Theorem" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Polygonal_Number_Theorem.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-08-10T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-08-10T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Polygonal Number Theorem"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>P</span>olygonal <span class='first'>N</span>umber <span class='first'>T</span>heorem
     
   </h1>
   <div>
       <p>
         <a href="../authors/leek">Kevin Lee</a> <a class="obfuscated" data="eyJob3N0IjpbImNhbSIsImFjIiwidWsiXSwidXNlciI6WyJrZmtsMiJdfQ==">📧</a>, <a href="../authors/yez">Zhengkun Ye</a> <a class="obfuscated" data="eyJob3N0IjpbImNhbSIsImFjIiwidWsiXSwidXNlciI6WyJ6eTMwNyJdfQ==">📧</a> and <a href="../authors/argyraki">Angeliki Koutsoukou-Argyraki</a> <a class="obfuscated" data="eyJob3N0IjpbImNhbSIsImFjIiwidWsiXSwidXNlciI6WyJhazIxMTAiXX0=">📧</a>
 
       </p>
       <p class="date">August 10, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process"><p>We formalize the proofs of Cauchy's and Legendre's Polygonal Number Theorems given in Melvyn B. Nathanson's book "Additive Number Theory: The Classical Bases".</p>
 
 <p>For $m \geq 1$, the $k$-th polygonal number of order $m+2$ is defined to be $p_m(k)=\frac{mk(k-1)}{2}+k$. The theorems state that:</p>
 
 <p>1. If $m \ge 4$ and $N \geq 108m$, then $N$ can be written as the sum of $m+1$ polygonal numbers of order $m+2$, at most four of which are different from $0$ or $1$. If $N \geq 324$, then $N$ can be written as the sum of five pentagonal numbers, at least one of which is $0$ or $1$.</p>
 
 <p>2. Let $m \geq 3$ and $N \geq 28m^3$. If $m$ is odd, then $N$ is the sum of four polygonal numbers of order $m+2$. If $m$ is even, then $N$ is the sum of five polygonal numbers of order $m+2$, at least one of which is $0$ or $1$.</p>
 
 <p>We also formalize the proof of Gauss's theorem which states that every non-negative integer is the sum of three triangular numbers.</p></div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/mathematics/number-theory">Mathematics/Number theory</a></li>
           <li><a href="../topics/mathematics/combinatorics">Mathematics/Combinatorics</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Nathanson, M. B. (1996). Additive Number Theory. Graduate Texts in Mathematics. <a href="https://doi.org/10.1007/978-1-4757-3845-2">https://doi.org/10.1007/978-1-4757-3845-2</a>
+        <li>Nathanson, M. B. (1996). Additive Number Theory. In Graduate Texts in Mathematics. Springer New York. <a href="https://doi.org/10.1007/978-1-4757-3845-2">https://doi.org/10.1007/978-1-4757-3845-2</a>
 
         </li>
       </ul>
       <h3>Session Polygonal_Number_Theorem</h3>
       <ul>
           <li><a href="../sessions/polygonal_number_theorem/#Polygonal_Number_Theorem_Lemmas">Polygonal_Number_Theorem_Lemmas</a></li>
           <li><a href="../sessions/polygonal_number_theorem/#Polygonal_Number_Theorem_Gauss">Polygonal_Number_Theorem_Gauss</a></li>
           <li><a href="../sessions/polygonal_number_theorem/#Polygonal_Number_Theorem_Cauchy">Polygonal_Number_Theorem_Cauchy</a></li>
           <li><a href="../sessions/polygonal_number_theorem/#Polygonal_Number_Theorem_Legendre">Polygonal_Number_Theorem_Legendre</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Three_Squares.html">Three Squares Theorem</a></li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Polygonal_Number_Theorem/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Polygonal_Number_Theorem/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Polygonal_Number_Theorem/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Polygonal_Number_Theorem-AFP</p>
         <pre id="copy-text">@article{Polygonal_Number_Theorem-AFP,
   author  = {Kevin Lee and Zhengkun Ye and Angeliki Koutsoukou-Argyraki},
   title   = {Polygonal Number Theorem},
   journal = {Archive of Formal Proofs},
   month   = {August},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Polygonal_Number_Theorem.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Polygonal_Number_Theorem-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Polygonal_Number_Theorem-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Polygonal_Number_Theorem-2023-08-11.tar.gz">
                 Aug 11, 2023
               </a>
               : Isabelle2022
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Prim_Dijkstra_Simple.html b/web/entries/Prim_Dijkstra_Simple.html
--- a/web/entries/Prim_Dijkstra_Simple.html
+++ b/web/entries/Prim_Dijkstra_Simple.html
@@ -1,274 +1,274 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra - Archive of Formal Proofs</title>
     <meta name="description" content="We verify purely functional, simple and efficient implementations of Prim&#39;s and Dijkstra&#39;s algorithms. This constitutes the first verification of an...">
 
   <meta property="og:title" content="Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Prim_Dijkstra_Simple.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2019-06-25T00:00:00+00:00" />
 <meta property="article:modified_time" content="2019-06-25T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>P</span>urely <span class='first'>F</span>unctional, <span class='first'>S</span>imple, and <span class='first'>E</span>fficient <span class='first'>I</span>mplementation of <span class='first'>P</span>rim and <span class='first'>D</span>ijkstra
     
   </h1>
   <div>
       <p>
         <a href="../authors/lammich">Peter Lammich</a> <a href="http://www21.in.tum.de/~lammich">🌐</a> and <a href="../authors/nipkow">Tobias Nipkow</a> <a href="https://www.in.tum.de/~nipkow/">🌐</a>
 
       </p>
       <p class="date">June 25, 2019</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">We verify purely functional, simple and efficient implementations of
 Prim's and Dijkstra's algorithms. This constitutes the first
 verification of an executable and even efficient version of
 Prim's algorithm. This entry formalizes the second part of our
 ITP-2019 proof pearl <em>Purely Functional, Simple and Efficient
 Priority Search Trees and Applications to Prim and Dijkstra</em>.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/algorithms/graph">Computer science/Algorithms/Graph</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Lammich, P., &amp; Nipkow, T. (2019). Proof Pearl: Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. <i>Schloss Dagstuhl - Leibniz-Zentrum Fuer Informatik GmbH, Wadern/Saarbruecken, Germany</i>. https://doi.org/10.4230/LIPICS.ITP.2019.23
+        <li>Lammich, P., &amp; Nipkow, T. (2019). <i>Proof Pearl: Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra</i> (Version 1.0). Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.ITP.2019.23
         </li>
       </ul>
       <h3>Session Prim_Dijkstra_Simple</h3>
       <ul>
           <li><a href="../sessions/prim_dijkstra_simple/#Common">Common</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Chapter_Prim">Chapter_Prim</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Undirected_Graph">Undirected_Graph</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Undirected_Graph_Specs">Undirected_Graph_Specs</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Prim_Abstract">Prim_Abstract</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Undirected_Graph_Impl">Undirected_Graph_Impl</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Prim_Impl">Prim_Impl</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Chapter_Dijkstra">Chapter_Dijkstra</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Directed_Graph">Directed_Graph</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Directed_Graph_Specs">Directed_Graph_Specs</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Dijkstra_Abstract">Dijkstra_Abstract</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Directed_Graph_Impl">Directed_Graph_Impl</a></li>
           <li><a href="../sessions/prim_dijkstra_simple/#Dijkstra_Impl">Dijkstra_Impl</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Priority_Search_Trees.html">Priority Search Trees</a></li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Prim_Dijkstra_Simple/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Prim_Dijkstra_Simple/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Prim_Dijkstra_Simple/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Prim_Dijkstra_Simple-AFP</p>
         <pre id="copy-text">@article{Prim_Dijkstra_Simple-AFP,
   author  = {Peter Lammich and Tobias Nipkow},
   title   = {Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra},
   journal = {Archive of Formal Proofs},
   month   = {June},
   year    = {2019},
   note    = {\url{https://isa-afp.org/entries/Prim_Dijkstra_Simple.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-2022-10-27.tar.gz">
                 Oct 27, 2022
               </a>
               : Isabelle2022
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-2021-12-14.tar.gz">
                 Dec 14, 2021
               </a>
               : Isabelle2021-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-2021-02-23.tar.gz">
                 Feb 23, 2021
               </a>
               : Isabelle2021
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-2020-04-20.tar.gz">
                 Apr 20, 2020
               </a>
               : Isabelle2020
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Prim_Dijkstra_Simple-2019-06-29.tar.gz">
                 Jun 29, 2019
               </a>
               : Isabelle2019
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Propositional_Proof_Systems.html b/web/entries/Propositional_Proof_Systems.html
--- a/web/entries/Propositional_Proof_Systems.html
+++ b/web/entries/Propositional_Proof_Systems.html
@@ -1,333 +1,333 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Propositional Proof Systems - Archive of Formal Proofs</title>
     <meta name="description" content="We formalize a range of proof systems for classical propositional
 logic (sequent calculus, natural deduction, Hilbert systems,
 resolution) and prove the...">
 
   <meta property="og:title" content="Propositional Proof Systems" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Propositional_Proof_Systems.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2017-06-21T00:00:00+00:00" />
 <meta property="article:modified_time" content="2017-06-21T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Propositional Proof Systems"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>P</span>ropositional <span class='first'>P</span>roof <span class='first'>S</span>ystems
     
   </h1>
   <div>
       <p>
         <a href="../authors/michaelis">Julius Michaelis</a> <a href="http://liftm.de/">🌐</a> and <a href="../authors/nipkow">Tobias Nipkow</a> <a href="https://www.in.tum.de/~nipkow/">🌐</a>
 
       </p>
       <p class="date">June 21, 2017</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">We formalize a range of proof systems for classical propositional
 logic (sequent calculus, natural deduction, Hilbert systems,
 resolution) and prove the most important meta-theoretic results about
 semantics and proofs: compactness, soundness, completeness,
 translations between proof systems, cut-elimination, interpolation and
 model existence.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/logic/proof-theory">Logic/Proof theory</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Michaelis, J., &amp; Nipkow, T. (2018). Formalized Proof Systems for Propositional Logic. <i>Schloss Dagstuhl - Leibniz-Zentrum Fuer Informatik GmbH, Wadern/Saarbruecken, Germany</i>. https://doi.org/10.4230/LIPICS.TYPES.2017.5
+        <li>Michaelis, J., &amp; Nipkow, T. (2019). <i>Formalized Proof Systems for Propositional Logic</i> (Version 1.0). Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.TYPES.2017.5
         </li>
       </ul>
       <h3>Session Propositional_Proof_Systems</h3>
       <ul>
           <li><a href="../sessions/propositional_proof_systems/#Formulas">Formulas</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Sema">Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Substitution">Substitution</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Substitution_Sema">Substitution_Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#CNF">CNF</a></li>
           <li><a href="../sessions/propositional_proof_systems/#CNF_Formulas">CNF_Formulas</a></li>
           <li><a href="../sessions/propositional_proof_systems/#CNF_Sema">CNF_Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#CNF_Formulas_Sema">CNF_Formulas_Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#CNF_To_Formula">CNF_To_Formula</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Tseytin">Tseytin</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Tseytin_Sema">Tseytin_Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#MiniFormulas">MiniFormulas</a></li>
           <li><a href="../sessions/propositional_proof_systems/#MiniFormulas_Sema">MiniFormulas_Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Consistency">Consistency</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Compactness">Compactness</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Compactness_Consistency">Compactness_Consistency</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Sema_Craig">Sema_Craig</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC">SC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC_Cut">SC_Cut</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC_Depth">SC_Depth</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC_Gentzen">SC_Gentzen</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC_Sema">SC_Sema</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC_Depth_Limit">SC_Depth_Limit</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SC_Compl_Consistency">SC_Compl_Consistency</a></li>
           <li><a href="../sessions/propositional_proof_systems/#ND">ND</a></li>
           <li><a href="../sessions/propositional_proof_systems/#ND_Sound">ND_Sound</a></li>
           <li><a href="../sessions/propositional_proof_systems/#ND_Compl_Truthtable">ND_Compl_Truthtable</a></li>
           <li><a href="../sessions/propositional_proof_systems/#ND_Compl_Truthtable_Compact">ND_Compl_Truthtable_Compact</a></li>
           <li><a href="../sessions/propositional_proof_systems/#HC">HC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#HC_Compl_Consistency">HC_Compl_Consistency</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Resolution">Resolution</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Resolution_Sound">Resolution_Sound</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Resolution_Compl">Resolution_Compl</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Resolution_Compl_Consistency">Resolution_Compl_Consistency</a></li>
           <li><a href="../sessions/propositional_proof_systems/#HCSC">HCSC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#SCND">SCND</a></li>
           <li><a href="../sessions/propositional_proof_systems/#NDHC">NDHC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#HCSCND">HCSCND</a></li>
           <li><a href="../sessions/propositional_proof_systems/#LSC">LSC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#LSC_Resolution">LSC_Resolution</a></li>
           <li><a href="../sessions/propositional_proof_systems/#ND_FiniteAssms">ND_FiniteAssms</a></li>
           <li><a href="../sessions/propositional_proof_systems/#ND_Compl_SC">ND_Compl_SC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Resolution_Compl_SC_Small">Resolution_Compl_SC_Small</a></li>
           <li><a href="../sessions/propositional_proof_systems/#Resolution_Compl_SC_Full">Resolution_Compl_SC_Full</a></li>
           <li><a href="../sessions/propositional_proof_systems/#MiniSC">MiniSC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#MiniSC_HC">MiniSC_HC</a></li>
           <li><a href="../sessions/propositional_proof_systems/#MiniSC_Craig">MiniSC_Craig</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/AI_Planning_Languages_Semantics.html">AI Planning Languages Semantics</a>
             </li>
             <li>
               <a href="../entries/Verified_SAT_Based_AI_Planning.html">Verified SAT-Based AI Planning</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Propositional_Proof_Systems/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Propositional_Proof_Systems/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Propositional_Proof_Systems/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Propositional_Proof_Systems-AFP</p>
         <pre id="copy-text">@article{Propositional_Proof_Systems-AFP,
   author  = {Julius Michaelis and Tobias Nipkow},
   title   = {Propositional Proof Systems},
   journal = {Archive of Formal Proofs},
   month   = {June},
   year    = {2017},
   note    = {\url{https://isa-afp.org/entries/Propositional_Proof_Systems.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2022-10-27.tar.gz">
                 Oct 27, 2022
               </a>
               : Isabelle2022
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2021-12-14.tar.gz">
                 Dec 14, 2021
               </a>
               : Isabelle2021-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2021-02-23.tar.gz">
                 Feb 23, 2021
               </a>
               : Isabelle2021
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2020-04-20.tar.gz">
                 Apr 20, 2020
               </a>
               : Isabelle2020
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2019-06-11.tar.gz">
                 Jun 11, 2019
               </a>
               : Isabelle2019
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2018-08-16.tar.gz">
                 Aug 16, 2018
               </a>
               : Isabelle2018
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2017-10-10.tar.gz">
                 Oct 10, 2017
               </a>
               : Isabelle2017
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Propositional_Proof_Systems-2017-06-22.tar.gz">
                 Jun 22, 2017
               </a>
               : Isabelle2016-1
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Quantales_Converse.html b/web/entries/Quantales_Converse.html
--- a/web/entries/Quantales_Converse.html
+++ b/web/entries/Quantales_Converse.html
@@ -1,262 +1,262 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Modal quantales, involutive quantales, Dedekind Quantales - Archive of Formal Proofs</title>
     <meta name="description" content="This AFP entry provides mathematical components for modal quantales,
   involutive quantales and Dedekind quantales. Modal quantales are
   simple extensions...">
 
   <meta property="og:title" content="Modal quantales, involutive quantales, Dedekind Quantales" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Quantales_Converse.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-07-25T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-07-25T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Modal quantales, involutive quantales, Dedekind Quantales"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>M</span>odal quantales, involutive quantales, <span class='first'>D</span>edekind <span class='first'>Q</span>uantales
     
   </h1>
   <div>
       <p>
         <a href="../authors/struth">Georg Struth</a> <a class="obfuscated" data="eyJob3N0IjpbInNoZWZmaWVsZCIsImFjIiwidWsiXSwidXNlciI6WyJnIiwic3RydXRoIl19">📧</a> and <a href="../authors/calk">Cameron Calk</a>
 
       </p>
       <p class="date">July 25, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">This AFP entry provides mathematical components for modal quantales,
   involutive quantales and Dedekind quantales. Modal quantales are
   simple extensions of modal Kleene algebras useful for the
   verification of recursive programs. Involutive quantales appear in
   the study of C*-algebras. Dedekind quantales are relatives of
   Tarski's relation algebras, hence relevant to program verification
   and beyond that to higher  rewriting. We also provide
   components for weaker variants such as Kleene algebras with converse
   and modal Kleene algebras with converse.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/semantics-and-reasoning">Computer science/Semantics and reasoning</a></li>
           <li><a href="../topics/mathematics/algebra">Mathematics/Algebra</a></li>
           <li><a href="../topics/mathematics/order">Mathematics/Order</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
         <li>Fahrenberg, U., Johansen, C., Struth, G., & Ziemiański, K. (2023). Catoids and modal convolution algebras. Algebra Universalis, 84(2). <a href="https://doi.org/10.1007/s00012-023-00805-9">https://doi.org/10.1007/s00012-023-00805-9</a>
 
         </li>
-        <li>Calk, C., Malbos, P., Pous, D., &amp; Struth, G. (2023). <i>Higher Catoids, Higher Quantales and their Correspondences</i> (Version 1). arXiv. https://doi.org/10.48550/ARXIV.2307.09253
+        <li>Calk, C., Malbos, P., Pous, D., &amp; Struth, G. (2023). <i>Higher Catoids, Higher Quantales and their Correspondences</i> (Version 2). arXiv. https://doi.org/10.48550/ARXIV.2307.09253
         </li>
       </ul>
       <h3>Session Quantales_Converse</h3>
       <ul>
           <li><a href="../sessions/quantales_converse/#Modal_Kleene_Algebra_Var">Modal_Kleene_Algebra_Var</a></li>
           <li><a href="../sessions/quantales_converse/#Kleene_Algebra_Converse">Kleene_Algebra_Converse</a></li>
           <li><a href="../sessions/quantales_converse/#Modal_Kleene_Algebra_Converse">Modal_Kleene_Algebra_Converse</a></li>
           <li><a href="../sessions/quantales_converse/#Modal_Quantale">Modal_Quantale</a></li>
           <li><a href="../sessions/quantales_converse/#Quantale_Converse">Quantale_Converse</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/KAD.html">Kleene Algebras with Domain</a></li>
               <li><a href="../entries/Kleene_Algebra.html">Kleene Algebra</a></li>
               <li><a href="../entries/Quantales.html">Quantales</a></li>
         </ul>
       </div>
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/Catoids.html">Catoids, Categories, Groupoids</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Quantales_Converse/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Quantales_Converse/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Quantales_Converse/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Quantales_Converse-AFP</p>
         <pre id="copy-text">@article{Quantales_Converse-AFP,
   author  = {Georg Struth and Cameron Calk},
   title   = {Modal quantales, involutive quantales, Dedekind Quantales},
   journal = {Archive of Formal Proofs},
   month   = {July},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Quantales_Converse.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Quantales_Converse-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Quantales_Converse-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Quantales_Converse-2023-08-10.tar.gz">
                 Aug 10, 2023
               </a>
               : Isabelle2022
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/S_Finite_Measure_Monad.html b/web/entries/S_Finite_Measure_Monad.html
--- a/web/entries/S_Finite_Measure_Monad.html
+++ b/web/entries/S_Finite_Measure_Monad.html
@@ -1,244 +1,244 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>S-Finite Measure Monad on Quasi-Borel Spaces - Archive of Formal Proofs</title>
     <meta name="description" content="The s-finite measure monad on quasi-Borel spaces provides a suitable denotational model for higher-order probabilistic programs with conditioning. This...">
 
   <meta property="og:title" content="S-Finite Measure Monad on Quasi-Borel Spaces" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/S_Finite_Measure_Monad.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-08-08T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-08-08T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="S-Finite Measure Monad on Quasi-Borel Spaces"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>S</span>-<span class='first'>F</span>inite <span class='first'>M</span>easure <span class='first'>M</span>onad on <span class='first'>Q</span>uasi-<span class='first'>B</span>orel <span class='first'>S</span>paces
     
   </h1>
   <div>
       <p>
         <a href="../authors/hirata">Michikazu Hirata</a> <a class="obfuscated" data="eyJob3N0IjpbIm0iLCJ0aXRlY2giLCJhYyIsImpwIl0sInVzZXIiOlsiaGlyYXRhIiwibSIsImFjIl19">📧</a> and <a href="../authors/minamide">Yasuhiko Minamide</a> <a class="obfuscated" data="eyJob3N0IjpbImlzIiwidGl0ZWNoIiwiYWMiLCJqcCJdLCJ1c2VyIjpbIm1pbmFtaWRlIl19">📧</a>
 
       </p>
       <p class="date">August 8, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">The s-finite measure monad on quasi-Borel spaces provides a suitable denotational model for higher-order probabilistic programs with conditioning. This entry is a formalization of the s-finite measure monad and related notions, including s-finite measures, s-finite kernels, and a proof automation for quasi-Borel spaces which is an extension of our previous entry <a href="https://www.isa-afp.org/entries/Quasi_Borel_Spaces.html"><i>Quasi-Borel Spaces</i></a>. We also implement several examples of probabilistic programs in previous works and prove their property.
 This work is a part of the work by Hirata, Minamide, and Sato, <i>Semantic Foundations of Higher-Order Probabilistic Programs in Isabelle/HOL</i> presented at the 14th Conference on Interactive Theorem Proving (ITP2023).</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/semantics-and-reasoning">Computer science/Semantics and reasoning</a></li>
           <li><a href="../topics/mathematics/measure-and-integration">Mathematics/Measure and integration</a></li>
           <li><a href="../topics/mathematics/probability-theory">Mathematics/Probability theory</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Hirata, M., Minamide, Y., &amp; Sato, T. (2023). Semantic Foundations of Higher-Order Probabilistic Programs in Isabelle/HOL. <i>Schloss Dagstuhl - Leibniz-Zentrum Für Informatik</i>. https://doi.org/10.4230/LIPICS.ITP.2023.18
+        <li>Hirata, M., Minamide, Y., &amp; Sato, T. (2023). <i>Semantic Foundations of Higher-Order Probabilistic Programs in Isabelle/HOL</i>. Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.ITP.2023.18
         </li>
       </ul>
       <h3>Session S_Finite_Measure_Monad</h3>
       <ul>
           <li><a href="../sessions/s_finite_measure_monad/#Lemmas_S_Finite_Measure_Monad">Lemmas_S_Finite_Measure_Monad</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#Kernels">Kernels</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#QuasiBorel">QuasiBorel</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#QBS_Morphism">QBS_Morphism</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#Measure_QuasiBorel_Adjunction">Measure_QuasiBorel_Adjunction</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#Monad_QuasiBorel">Monad_QuasiBorel</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#Montecarlo">Montecarlo</a></li>
           <li><a href="../sessions/s_finite_measure_monad/#Query">Query</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/Standard_Borel_Spaces.html">Standard Borel Spaces</a></li>
         </ul>
       </div>
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/Disintegration.html">Disintegration Theorem</a>
             </li>
         </ul>
       </div>
         <div>
           <h3>Auto-related entries</h3>
           <ul class="horizontal-list">
               <li><a href="../entries/Quasi_Borel_Spaces.html">Quasi-Borel Spaces</a></li>
               <li><a href="../entries/Automated_Stateful_Protocol_Verification.html">Automated Stateful Protocol Verification</a></li>
               <li><a href="../entries/Proof_Strategy_Language.html">Proof Strategy Language</a></li>
           </ul>
         </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/S_Finite_Measure_Monad/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/S_Finite_Measure_Monad/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/S_Finite_Measure_Monad/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">S_Finite_Measure_Monad-AFP</p>
         <pre id="copy-text">@article{S_Finite_Measure_Monad-AFP,
   author  = {Michikazu Hirata and Yasuhiko Minamide},
   title   = {S-Finite Measure Monad on Quasi-Borel Spaces},
   journal = {Archive of Formal Proofs},
   month   = {August},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/S_Finite_Measure_Monad.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-S_Finite_Measure_Monad-current.tar.gz"
          download>Download latest</a>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Simpl.html b/web/entries/Simpl.html
--- a/web/entries/Simpl.html
+++ b/web/entries/Simpl.html
@@ -1,397 +1,402 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment - Archive of Formal Proofs</title>
     <meta name="description" content="We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational...">
 
   <meta property="og:title" content="A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Simpl.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2008-02-29T00:00:00+00:00" />
 <meta property="article:modified_time" content="2008-02-29T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>A</span> <span class='first'>S</span>equential <span class='first'>I</span>mperative <span class='first'>P</span>rogramming <span class='first'>L</span>anguage <span class='first'>S</span>yntax, <span class='first'>S</span>emantics, <span class='first'>H</span>oare <span class='first'>L</span>ogics and <span class='first'>V</span>erification <span class='first'>E</span>nvironment
     
   </h1>
   <div>
       <p>
         <a href="../authors/schirmer">Norbert Schirmer</a>
 
       </p>
       <p class="date">February 29, 2008</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational semantics) and Hoare logics for both partial as well as total correctness. We prove soundness and completeness of the Hoare logic. We integrate and automate the Hoare logic in Isabelle/HOL to obtain a practically usable verification environment for imperative programs. Simpl is independent of a concrete programming language but expressive enough to cover all common language features: mutually recursive procedures, abrupt termination and exceptions, runtime faults, local and global variables, pointers and heap, expressions with side effects, pointers to procedures, partial application and closures, dynamic method invocation and also unbounded nondeterminism.</div>
 
     <h3>License</h3>
     <div>
-        <a href="https://isa-afp.org/LICENSE.LGPL">GNU Lesser General Public License (LGPL)</a>
+        <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
+      <h3>History</h3>
+      <dl>
+        <dt>February 18, 2024</dt>
+        <dd>License change to BSD; more canonical and versatile ML interfaces; some more derived language constructs.</dd>
+      </dl>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/programming-languages/language-definitions">Computer science/Programming languages/Language definitions</a></li>
           <li><a href="../topics/computer-science/programming-languages/logics">Computer science/Programming languages/Logics</a></li>
       </ul>
       <h3>Session Simpl</h3>
       <ul>
           <li><a href="../sessions/simpl/#Language">Language</a></li>
           <li><a href="../sessions/simpl/#Semantic">Semantic</a></li>
           <li><a href="../sessions/simpl/#HoarePartialDef">HoarePartialDef</a></li>
           <li><a href="../sessions/simpl/#HoarePartialProps">HoarePartialProps</a></li>
           <li><a href="../sessions/simpl/#HoarePartial">HoarePartial</a></li>
           <li><a href="../sessions/simpl/#Termination">Termination</a></li>
           <li><a href="../sessions/simpl/#SmallStep">SmallStep</a></li>
           <li><a href="../sessions/simpl/#HoareTotalDef">HoareTotalDef</a></li>
           <li><a href="../sessions/simpl/#HoareTotalProps">HoareTotalProps</a></li>
           <li><a href="../sessions/simpl/#HoareTotal">HoareTotal</a></li>
           <li><a href="../sessions/simpl/#Hoare">Hoare</a></li>
           <li><a href="../sessions/simpl/#StateSpace">StateSpace</a></li>
           <li><a href="../sessions/simpl/#AlternativeSmallStep">AlternativeSmallStep</a></li>
           <li><a href="../sessions/simpl/#Simpl_Heap">Simpl_Heap</a></li>
           <li><a href="../sessions/simpl/#HeapList">HeapList</a></li>
           <li><a href="../sessions/simpl/#Generalise">Generalise</a></li>
           <li><a href="../sessions/simpl/#Vcg">Vcg</a></li>
           <li><a href="../sessions/simpl/#SyntaxTest">SyntaxTest</a></li>
           <li><a href="../sessions/simpl/#VcgEx">VcgEx</a></li>
           <li><a href="../sessions/simpl/#VcgExSP">VcgExSP</a></li>
           <li><a href="../sessions/simpl/#VcgExTotal">VcgExTotal</a></li>
           <li><a href="../sessions/simpl/#Quicksort">Quicksort</a></li>
           <li><a href="../sessions/simpl/#XVcg">XVcg</a></li>
           <li><a href="../sessions/simpl/#XVcgEx">XVcgEx</a></li>
           <li><a href="../sessions/simpl/#ProcParEx">ProcParEx</a></li>
           <li><a href="../sessions/simpl/#ProcParExSP">ProcParExSP</a></li>
           <li><a href="../sessions/simpl/#Closure">Closure</a></li>
           <li><a href="../sessions/simpl/#ClosureEx">ClosureEx</a></li>
           <li><a href="../sessions/simpl/#Compose">Compose</a></li>
           <li><a href="../sessions/simpl/#ComposeEx">ComposeEx</a></li>
           <li><a href="../sessions/simpl/#UserGuide">UserGuide</a></li>
           <li><a href="../sessions/simpl/#Simpl">Simpl</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/Planarity_Certificates.html">Planarity Certificates</a>
             </li>
             <li>
               <a href="../entries/BDD.html">BDD Normalisation</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Simpl/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Simpl/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Simpl/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Simpl-AFP</p>
         <pre id="copy-text">@article{Simpl-AFP,
   author  = {Norbert Schirmer},
   title   = {A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment},
   journal = {Archive of Formal Proofs},
   month   = {February},
   year    = {2008},
   note    = {\url{https://isa-afp.org/entries/Simpl.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Simpl-current.tar.gz"
          download>Download latest</a>
         <p>Older releases:</p>
         <ul>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2023-09-13.tar.gz">
                 Sep 13, 2023
               </a>
               : Isabelle2023
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2022-10-27.tar.gz">
                 Oct 27, 2022
               </a>
               : Isabelle2022
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2021-12-14.tar.gz">
                 Dec 14, 2021
               </a>
               : Isabelle2021-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2021-02-23.tar.gz">
                 Feb 23, 2021
               </a>
               : Isabelle2021
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2020-04-20.tar.gz">
                 Apr 20, 2020
               </a>
               : Isabelle2020
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2019-06-11.tar.gz">
                 Jun 11, 2019
               </a>
               : Isabelle2019
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2018-08-16.tar.gz">
                 Aug 16, 2018
               </a>
               : Isabelle2018
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2017-10-10.tar.gz">
                 Oct 10, 2017
               </a>
               : Isabelle2017
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2016-12-17.tar.gz">
                 Dec 17, 2016
               </a>
               : Isabelle2016-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2016-02-22.tar.gz">
                 Feb 22, 2016
               </a>
               : Isabelle2016
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2015-05-27.tar.gz">
                 May 27, 2015
               </a>
               : Isabelle2015
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2014-08-28.tar.gz">
                 Aug 28, 2014
               </a>
               : Isabelle2014
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2013-12-11.tar.gz">
                 Dec 11, 2013
               </a>
               : Isabelle2013-2
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2013-11-17.tar.gz">
                 Nov 17, 2013
               </a>
               : Isabelle2013-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2013-02-16.tar.gz">
                 Feb 16, 2013
               </a>
               : Isabelle2013
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2012-05-24.tar.gz">
                 May 24, 2012
               </a>
               : Isabelle2012
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2011-10-11.tar.gz">
                 Oct 11, 2011
               </a>
               : Isabelle2011-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2011-02-11.tar.gz">
                 Feb 11, 2011
               </a>
               : Isabelle2011
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2010-07-01.tar.gz">
                 Jul 1, 2010
               </a>
               : Isabelle2009-2
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2009-12-12.tar.gz">
                 Dec 12, 2009
               </a>
               : Isabelle2009-1
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2009-09-12.tar.gz">
                 Sep 12, 2009
               </a>
               : Isabelle2009
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2009-04-29.tar.gz">
                 Apr 29, 2009
               </a>
               : Isabelle2009
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2008-06-10.tar.gz">
                 Jun 10, 2008
               </a>
               : Isabelle2008
             </li>
             <li>
               <a href="https://www.isa-afp.org/release/afp-Simpl-2008-03-07.tar.gz">
                 Mar 7, 2008
               </a>
               : Isabelle2007
             </li>
         </ul>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Standard_Borel_Spaces.html b/web/entries/Standard_Borel_Spaces.html
--- a/web/entries/Standard_Borel_Spaces.html
+++ b/web/entries/Standard_Borel_Spaces.html
@@ -1,229 +1,229 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Standard Borel Spaces - Archive of Formal Proofs</title>
     <meta name="description" content="This entry includes a formalization of standard Borel spaces and (a variant of) the Borel isomorphism theorem. A separable complete metrizable topological...">
 
   <meta property="og:title" content="Standard Borel Spaces" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Standard_Borel_Spaces.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-08-08T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-08-08T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Standard Borel Spaces"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>S</span>tandard <span class='first'>B</span>orel <span class='first'>S</span>paces
     
   </h1>
   <div>
       <p>
         <a href="../authors/hirata">Michikazu Hirata</a> <a class="obfuscated" data="eyJob3N0IjpbIm0iLCJ0aXRlY2giLCJhYyIsImpwIl0sInVzZXIiOlsiaGlyYXRhIiwibSIsImFjIl19">📧</a>
 
       </p>
       <p class="date">August 8, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">This entry includes a formalization of standard Borel spaces and (a variant of) the Borel isomorphism theorem. A separable complete metrizable topological space is called a polish space and a measurable space generated from a polish space is called a standard Borel space. We formalize the notion of standard Borel spaces by establishing set-based metric spaces, and then prove (a variant of) the Borel isomorphism theorem. The theorem states that a standard Borel spaces is either a countable discrete space or isomorphic to $\mathbb{R}$.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/mathematics/analysis">Mathematics/Analysis</a></li>
           <li><a href="../topics/mathematics/topology">Mathematics/Topology</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Hirata, M., Minamide, Y., &amp; Sato, T. (2023). Semantic Foundations of Higher-Order Probabilistic Programs in Isabelle/HOL. <i>Schloss Dagstuhl - Leibniz-Zentrum Für Informatik</i>. https://doi.org/10.4230/LIPICS.ITP.2023.18
+        <li>Hirata, M., Minamide, Y., &amp; Sato, T. (2023). <i>Semantic Foundations of Higher-Order Probabilistic Programs in Isabelle/HOL</i>. Schloss Dagstuhl – Leibniz-Zentrum für Informatik. https://doi.org/10.4230/LIPICS.ITP.2023.18
         </li>
       </ul>
       <h3>Session Standard_Borel_Spaces</h3>
       <ul>
           <li><a href="../sessions/standard_borel_spaces/#Lemmas_StandardBorel">Lemmas_StandardBorel</a></li>
           <li><a href="../sessions/standard_borel_spaces/#Set_Based_Metric_Space">Set_Based_Metric_Space</a></li>
           <li><a href="../sessions/standard_borel_spaces/#Set_Based_Metric_Product">Set_Based_Metric_Product</a></li>
           <li><a href="../sessions/standard_borel_spaces/#Abstract_Metrizable_Topology">Abstract_Metrizable_Topology</a></li>
           <li><a href="../sessions/standard_borel_spaces/#StandardBorel">StandardBorel</a></li>
           <li><a href="../sessions/standard_borel_spaces/#Space_of_Continuous_Maps">Space_of_Continuous_Maps</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Used by</h3>
         <ul class="horizontal-list">
             <li>
               <a href="../entries/Disintegration.html">Disintegration Theorem</a>
             </li>
             <li>
               <a href="../entries/S_Finite_Measure_Monad.html">S-Finite Measure Monad on Quasi-Borel Spaces</a>
             </li>
         </ul>
       </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Standard_Borel_Spaces/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Standard_Borel_Spaces/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Standard_Borel_Spaces/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Standard_Borel_Spaces-AFP</p>
         <pre id="copy-text">@article{Standard_Borel_Spaces-AFP,
   author  = {Michikazu Hirata},
   title   = {Standard Borel Spaces},
   journal = {Archive of Formal Proofs},
   month   = {August},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Standard_Borel_Spaces.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Standard_Borel_Spaces-current.tar.gz"
          download>Download latest</a>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/entries/Transport.html b/web/entries/Transport.html
--- a/web/entries/Transport.html
+++ b/web/entries/Transport.html
@@ -1,350 +1,350 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Transport via Partial Galois Connections and Equivalences - Archive of Formal Proofs</title>
     <meta name="description" content="This entry contains the accompanying formalisation of the paper &#34;Transport via Partial Galois Connections and Equivalences&#34; (APLAS 2023). It contains a...">
 
   <meta property="og:title" content="Transport via Partial Galois Connections and Equivalences" />
 <meta property="og:description" content="" />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/entries/Transport.html" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="entries" />
 <meta property="article:published_time" content="2023-10-11T00:00:00+00:00" />
 <meta property="article:modified_time" content="2023-10-11T00:00:00+00:00" /><meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Transport via Partial Galois Connections and Equivalences"/>
 <meta name="twitter:description" content=""/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
     
     <script>
       MathJax = {
         tex: {
           inlineMath: [['$', '$'], ['\\(', '\\)']]
         },
         processEscapes: true,
         svg: {
           fontCache: 'global'
         }
       };
     </script>
     <script id="MathJax-script" async src="../js/mathjax/es5/tex-mml-chtml.js">
     </script>
     <script src="../js/entries.js"></script>
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content entries'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>T</span>ransport via <span class='first'>P</span>artial <span class='first'>G</span>alois <span class='first'>C</span>onnections and <span class='first'>E</span>quivalences
     
   </h1>
   <div>
       <p>
         <a href="../authors/kappelmann">Kevin Kappelmann</a> <a class="obfuscated" data="eyJob3N0IjpbInR1bSIsImRlIl0sInVzZXIiOlsia2V2aW4iLCJrYXBwZWxtYW5uIl19">📧</a>
 
       </p>
       <p class="date">October 11, 2023</p>
   </div>
 </header>
       <div>
         
   <main>
     <h3>Abstract</h3>
 
     <div class="abstract mathjax_process">This entry contains the accompanying formalisation of the paper
 <a href="https://conf.researchr.org/details/aplas-2023/aplas-2023-research-papers/15/Transport-via-Partial-Galois-Connections-and-Equivalences">"Transport via Partial Galois Connections and Equivalences" (APLAS 2023)</a>.
 It contains a theoretical framework to transport programs via equivalences,
 subsuming the theory of <a href="https://doi.org/10.1007/978-3-319-03545-1_9">Isabelle's Lifting package</a>.
 It also contains a prototype to automate transports using this framework in Isabelle/HOL,
 but this prototype is not yet ready for production.
 Finally, it contains a library on top of Isabelle/HOL's axioms,
 including various relativised concepts on orders, functions, binary relations,
 and Galois connections and equivalences.</div>
 
     <h3>License</h3>
     <div>
         <a href="https://isa-afp.org/LICENSE">BSD License</a>
     </div>
       <h3>Topics</h3>
       <ul>
           <li><a href="../topics/computer-science/programming-languages/lambda-calculi">Computer science/Programming languages/Lambda calculi</a></li>
           <li><a href="../topics/computer-science/programming-languages/type-systems">Computer science/Programming languages/Type systems</a></li>
           <li><a href="../topics/computer-science/semantics-and-reasoning">Computer science/Semantics and reasoning</a></li>
           <li><a href="../topics/mathematics/order">Mathematics/Order</a></li>
       </ul>
       <h3>Related publications</h3>
       <ul>
-        <li>Kappelmann, K. (2023). <i>Transport via Partial Galois Connections and Equivalences</i> (Version 4). arXiv. https://doi.org/10.48550/ARXIV.2303.05244
+        <li>Kappelmann, K. (2023). Transport via Partial Galois Connections and Equivalences. <i>ArXiv</i>. https://doi.org/10.48550/ARXIV.2303.05244
         </li>
       </ul>
       <h3>Session Transport</h3>
       <ul>
           <li><a href="../sessions/transport/#HOL_Basics_Base">HOL_Basics_Base</a></li>
           <li><a href="../sessions/transport/#Binary_Relation_Functions">Binary_Relation_Functions</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Order_Base">Binary_Relations_Order_Base</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Lattice">Binary_Relations_Lattice</a></li>
           <li><a href="../sessions/transport/#Functions_Base">Functions_Base</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles_Lattices">HOL_Syntax_Bundles_Lattices</a></li>
           <li><a href="../sessions/transport/#Predicates_Lattice">Predicates_Lattice</a></li>
           <li><a href="../sessions/transport/#Function_Relators">Function_Relators</a></li>
           <li><a href="../sessions/transport/#Predicates_Order">Predicates_Order</a></li>
           <li><a href="../sessions/transport/#Predicates">Predicates</a></li>
           <li><a href="../sessions/transport/#Functions_Monotone">Functions_Monotone</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Reflexive">Binary_Relations_Reflexive</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Symmetric">Binary_Relations_Symmetric</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Transitive">Binary_Relations_Transitive</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Order">Binary_Relations_Order</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Antisymmetric">Binary_Relations_Antisymmetric</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Injective">Binary_Relations_Injective</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Irreflexive">Binary_Relations_Irreflexive</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Left_Total">Binary_Relations_Left_Total</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Right_Unique">Binary_Relations_Right_Unique</a></li>
           <li><a href="../sessions/transport/#Binary_Relations_Surjective">Binary_Relations_Surjective</a></li>
           <li><a href="../sessions/transport/#Binary_Relation_Properties">Binary_Relation_Properties</a></li>
           <li><a href="../sessions/transport/#Preorders">Preorders</a></li>
           <li><a href="../sessions/transport/#Partial_Equivalence_Relations">Partial_Equivalence_Relations</a></li>
           <li><a href="../sessions/transport/#Equivalence_Relations">Equivalence_Relations</a></li>
           <li><a href="../sessions/transport/#Partial_Orders">Partial_Orders</a></li>
           <li><a href="../sessions/transport/#Restricted_Equality">Restricted_Equality</a></li>
           <li><a href="../sessions/transport/#LBinary_Relations">LBinary_Relations</a></li>
           <li><a href="../sessions/transport/#Functions_Injective">Functions_Injective</a></li>
           <li><a href="../sessions/transport/#Functions_Inverse">Functions_Inverse</a></li>
           <li><a href="../sessions/transport/#Functions_Bijection">Functions_Bijection</a></li>
           <li><a href="../sessions/transport/#Functions_Surjective">Functions_Surjective</a></li>
           <li><a href="../sessions/transport/#Function_Properties">Function_Properties</a></li>
           <li><a href="../sessions/transport/#LFunctions">LFunctions</a></li>
           <li><a href="../sessions/transport/#Order_Functions_Base">Order_Functions_Base</a></li>
           <li><a href="../sessions/transport/#Order_Functors_Base">Order_Functors_Base</a></li>
           <li><a href="../sessions/transport/#Galois_Base">Galois_Base</a></li>
           <li><a href="../sessions/transport/#Galois_Relator_Base">Galois_Relator_Base</a></li>
           <li><a href="../sessions/transport/#Order_Equivalences">Order_Equivalences</a></li>
           <li><a href="../sessions/transport/#Half_Galois_Property">Half_Galois_Property</a></li>
           <li><a href="../sessions/transport/#Galois_Property">Galois_Property</a></li>
           <li><a href="../sessions/transport/#Galois_Connections">Galois_Connections</a></li>
           <li><a href="../sessions/transport/#Galois_Equivalences">Galois_Equivalences</a></li>
           <li><a href="../sessions/transport/#Galois_Relator">Galois_Relator</a></li>
           <li><a href="../sessions/transport/#Galois">Galois</a></li>
           <li><a href="../sessions/transport/#Closure_Operators">Closure_Operators</a></li>
           <li><a href="../sessions/transport/#Order_Functions">Order_Functions</a></li>
           <li><a href="../sessions/transport/#Order_Functors">Order_Functors</a></li>
           <li><a href="../sessions/transport/#Orders">Orders</a></li>
           <li><a href="../sessions/transport/#HOL_Basics">HOL_Basics</a></li>
           <li><a href="../sessions/transport/#HOL_Mem_Of">HOL_Mem_Of</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles_Relations">HOL_Syntax_Bundles_Relations</a></li>
           <li><a href="../sessions/transport/#HOL_Alignment_Binary_Relations">HOL_Alignment_Binary_Relations</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles_Functions">HOL_Syntax_Bundles_Functions</a></li>
           <li><a href="../sessions/transport/#HOL_Alignment_Functions">HOL_Alignment_Functions</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles_Orders">HOL_Syntax_Bundles_Orders</a></li>
           <li><a href="../sessions/transport/#HOL_Alignment_Orders">HOL_Alignment_Orders</a></li>
           <li><a href="../sessions/transport/#HOL_Alignments">HOL_Alignments</a></li>
           <li><a href="../sessions/transport/#HOL_Algebra_Alignment_Orders">HOL_Algebra_Alignment_Orders</a></li>
           <li><a href="../sessions/transport/#HOL_Algebra_Alignment_Galois">HOL_Algebra_Alignment_Galois</a></li>
           <li><a href="../sessions/transport/#HOL_Algebra_Alignments">HOL_Algebra_Alignments</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles_Base">HOL_Syntax_Bundles_Base</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles_Groups">HOL_Syntax_Bundles_Groups</a></li>
           <li><a href="../sessions/transport/#HOL_Syntax_Bundles">HOL_Syntax_Bundles</a></li>
           <li><a href="../sessions/transport/#Transport_Base">Transport_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Bijections">Transport_Bijections</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Base">Transport_Compositions_Agree_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Monotone">Transport_Compositions_Agree_Monotone</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Galois_Property">Transport_Compositions_Agree_Galois_Property</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Galois_Connection">Transport_Compositions_Agree_Galois_Connection</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Galois_Equivalence">Transport_Compositions_Agree_Galois_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Galois_Relator">Transport_Compositions_Agree_Galois_Relator</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree_Order_Equivalence">Transport_Compositions_Agree_Order_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Agree">Transport_Compositions_Agree</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Base">Transport_Compositions_Generic_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Galois_Property">Transport_Compositions_Generic_Galois_Property</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Monotone">Transport_Compositions_Generic_Monotone</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Galois_Connection">Transport_Compositions_Generic_Galois_Connection</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Galois_Equivalence">Transport_Compositions_Generic_Galois_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Galois_Relator">Transport_Compositions_Generic_Galois_Relator</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Order_Base">Transport_Compositions_Generic_Order_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic_Order_Equivalence">Transport_Compositions_Generic_Order_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions_Generic">Transport_Compositions_Generic</a></li>
           <li><a href="../sessions/transport/#Transport_Compositions">Transport_Compositions</a></li>
           <li><a href="../sessions/transport/#Reflexive_Relator">Reflexive_Relator</a></li>
           <li><a href="../sessions/transport/#Monotone_Function_Relator">Monotone_Function_Relator</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Base">Transport_Functions_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Monotone">Transport_Functions_Monotone</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Galois_Property">Transport_Functions_Galois_Property</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Galois_Connection">Transport_Functions_Galois_Connection</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Order_Base">Transport_Functions_Order_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Galois_Equivalence">Transport_Functions_Galois_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Relation_Simplifications">Transport_Functions_Relation_Simplifications</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Galois_Relator">Transport_Functions_Galois_Relator</a></li>
           <li><a href="../sessions/transport/#Transport_Functions_Order_Equivalence">Transport_Functions_Order_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Functions">Transport_Functions</a></li>
           <li><a href="../sessions/transport/#Transport_Identity">Transport_Identity</a></li>
           <li><a href="../sessions/transport/#Transport">Transport</a></li>
           <li><a href="../sessions/transport/#Transport_Natural_Functors_Base">Transport_Natural_Functors_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Natural_Functors_Galois">Transport_Natural_Functors_Galois</a></li>
           <li><a href="../sessions/transport/#Transport_Natural_Functors_Galois_Relator">Transport_Natural_Functors_Galois_Relator</a></li>
           <li><a href="../sessions/transport/#Transport_Natural_Functors_Order_Base">Transport_Natural_Functors_Order_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Natural_Functors_Order_Equivalence">Transport_Natural_Functors_Order_Equivalence</a></li>
           <li><a href="../sessions/transport/#Transport_Natural_Functors">Transport_Natural_Functors</a></li>
           <li><a href="../sessions/transport/#Transport_Rel_If">Transport_Rel_If</a></li>
           <li><a href="../sessions/transport/#Transport_Prototype">Transport_Prototype</a></li>
           <li><a href="../sessions/transport/#Transport_Syntax">Transport_Syntax</a></li>
           <li><a href="../sessions/transport/#Transport_Dep_Fun_Rel_Examples">Transport_Dep_Fun_Rel_Examples</a></li>
           <li><a href="../sessions/transport/#Transport_Lists_Sets_Examples">Transport_Lists_Sets_Examples</a></li>
           <li><a href="../sessions/transport/#Transport_Partial_Quotient_Types">Transport_Partial_Quotient_Types</a></li>
           <li><a href="../sessions/transport/#Transport_Typedef_Base">Transport_Typedef_Base</a></li>
           <li><a href="../sessions/transport/#Transport_Typedef">Transport_Typedef</a></li>
           <li><a href="../sessions/transport/#Transport_Via_Partial_Galois_Connections_Equivalences_Paper">Transport_Via_Partial_Galois_Connections_Equivalences_Paper</a></li>
       </ul>
 
     <div class="flex-wrap">
       <div>
         <h3>Depends on</h3>
         <ul class="horizontal-list">
               <li><a href="../entries/ML_Unification.html">Unification Utilities for Isabelle/ML</a></li>
         </ul>
       </div>
         <div>
           <h3>Auto-related entries</h3>
           <ul class="horizontal-list">
               <li><a href="../entries/Order_Lattice_Props.html">Properties of Orderings and Lattices</a></li>
               <li><a href="../entries/KAD.html">Kleene Algebras with Domain</a></li>
               <li><a href="../entries/Multirelations.html">Binary Multirelations</a></li>
               <li><a href="../entries/Relation_Algebra.html">Relation Algebra</a></li>
           </ul>
         </div>
       </div>
     
   </main>
 
   <nav class='links'>
     <a class='popup-button' href="#cite-popup">Cite</a>
     <a class='popup-button' href="#download-popup">Download</a>
     <h4>PDFs</h4>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Transport/outline.pdf">Proof outline</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Transport/document.pdf">Proof document</a>
     <a href="https://www.isa-afp.org/browser_info/current/AFP/Transport/session_graph.pdf">Dependencies</a>
   </nav>
 
   <div id="cite-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Cite</h2>
       <a class="close" href="#">&times;</a>
       <div>
         <p style="display:none;" id="bibtex-filename">Transport-AFP</p>
         <pre id="copy-text">@article{Transport-AFP,
   author  = {Kevin Kappelmann},
   title   = {Transport via Partial Galois Connections and Equivalences},
   journal = {Archive of Formal Proofs},
   month   = {October},
   year    = {2023},
   note    = {\url{https://isa-afp.org/entries/Transport.html},
              Formal proof development},
   ISSN    = {2150-914x},
 }</pre>
         <button id="copy-bibtex">Copy</button> <a id="download-bibtex">Download</a>
       </div>
     </div>
   </div>
 
   <div id="download-popup" class="overlay">
     <a class="cancel" href="#"></a>
     <div class="popup">
       <h2>Download</h2>
       <a class="close" href="#">&times;</a>
       <a href="https://www.isa-afp.org/release/afp-Transport-current.tar.gz"
          download>Download latest</a>
     </div>
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file
diff --git a/web/statistics/index.html b/web/statistics/index.html
--- a/web/statistics/index.html
+++ b/web/statistics/index.html
@@ -1,383 +1,383 @@
 <!DOCTYPE html>
 <html lang="en">
   <head>
   <meta charset="utf-8" />
   <meta http-equiv="X-UA-Compatible" content="IE=edge">
   <meta name="viewport" content="width=device-width, initial-scale=1">
     <title>Statistics - Archive of Formal Proofs</title>
     <meta name="description" content="A collection of proof libraries, examples, and larger
      scientific developments, mechanically checked in the theorem prover Isabelle.">
 
   <meta property="og:title" content="Statistics" />
-<meta property="og:description" content="798 Entries   475 Authors   ~252,000  Lemmas   ~4,087,700  Lines of Code   Most used AFP entries:   Name Used by ? entries   1. List-Index 23   2. Collections 19   3. Show 16   4. Jordan_Normal_Form 15   5. Deriving 14   6. Coinductive 13   7. Polynomial_Factorization 12   8." />
+<meta property="og:description" content="798 Entries   475 Authors   ~252,100  Lemmas   ~4,088,600  Lines of Code   Most used AFP entries:   Name Used by ? entries   1. List-Index 23   2. Collections 19   3. Show 16   4. Jordan_Normal_Form 15   5. Deriving 14   6. Coinductive 13   7. Polynomial_Factorization 12   8." />
 <meta property="og:type" content="article" />
 <meta property="og:url" content="/statistics/" /><meta property="og:image" content="/images/afp.png"/><meta property="article:section" content="" />
 
 <meta property="og:site_name" content="Archive of Formal Proofs" />
 
 
   <meta name="twitter:card" content="summary_large_image"/>
 <meta name="twitter:image" content="/images/afp.png"/>
 
 <meta name="twitter:title" content="Statistics"/>
-<meta name="twitter:description" content="798 Entries   475 Authors   ~252,000  Lemmas   ~4,087,700  Lines of Code   Most used AFP entries:   Name Used by ? entries   1. List-Index 23   2. Collections 19   3. Show 16   4. Jordan_Normal_Form 15   5. Deriving 14   6. Coinductive 13   7. Polynomial_Factorization 12   8."/>
+<meta name="twitter:description" content="798 Entries   475 Authors   ~252,100  Lemmas   ~4,088,600  Lines of Code   Most used AFP entries:   Name Used by ? entries   1. List-Index 23   2. Collections 19   3. Show 16   4. Jordan_Normal_Form 15   5. Deriving 14   6. Coinductive 13   7. Polynomial_Factorization 12   8."/>
 
   <link rel="stylesheet" type="text/css" href="../css/front.min.css">
 
   <link rel="icon" href="../images/favicon.ico" type="image/icon">
 
   <script src="../js/obfuscate.js"></script>
   <script src="../js/flexsearch.bundle.js"></script>
   <script src="../js/scroll-spy.js"></script>
   <script src="../js/theory.js"></script>
   <script src="../js/util.js"></script>
     <script src="../js/header-search.js"></script>
   <script src="../js/search-autocomplete.js"></script>
 </head>
 
   <body class='mathjax_ignore'>
     <aside>
         <div id="menu-toggle">
   <input id="toggle" type="checkbox" />
   <label for="toggle">
     <span>menu</span>
     <img src="../images/menu.svg" alt="Menu" />
   </label>
 
   <a href="../" class="logo-link">
     <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
          class="logo">
   </a>
 
   <nav id="menu">
     <div>
       <a href="../" class='logo-link'>
         <img src="../images/afp.png" alt="Logo of the Archive of Formal Proofs"
              class="logo">
       </a>
       <ul>
           <a href="../">
             <li >
               Home
             </li>
           </a>
           <a href="../topics/">
             <li >
               Topics
             </li>
           </a>
           <a href="../download/">
             <li >
               Download
             </li>
           </a>
           <a href="../help/">
             <li >
               Help
             </li>
           </a>
           <a href="../submission/">
             <li >
               Submission
             </li>
           </a>
           <a href="../statistics/">
             <li class="active" >
               Statistics
             </li>
           </a>
           <a href="../about/">
             <li >
               About
             </li>
           </a>
       </ul>
     </div>
   </nav>
 </div>
     </aside>
     <div class='content'>
       <header>
     <form autocomplete="off" action="../search">
       <div class='form-container'>
         <input id="search-input" type="search" size="31" maxlength="255" value=""
                aria-label="Search the AFP" list="autocomplete"><button
                id="search-button" type="button">
           <img src="../images/search.svg" alt="Search"/>
         </button>
         <datalist id="autocomplete">
         </datalist>
       </div>
     </form>
   <h1>
     <span class='first'>S</span>tatistics
     
   </h1>
   <div>
   </div>
 </header>
       <div>
         
   <div>
     <table>
   <tr>
     <td class="statsnumber">798</td>
     <td><a href="../">Entries</a></td>
   </tr>
   <tr>
     <td class="statsnumber">475</td>
     <td><a href="../authors/">Authors</a></td>
   </tr>
   <tr>
     <td class="statsnumber">
-      ~252,000
+      ~252,100
     </td>
     <td>Lemmas</td>
   </tr>
   <tr>
     <td class="statsnumber">
-      ~4,087,700
+      ~4,088,600
     </td>
     <td>Lines of Code</td>
   </tr>
 </table>
 
 <h4>Most used AFP entries:</h4>
 <table id="most_used">
   <tr>
     <th></th>
     <th>Name</th>
     <th>Used by ? entries</th>
   </tr>
 
   
   <tr>
     <td>1.</td>
     <td><a href="../entries/List-Index.html">List-Index</a></td>
     <td><a href="../dependencies/list-index/">23</a></td>
   </tr>
   
   <tr>
     <td>2.</td>
     <td><a href="../entries/Collections.html">Collections</a></td>
     <td><a href="../dependencies/collections/">19</a></td>
   </tr>
   
   <tr>
     <td>3.</td>
     <td><a href="../entries/Show.html">Show</a></td>
     <td><a href="../dependencies/show/">16</a></td>
   </tr>
   
   <tr>
     <td>4.</td>
     <td><a href="../entries/Jordan_Normal_Form.html">Jordan_Normal_Form</a></td>
     <td><a href="../dependencies/jordan_normal_form/">15</a></td>
   </tr>
   
   <tr>
     <td>5.</td>
     <td><a href="../entries/Deriving.html">Deriving</a></td>
     <td><a href="../dependencies/deriving/">14</a></td>
   </tr>
   
   <tr>
     <td>6.</td>
     <td><a href="../entries/Coinductive.html">Coinductive</a></td>
     <td><a href="../dependencies/coinductive/">13</a></td>
   </tr>
   
   <tr>
     <td>7.</td>
     <td><a href="../entries/Polynomial_Factorization.html">Polynomial_Factorization</a></td>
     <td><a href="../dependencies/polynomial_factorization/">12</a></td>
   </tr>
   
   <tr>
     <td>8.</td>
     <td><a href="../entries/Regular-Sets.html">Regular-Sets</a></td>
     <td><a href="../dependencies/regular-sets/">12</a></td>
   </tr>
   
   <tr>
     <td>9.</td>
     <td><a href="../entries/Landau_Symbols.html">Landau_Symbols</a></td>
     <td><a href="../dependencies/landau_symbols/">11</a></td>
   </tr>
   
   <tr>
     <td>10.</td>
     <td><a href="../entries/Abstract-Rewriting.html">Abstract-Rewriting</a></td>
     <td><a href="../dependencies/abstract-rewriting/">10</a></td>
   </tr>
   
   <tr>
     <td>11.</td>
     <td><a href="../entries/Automatic_Refinement.html">Automatic_Refinement</a></td>
     <td><a href="../dependencies/automatic_refinement/">10</a></td>
   </tr>
   
   <tr>
     <td>12.</td>
     <td><a href="../entries/Native_Word.html">Native_Word</a></td>
     <td><a href="../dependencies/native_word/">10</a></td>
   </tr>
   
 </table>
 
 <script>
   const years = [2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2021,2022,2023,2024]
   const no_articles = [14,22,29,37,52,64,86,103,128,151,208,253,326,396,455,511,577,650,722,792,798]
-  const no_loc = [60600,96300,130800,238300,353000,435200,516300,567400,737300,824600,1036200,1216500,1600900,1856900,2129500,2449000,2849300,3367100,3732300,4064900,4087700 ]
+  const no_loc = [60600,96300,130800,238300,353800,436000,517200,568200,738100,825400,1037000,1217300,1601800,1857800,2130300,2449800,2850100,3367900,3733200,4065800,4088600 ]
   const no_authors = [14,11,6,6,10,6,24,11,17,16,37,20,63,32,26,38,30,43,32,29,4]
   const no_authors_series = [14,25,31,37,47,53,77,88,105,121,158,178,241,273,299,337,367,410,442,471,475]
   const all_articles = ['AVL-Trees','MiniML','Functional-Automata','BinarySearchTree','Lazy-Lists-II','Topology','Group-Ring-Module','Depth-First-Search','Compiling-Exceptions-Correctly','Completeness','Ramsey-Infinite','Verified-Prover','Integration','FileRefinement','Category','RSAPSS','Jinja','JiveDataStoreModel','DiskPaxos','GenClock','FFT','Ordinal','Cauchy','ClockSynchInst','FeatherweightJava','CoreC++','Flyspeck-Tame','Abstract-Hoare-Logics','HotelKeyCards','FOL-Fitting','POPLmark-deBruijn','Valuation','Fermat3_4','SumSquares','MuchAdoAboutTwo','JinjaThreads','Program-Conflict-Analysis','LinearQuantifierElim','NormByEval','BDD','Simpl','Recursion-Theory-I','SATSolverVerification','FunWithFunctions','ArrowImpossibilityGS','VolpanoSmith','Slicing','Huffman','FunWithTilings','SenSocialChoice','SIFPL','BytecodeLogicJmlTypes','Stream-Fusion','FinFun','CofGroups','SequentInvertibility','Ordinals_and_Cardinals','WorkerWrapper','HRB-Slicing','Perfect-Number-Thm','Collections','Tree-Automata','Presburger-Automata','DPT-SAT-Solver','Coinductive','List-Index','InformationFlowSlicing','InformationFlowSlicing_Inter','Free-Boolean-Algebra','Locally-Nameless-Sigma','Regular-Sets','Robbins-Conjecture','DataRefinementIBP','GraphMarkingIBP','Abstract-Rewriting','Matrix','Category2','Free-Groups','Statecharts','Polynomials','Lam-ml-Normalization','Binomial-Heaps','Binomial-Queues','Finger-Trees','Shivers-CFA','Marriage','Lower_Semicontinuous','RIPEMD-160-SPARK','LightweightJava','AutoFocus-Stream','List-Infinite','Nat-Interval-Logic','Transitive-Closure','General-Triangle','KBPs','Max-Card-Matching','Gauss-Jordan-Elim-Fun','Myhill-Nerode','LatticeProperties','MonoBoolTranAlgebra','PseudoHoops','Efficient-Mergesort','TLA','Markov_Models','Dijkstra_Shortest_Path','Refine_Monadic','Girth_Chromatic','Transitive-Closure-II','Abortable_Linearizable_Modules','Well_Quasi_Orders','Ordinary_Differential_Equations','Inductive_Confidentiality','Stuttering_Equivalence','Separation_Algebra','Circus','CCS','Pi_Calculus','Psi_Calculi','Tycon','PCF','Heard_Of','Impossible_Geometry','Datatype_Order_Generator','Possibilistic_Noninterference','Bondy','Tarskis_Geometry','Open_Induction','Separation_Logic_Imperative_HOL','Sqrt_Babylonian','Kleene_Algebra','Rank_Nullity_Theorem','Ribbon_Proofs','Launchbury','Nominal2','Containers','Graph_Theory','ShortestPath','Sort_Encodings','Koenigsberg_Friendship','Lehmer','Pratt_Certificate','IEEE_Floating_Point','Native_Word','Automatic_Refinement','Decreasing-Diagrams','GoedelGod','FocusStreamsCaseStudies','Coinductive_Languages','HereditarilyFinite','Incompleteness','Tail_Recursive_Functions','CryptoBasedCompositionalProperties','Sturm_Sequences','Featherweight_OCL','KAT_and_DRA','Relation_Algebra','Secondary_Sylow','Regex_Equivalence','Real_Impl','Affine_Arithmetic','Selection_Heap_Sort','Random_Graph_Subgraph_Threshold','Partial_Function_MR','AWN','Probabilistic_Noninterference','GPU_Kernel_PL','Discrete_Summation','Abstract_Completeness','HyperCTL','Bounded_Deducibility_Security','SIFUM_Type_Systems','Strong_Security','WHATandWHERE_Security','ComponentDependencies','Regular_Algebras','Noninterference_CSP','Roy_Floyd_Warshall','CAVA_Automata','CAVA_LTL_Modelchecker','Gabow_SCC','LTL_to_GBA','Promela','Boolean_Expression_Checkers','MSO_Regex_Equivalence','Pop_Refinement','Network_Security_Policy_Verification','Amortized_Complexity','pGCL','CISC-Kernel','Show','Splay_Tree','Skew_Heap','Special_Function_Bounds','VectorSpace','Gauss_Jordan','Priority_Queue_Braun','Jordan_Hoelder','Cayley_Hamilton','Sturm_Tarski','Imperative_Insertion_Sort','Certification_Monads','XML','RefinementReactive','Density_Compiler','Stream_Fusion_Code','Lifting_Definition_Option','AODV','UPF','UpDown_Scheme','Finite_Automata_HF','Echelon_Form','QR_Decomposition','Call_Arity','Deriving','Consensus_Refined','Trie','ConcurrentGC','ConcurrentIMP','Residuated_Lattices','Vickrey_Clarke_Groves','Probabilistic_System_Zoo','Formula_Derivatives','Dynamic_Tables','List_Interleaving','Multirelations','Noninterference_Generic_Unwinding','Noninterference_Ipurge_Unwinding','Derangements','Hermite','Akra_Bazzi','Landau_Symbols','Case_Labeling','Encodability_Process_Calculi','Rep_Fin_Groups','Noninterference_Inductive_Unwinding','Decreasing-Diagrams-II','Jordan_Normal_Form','LTL_to_DRA','Isabelle_Meta_Model','Parity_Game','Planarity_Certificates','TortoiseHare','Euler_Partition','Ergodic_Theory','Latin_Square','Card_Partitions','Algebraic_Numbers','Applicative_Lifting','Stern_Brocot','Descartes_Sign_Rule','Liouville_Numbers','Prime_Harmonic_Series','Triangle','Card_Number_Partitions','Matrix_Tensor','Knot_Theory','Polynomial_Factorization','Polynomial_Interpolation','Formal_SSA','List_Update','LTL','Cartan_FP','Timed_Automata','PropResPI','KAD','Noninterference_Sequential_Composition','CYK','ROBDD','No_FTL_observers','Groebner_Bases','Bell_Numbers_Spivey','SDS_Impossibility','Randomised_Social_Choice','MFMC_Countable','FLP','Incredible_Proof_Machine','Perron_Frobenius','Card_Equiv_Relations','Posix-Lexing','Tree_Decomposition','Word_Lib','Noninterference_Concurrent_Composition','Algebraic_VCs','Catalan_Numbers','Dependent_SIFUM_Type_Systems','Card_Multisets','Category3','Dependent_SIFUM_Refinement','IP_Addresses','Resolution_FOL','Rewriting_Z','Buildings','DFS_Framework','Pairing_Heap','Surprise_Paradox','Ptolemys_Theorem','Refine_Imperative_HOL','EdmondsKarp_Maxflow','InfPathElimination','Simple_Firewall','Routing','Stirling_Formula','Stone_Algebras','SuperCalc','Iptables_Semantics','Lambda_Free_RPOs','Allen_Calculus','Fisher_Yates','Lp','Chord_Segments','Berlekamp_Zassenhaus','SPARCv8','Source_Coding_Theorem','LOFT','Stable_Matching','Modal_Logics_for_NTS','Deep_Learning','Lambda_Free_KBOs','Nested_Multisets_Ordinals','Separata','Abs_Int_ITP2012','Complx','Paraconsistency','Proof_Strategy_Language','Twelvefold_Way','Concurrent_Ref_Alg','FOL_Harrison','Password_Authentication_Protocol','UPF_Firewall','E_Transcendental','Bertrands_Postulate','Minimal_SSA','Bernoulli','Key_Agreement_Strong_Adversaries','Stone_Relation_Algebras','Abstract_Soundness','Differential_Dynamic_Logic','Menger','Elliptic_Curves_Group_Law','Euler_MacLaurin','Comparison_Sort_Lower_Bound','Quick_Sort_Cost','Random_BSTs','Subresultants','Lazy_Case','Constructor_Funs','LocalLexing','Types_Tableaus_and_Goedels_God','MonoidalCategory','CryptHOL','Game_Based_Crypto','Monad_Normalisation','Monomorphic_Monad','Probabilistic_While','Floyd_Warshall','Dict_Construction','Security_Protocol_Refinement','Optics','Flow_Networks','Prpu_Maxflow','Buffons_Needle','PSemigroupsConvolution','Propositional_Proof_Systems','Stone_Kleene_Relation_Algebras','CRDT','Name_Carrying_Type_Inference','Minkowskis_Theorem','HOLCF-Prelude','Decl_Sem_Fun_PL','DynamicArchitectures','Stewart_Apollonius','LambdaMu','Orbit_Stabiliser','Root_Balanced_Tree','First_Welfare_Theorem','AnselmGod','PLM','Lowe_Ontological_Argument','Dirichlet_Series','Linear_Recurrences','Zeta_Function','Diophantine_Eqns_Lin_Hom','Count_Complex_Roots','Winding_Number_Eval','Buchi_Complementation','Transition_Systems_and_Automata','Kuratowski_Closure_Complement','Hybrid_Multi_Lane_Spatial_Logic','IMAP-CRDT','Stochastic_Matrices','Knuth_Morris_Pratt','BNF_Operations','Dirichlet_L','Mason_Stothers','Median_Of_Medians_Selection','Falling_Factorial_Sum','Taylor_Models','Green','Gromov_Hyperbolicity','Ordered_Resolution_Prover','LLL_Basis_Reduction','Error_Function','First_Order_Terms','LLL_Factorization','Treaps','Hoare_Time','Architectural_Design_Patterns','CakeML','Weight_Balanced_Trees','Fishburn_Impossibility','BNF_CC','VerifyThis2018','WebAssembly','Modular_Assembly_Kit_Security','OpSets','Monad_Memo_DP','AxiomaticCategoryTheory','Irrationality_J_Hancl','Probabilistic_Timed_Automata','Hidden_Markov_Models','Optimal_BST','Partial_Order_Reduction','Localization_Ring','Projective_Geometry','Pell','Neumann_Morgenstern_Utility','DiscretePricing','Minsky_Machines','Simplex','Budan_Fourier','Quaternions','Octonions','Aggregation_Algebras','Prime_Number_Theorem','Signature_Groebner','Symmetric_Polynomials','Pi_Transcendental','Factored_Transition_System_Bounding','Lambda_Free_EPO','Randomised_BSTs','Smooth_Manifolds','Epistemic_Logic','GewirthPGCProof','Generic_Deriving','Matroids','Auto2_HOL','Functional_Ordered_Resolution_Prover','Graph_Saturation','Order_Lattice_Props','Quantales','Transformer_Semantics','Constructive_Cryptography','Auto2_Imperative_HOL','Concurrent_Revisions','Core_DOM','Store_Buffer_Reduction','Higher_Order_Terms','IMP2','Farkas','List_Inversions','UTP','Universal_Turing_Machine','Probabilistic_Prime_Tests','Kruskal','Prime_Distribution_Elementary','Safe_OCL','QHLProver','Transcendence_Series_Hancl_Rucki','Binding_Syntax_Theory','LTL_Master_Theorem','HOL-CSP','Multi_Party_Computation','LambdaAuth','KD_Tree','Differential_Game_Logic','IMP2_Binary_Heap','Groebner_Macaulay','Nullstellensatz','Linear_Inequalities','Prim_Dijkstra_Simple','Priority_Search_Trees','Complete_Non_Orders','MFOTL_Monitor','CakeML_Codegen','FOL_Seq_Calc1','Szpilrajn','TESL_Language','Stellar_Quorums','IMO2019','C2KA_DistributedSystems','Linear_Programming','Laplace_Transform','Adaptive_State_Counting','Jacobson_Basic_Algebra','Fourier','Hybrid_Systems_VCs','Generic_Join','Clean','Sigma_Commit_Crypto','Aristotles_Assertoric_Syllogistic','VerifyThis2019','Isabelle_C','ZFC_in_HOL','Interval_Arithmetic_Word32','Generalized_Counting_Sort','Gauss_Sums','Complex_Geometry','Poincare_Disc','Poincare_Bendixson','Hybrid_Logic','Zeta_3_Irrational','Bicategory','Skip_Lists','Closest_Pair_Points','Approximation_Algorithms','Mersenne_Primes','Subset_Boolean_Algebras','Arith_Prog_Rel_Primes','VeriComp','Goodstein_Lambda','Hello_World','Relational-Incorrectness-Logic','Furstenberg_Topology','WOOT_Strong_Eventual_Consistency','Lucas_Theorem','Automated_Stateful_Protocol_Verification','Stateful_Protocol_Composition_and_Typing','MFODL_Monitor_Optimized','Saturation_Framework','Sliding_Window_Algorithm','ADS_Functor','Matrices_for_ODEs','Gaussian_Integers','Lambert_W','Power_Sum_Polynomials','Attack_Trees','Banach_Steinhaus','Forcing','LTL_Normal_Form','Recursion-Addition','Irrational_Series_Erdos_Straus','Knuth_Bendix_Order','Nash_Williams','Smith_Normal_Form','Safe_Distance','Relational_Paths','Chandy_Lamport','Ordinal_Partitions','Amicable_Numbers','BirdKMP','Saturation_Framework_Extensions','Relational_Disjoint_Set_Forests','Inductive_Inference','PAC_Checker','Extended_Finite_State_Machine_Inference','Extended_Finite_State_Machines','Goedel_HFSet_Semantic','Goedel_HFSet_Semanticless','Goedel_Incompleteness','Robinson_Arithmetic','Syntax_Independent_Logic','Core_SC_DOM','DOM_Components','SC_DOM_Components','Shadow_DOM','Shadow_SC_DOM','Finite-Map-Extras','Physical_Quantities','AI_Planning_Languages_Semantics','Verified_SAT_Based_AI_Planning','CSP_RefTK','Isabelle_Marries_Dirac','Relational_Method','Interpreter_Optimizations','Relational_Minimum_Spanning_Trees','Topological_Semantics','Delta_System_Lemma','JinjaDCI','Hood_Melville_Queue','Blue_Eyes','IsaGeoCoq','Laws_of_Large_Numbers','Formal_Puiseux_Series','BTree','Sunflowers','Mereology','Hermite_Lindemann','Projective_Measurements','Modular_arithmetic_LLL_and_HNF_algorithms','Constructive_Cryptography_CM','Padic_Ints','Grothendieck_Schemes','IFC_Tracking','Progress_Tracking','GaleStewart_Games','BenOr_Kozen_Reif','Lifting_the_Exponent','Metalogic_ProofChecker','Regression_Test_Selection','Combinatorics_Words','Combinatorics_Words_Graph_Lemma','Combinatorics_Words_Lyndon','IMP_Compiler','Public_Announcement_Logic','MiniSail','Van_der_Waerden','SpecCheck','Finitely_Generated_Abelian_Groups','Schutz_Spacetime','Relational_Forests','Design_Theory','BD_Security_Compositional','CoCon','CoSMeDis','CoSMed','Fresh_Identifiers','Three_Circles','Logging_Independent_Anonymity','Cubic_Quartic_Equations','Dominance_CHK','CZH_Elementary_Categories','CZH_Foundations','CZH_Universal_Constructions','Conditional_Simplification','Conditional_Transfer_Rule','Intro_Dest_Elim','Types_To_Sets_Extension','Weighted_Path_Order','Complex_Bounded_Operators','FOL_Axiomatic','Virtual_Substitution','Correctness_Algebras','X86_Semantics','Belief_Revision','Registers','Szemeredi_Regularity','Factor_Algebraic_Polynomial','PAL','Real_Power','SimplifiedOntologicalArgument','Hahn_Jordan_Decomposition','Foundation_of_geometry','Van_Emde_Boas_Trees','Simplicial_complexes_and_boolean_functions','Regular_Tree_Relations','MDP-Algorithms','MDP-Rewards','Roth_Arithmetic_Progressions','Gale_Shapley','Hyperdual','Knights_Tour','Irrationals_From_THEBOOK','Actuarial_Mathematics','Median_Method','Interpolation_Polynomials_HOL_Algebra','FOL_Seq_Calc2','Youngs_Inequality','FO_Theory_Rewriting','LP_Duality','Quasi_Borel_Spaces','Equivalence_Relation_Enumeration','VYDRA_MDL','Eval_FO','Wetzels_Problem','Universal_Hash_Families','ResiduatedTransitionSystem','Transitive_Models','Independence_CH','Cotangent_PFD_Formula','FOL_Seq_Calc3','Ackermanns_not_PR','Dedekind_Real','Frequency_Moments','Prefix_Free_Code_Combinators','Sophomores_Dream','Digit_Expansions','Multiset_Ordering_NPC','Fishers_Inequality','Clique_and_Monotone_Circuits','Package_logic','Pluennecke_Ruzsa_Inequality','Combinable_Wands','Rewrite_Properties_Reduction','DPRM_Theorem','Finite_Fields','IsaNet','Boolos_Curious_Inference','Real_Time_Deque','IMP_Compiler_Reuse','Weighted_Arithmetic_Geometric_Mean','Commuting_Hermitian','Solidity','Nano_JSON','FSM_Tests','Involutions2Squares','SCC_Bloemen_Sequential','Number_Theoretic_Transform','Hales_Jewett','Khovanskii_Theorem','Separation_Logic_Unbounded','CRYSTALS-Kyber','Implicational_Logic','Risk_Free_Lending','Padic_Field','Stalnaker_Logic','Safe_Range_RC','Maximum_Segment_Sum','Undirected_Graph_Theory','Query_Optimization','PAPP_Impossibility','Balog_Szemeredi_Gowers','Combinatorial_Enumeration_Algorithms','Turans_Graph_Theorem','Kneser_Cauchy_Davenport','Sauer_Shelah_Lemma','CHERI-C_Memory_Model','AOT','Multitape_To_Singletape_TM','Boolos_Curious_Inference_Automated','Birkhoff_Finite_Distributive_Lattices','Propositional_Logic_Class','Quantifier_Elimination_Hybrid','Binary_Code_Imprimitive','Two_Generated_Word_Monoids_Intersection','Cook_Levin','Synthetic_Completeness','StrictOmegaCategories','HoareForDivergence','Suppes_Theorem','Given_Clause_Loops','ABY3_Protocols','CVP_Hardness','Edwards_Elliptic_Curves_Group','Probability_Inequality_Completeness','Rensets','Expander_Graphs','No_FTL_observers_Gen_Rel','CommCSL','DigitsInBase','Distributed_Distinct_Elements','HyperHoareLogic','TsirelsonBound','Simple_Clause_Learning','Schwartz_Zippel','MHComputation','Three_Squares','MLSS_Decision_Proc','Tree_Enumeration','Multirelations_Heterogeneous','Directed_Sets','Efficient_Weighted_Path_Order','Crypto_Standards','Zeckendorf','DCR-ExecutionEquivalence','Executable_Randomized_Algorithms','Gray_Codes','Earley_Parser','Quantales_Converse','S_Finite_Measure_Monad','Standard_Borel_Spaces','Polygonal_Number_Theorem','Catoids','Fixed_Length_Vector','Ceva','Coupledsim_Contrasim','IO_Language_Conformance','Euler_Polyhedron_Formula','ML_Unification','Hypergraph_Basics','Lovasz_Local','Relational_Cardinality','Hypergraph_Colourings','Transport','Eudoxus_Reals','Labeled_Transition_Systems','Pushdown_Systems','Disintegration','Q0_Metatheory','Elimination_Of_Repeated_Factors','Perfect_Fields','Nominal_Myhill_Nerode','Concentration_Inequalities','Chebyshev_Polynomials','Polynomial_Crit_Geometry','Cardinality_Continuum','Polylog','Q0_Soundness','Martingales','Lambert_Series','KnuthMorrisPratt','HOL-CSPM','CRYSTALS-Kyber_Security','Interval_Analysis','Isabelle_hoops','OmegaCatoidsQuantales','Region_Quadtrees','Sumcheck_Protocol','IMP_Noninterference']
   const article_years_unique = ['2004','','','','','','','','','','','','','','2005','','','','','','','','2006','','','','','','','2007','','','','','','','','2008','','','','','','','','','','','','','','','2009','','','','','','','','','','','','2010','','','','','','','','','','','','','','','','','','','','','','2011','','','','','','','','','','','','','','','','','2012','','','','','','','','','','','','','','','','','','','','','','','','','2013','','','','','','','','','','','','','','','','','','','','','','','2014','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2015','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2016','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2017','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2018','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2019','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2020','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2021','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2022','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2023','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','2024','','','','','']
-  const loc_articles = [839,1507,1542,1096,1058,2419,44195,205,142,1974,209,1110,3792,506,1141,3766,17615,3119,6430,1145,447,2081,1275,1583,1838,12832,13047,2685,1228,3556,4238,9647,2847,970,1740,79712,4738,3396,2185,10664,31022,6726,30332,180,793,1047,14413,2032,254,2220,5959,3463,799,1540,684,6654,8,2625,27490,264,32555,5025,4380,208,9538,447,2380,3399,606,6305,2060,840,713,1024,5632,1427,4078,2230,5997,22604,1602,3370,1587,2451,2591,260,1617,16,2937,6557,7804,6381,992,125,10130,332,239,1831,999,1756,4420,434,4461,11862,2835,8575,1045,408,2940,2612,37929,3207,1480,2612,3141,2580,23005,27588,2266,4107,7701,1249,260,5309,73,9729,663,6748,1512,4355,1249,1916,6214,4972,10086,7261,538,3830,4591,202,853,2003,5274,10320,1524,150,5292,706,2217,10739,1463,1958,3067,11487,1860,1190,1219,2174,1144,14860,2212,1957,166,10685,6420,572,590,465,1698,1909,4134,1403,2138,2280,1959,2467,220,4429,9396,5430,3999,4472,406,5935,1829,12828,3234,9486,4560,926,659,63,1653,2338,9085,822,1302,875,2563,627,945,1405,1296,7880,1922,90,28055,2879,2796,1116,5259,4863,8842,1356,5986,527,6650,2584,1772,5327,1092,4121,952,1064,2362,1089,2446,477,2074,3763,1954,710,16080,8267,908,1056,21228,9679,8665,3142,9156,695,435,13986,478,898,10416,2724,1162,741,405,495,498,838,3622,4616,6184,4106,8166,12091,3188,518,17581,2876,2418,5496,885,2453,1159,17387,576,703,5047,10687,4287,3811,5337,329,4108,1057,15501,3257,2582,553,8478,206,27172,8773,3324,2960,398,12811,9483,370,173,384,19029,2545,6119,3774,645,2415,4344,9355,20053,3963,3419,319,3174,169,19414,14667,541,2652,7059,7595,3898,3243,4510,855,2289,5027,1349,276,4339,1475,3482,7119,9662,592,1728,852,2194,12198,4382,590,13558,1695,4484,1644,694,835,737,3394,105,68,10492,1127,8628,11278,4135,378,4711,1200,2103,639,14042,3160,3930,4869,468,1531,5570,5721,1993,4205,478,4124,3147,3472,88,480,1090,1883,2194,250,10669,822,7432,3105,5166,2782,8208,8127,2324,6164,940,6514,992,489,810,8949,3434,338,854,493,4593,9455,15962,6462,10342,787,3772,3253,1820,8442,3278,12945,672,843,3402,3638,11570,13548,3734,6261,528,965,7711,1042,1221,5017,1390,2755,1622,2173,13357,805,9900,2667,541,1271,2825,4896,9770,2765,937,11918,2205,1743,7906,1386,449,685,1812,1235,3559,3578,2951,2218,1644,5182,4968,2767,17370,34354,3235,6018,1891,373,9969,30917,3018,3298,5306,4590,10509,986,15793,4437,11122,5556,3301,1264,2973,805,10229,2606,5735,3365,472,4879,3199,13317,987,787,4455,527,713,782,2321,2134,9936,2090,3734,5801,2350,4212,3808,176,1726,9694,7217,5069,5729,4562,14098,10292,6404,4470,1909,68341,2345,3937,3485,1706,3154,944,1033,597,370,691,764,2564,332,27826,24138,10943,3063,744,2353,1560,2537,1609,1242,1939,1338,12000,1034,1444,1902,2124,729,13319,3036,5074,9793,6176,1261,2899,2101,5904,12873,9015,4257,4725,426,11477,3546,1295,8100,16379,3523,7792,12655,15363,648,1761,2352,16434,1435,7700,3995,6542,4579,1788,3304,24539,745,365,26525,290,2404,15792,615,4039,3767,4958,17079,8442,15846,6578,4131,7221,1015,10340,384,9264,4094,15795,487,835,666,840,19737,1088,233,4435,7684,1962,4943,3003,11165,14638,5913,303,3758,817,1329,3157,40867,29090,22137,225,1053,169,17516,4304,18639,1306,21773,13533,2621,1324,5954,913,2961,133,2203,455,2619,6076,20605,1882,9607,7685,4271,1385,2302,2946,3108,264,6316,777,757,2594,656,9228,633,8738,502,7222,5937,337,829,18644,18383,14310,730,719,201,1411,4183,816,401,1312,1820,5168,2337,2169,654,2031,3338,8754,4622,7330,95,3657,1527,414,5785,16082,1041,53749,351,3175,1961,2144,1373,2325,3656,431,2239,39749,534,3097,144,2696,19190,2366,2961,1593,799,2051,419,4072,23190,1844,135,888,3535,8765,2328,1286,51217,2400,1105,2001,1036,6140,3226,4780,6881,7843,1739,7492,8371,8943,818,6726,3268,6198,9443,1034,193,3098,5281,3002,7219,618,1263,43708,292,157,3889,497,6003,1765,10568,12604,1938,1397,404,467,5302,2898,2604,1570,259,3589,3204,1175,12659,1322,1566,3278,2656,12364,1275,1833,3517,2080,3124,547,803,916,2721,3176,2283,449,4531,2283,6911,3235,3025,1459,1423,6746]
+  const loc_articles = [839,1507,1542,1096,1058,2419,44195,205,142,1974,209,1110,3792,506,1141,3766,17615,3119,6430,1145,447,2081,1275,1583,1838,12832,13047,2685,1228,3556,4238,9647,2847,970,1740,79712,4738,3396,2185,10664,31865,6726,30332,180,793,1047,14413,2032,254,2220,5959,3463,799,1540,684,6654,8,2625,27490,264,32555,5025,4380,208,9538,447,2380,3399,606,6305,2060,840,713,1024,5632,1427,4078,2230,5997,22604,1602,3370,1587,2451,2591,260,1617,16,2937,6557,7804,6381,992,125,10130,332,239,1831,999,1756,4420,434,4461,11862,2835,8575,1045,408,2940,2612,37929,3207,1480,2612,3141,2580,23005,27588,2266,4107,7701,1249,260,5309,73,9729,663,6748,1512,4355,1249,1916,6214,4972,10086,7261,538,3830,4591,202,853,2003,5274,10320,1524,150,5292,706,2217,10739,1463,1958,3067,11487,1860,1190,1219,2174,1144,14860,2212,1957,166,10685,6420,572,590,465,1698,1909,4134,1403,2138,2280,1959,2467,220,4429,9396,5430,3999,4472,406,5935,1829,12828,3234,9486,4560,926,659,63,1653,2338,9085,822,1302,875,2563,627,945,1405,1296,7880,1922,90,28055,2879,2796,1116,5259,4863,8842,1356,5986,527,6650,2584,1772,5327,1092,4121,952,1064,2362,1089,2446,477,2074,3763,1954,710,16080,8267,908,1056,21228,9679,8665,3142,9156,695,435,13986,478,898,10416,2724,1162,741,405,495,498,838,3622,4616,6184,4106,8166,12091,3188,518,17581,2876,2418,5496,885,2453,1159,17387,576,703,5047,10687,4287,3811,5337,329,4108,1057,15501,3257,2582,553,8478,206,27172,8773,3324,2960,398,12811,9483,370,173,384,19029,2545,6119,3774,645,2415,4344,9355,20053,3963,3419,319,3174,169,19414,14667,541,2652,7059,7595,3898,3243,4510,855,2289,5027,1349,276,4339,1475,3482,7119,9662,592,1728,852,2194,12198,4382,590,13558,1695,4484,1644,694,835,737,3394,105,68,10492,1127,8628,11278,4135,378,4711,1200,2103,639,14042,3160,3930,4869,468,1531,5570,5721,1993,4205,478,4124,3147,3472,88,480,1090,1883,2194,250,10669,822,7432,3105,5166,2782,8208,8127,2324,6164,940,6514,992,489,810,8949,3434,338,854,493,4593,9455,15962,6462,10342,787,3772,3253,1820,8442,3278,12945,672,843,3402,3638,11570,13548,3734,6261,528,965,7711,1042,1221,5017,1390,2755,1622,2173,13357,805,9900,2667,541,1271,2825,4896,9770,2765,937,11918,2205,1743,7906,1386,449,685,1812,1235,3559,3578,2951,2218,1644,5182,4968,2767,17370,34354,3235,6018,1891,373,9969,30917,3018,3298,5306,4590,10509,986,15793,4437,11122,5556,3301,1264,2973,805,10229,2606,5735,3365,472,4879,3199,13317,987,787,4455,527,713,782,2321,2134,9936,2090,3734,5801,2350,4212,3808,176,1726,9694,7217,5069,5729,4562,14098,10292,6404,4470,1909,68341,2345,3937,3485,1706,3154,944,1033,597,370,691,764,2564,332,27826,24138,10943,3063,744,2353,1560,2537,1609,1242,1939,1338,12000,1034,1444,1902,2124,729,13319,3036,5074,9793,6176,1261,2899,2101,5904,12873,9015,4257,4725,426,11477,3546,1295,8100,16379,3523,7792,12655,15363,648,1761,2352,16434,1435,7700,3995,6542,4579,1788,3304,24539,745,365,26525,290,2404,15792,615,4039,3767,4958,17079,8442,15846,6578,4131,7221,1015,10340,384,9264,4094,15795,487,835,666,840,19737,1088,233,4435,7684,1962,4943,3003,11165,14638,5913,303,3758,817,1329,3157,40867,29090,22137,225,1053,169,17516,4304,18639,1306,21773,13533,2621,1324,5954,913,2961,133,2203,455,2619,6076,20605,1882,9607,7685,4271,1385,2302,2946,3108,264,6316,777,757,2594,656,9228,633,8738,502,7222,5937,337,829,18644,18383,14310,730,719,201,1411,4183,816,401,1312,1820,5168,2337,2169,654,2031,3338,8754,4622,7330,95,3657,1527,414,5785,16082,1041,53749,351,3175,1961,2144,1373,2325,3656,431,2239,39749,534,3097,144,2696,19190,2366,2961,1593,799,2051,419,4072,23190,1844,135,888,3535,8765,2328,1286,51217,2400,1105,2001,1036,6140,3226,4780,6881,7843,1739,7492,8371,8943,818,6726,3268,6198,9443,1034,193,3098,5281,3002,7219,618,1263,43708,292,157,3889,497,6003,1765,10568,12604,1938,1397,404,467,5302,2898,2604,1570,259,3589,3204,1175,12659,1322,1566,3278,2656,12364,1275,1833,3517,2080,3124,547,803,916,2721,3176,2283,449,4531,2283,6911,3235,3025,1459,1423,6746]
 </script>
 <h4>Growth in number of entries:</h4>
 <script src="../js/Chart.js"></script>
 <div class="chart">
   <canvas id="num-articles-canvas"></canvas>
 </div>
 <script>
   new Chart(document.getElementById("num-articles-canvas"), {
     type: 'bar',
     data: {
       labels: years,
       datasets: [{
         label: 'Size of the AFP in # of entries',
         data: no_articles,
         backgroundColor: "rgba(46, 45, 78, 1)"
       }],
     },
     options: {
       responsive: true,
       maintainAspectRatio: false,
       scales: {
         yAxes: [{
           ticks: {
             beginAtZero: true
           }
         }]
       },
     }
   })
 </script>
 
 <h4>Growth in lines of code:</h4>
 <div class="chart">
   <canvas id="loc-years-canvas"></canvas>
 </div>
 <script>
   new Chart(document.getElementById("loc-years-canvas"), {
     type: 'bar',
     data: {
       labels: years,
       datasets: [{
         label: 'size of the AFP in lines of code',
         data: no_loc,
         backgroundColor: "rgba(101, 99, 136, 1)"
       }],
     },
     options: {
       responsive: true,
       maintainAspectRatio: false,
       scales: {
         yAxes: [{
           ticks: {
             beginAtZero: true
           }
         }]
       },
     }
   })
 </script>
 
 <h4>Growth in number of authors:</h4>
 <div class="chart">
   <canvas id="author-years-canvas"></canvas>
 </div>
 <script>
   new Chart(document.getElementById("author-years-canvas"), {
     type: 'bar',
     data: {
       labels: years,
       datasets: [{
         label: 'new authors per year',
         data: no_authors,
         backgroundColor: "rgba(101, 99, 136, 1)"
       },
       {
         label: 'number of authors contributing (cumulative)',
         data: no_authors_series,
         backgroundColor: "rgba(0, 15, 48, 1)"
       }],
     },
     options: {
       responsive: true,
       maintainAspectRatio: false,
       scales: {
         yAxes: [{
           ticks: {
             beginAtZero: true
           }
         }]
       },
     }
   })
 </script>
 
 <h4>Size of entries:</h4>
 <div class="chart">
   <canvas id="loc-articles-canvas"></canvas>
 </div>
 <script>
   new Chart(document.getElementById("loc-articles-canvas"), {
     type: 'bar',
     data: {
       labels: article_years_unique,
       datasets: [{
         label: 'loc per article',
         data: loc_articles,
         backgroundColor: 'rgba(101, 99, 136, 1)'
       }]
     },
     options: {
       responsive: true,
       maintainAspectRatio: false,
       scales: {
         xAxes: [{
           categoryPercentage: 1,
           barPercentage: 0.9,
           ticks: {
             autoSkip: false
           }
         }],
         yAxes: [{
           ticks: {
             beginAtZero: true
           }
         }]
       },
       tooltips: {
         callbacks: {
           title: tooltipItem => all_articles[tooltipItem[0].index]
         }
       }
     }
   })
 </script>
 
 </td>
 </tr>
 
 </tbody>
 </table>
 
   </div>
         
       </div>
     </div>
   </body>
 </html>
\ No newline at end of file