From 0c3ac9da284c65a21d65cf8f2571415465182d6d Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Wed, 19 Jul 2023 19:32:26 +1000
Subject: [PATCH 1/5] lib/monads: restyle Trace_Monad.thy

This should now be in sync with Nondet_Monad.thy wherever the two files
have similar content.

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 lib/Monads/trace/Trace_Monad.thy | 894 ++++++++++++-------------------
 1 file changed, 347 insertions(+), 547 deletions(-)

diff --git a/lib/Monads/trace/Trace_Monad.thy b/lib/Monads/trace/Trace_Monad.thy
index 506f8954ca..21ea924db8 100644
--- a/lib/Monads/trace/Trace_Monad.thy
+++ b/lib/Monads/trace/Trace_Monad.thy
@@ -1,62 +1,60 @@
 (*
+ * Copyright 2023, Proofcraft Pty Ltd
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
+
+chapter "Interference Trace Monad"
+
 theory Trace_Monad
-imports
-  Monad_Lib
-  Strengthen
+  imports
+    Fun_Pred_Syntax
+    Monad_Lib
+    Strengthen
 begin
 
 text \<open>
-The ``Interference Trace Monad''. This nondeterministic monad
-records the state at every interference point, permitting
-nondeterministic interference by the environment at interference
-points.
-
-The trace set initially includes all possible environment behaviours.
-Trace steps are tagged as environment or self actions, and can then
-be constrained to a smaller set where the environment acts according
-to a rely constraint (i.e. rely-guarantee reasoning), or to set the
-environment actions to be the self actions of another program (parallel
-composition).
-\<close>
+  The ``Interference Trace Monad''. This nondeterministic monad
+  records the state at every interference point, permitting
+  nondeterministic interference by the environment at these points.
+
+  The trace set initially includes all possible environment behaviours.
+  Trace steps are tagged as environment or self actions, and can then
+  be constrained to a smaller set where the environment acts according
+  to a rely constraint (i.e. rely-guarantee reasoning), or to set the
+  environment actions to be the self actions of another program (parallel
+  composition).\<close>
 
 section "The Trace Monad"
 
 text \<open>Trace monad identifier. Me corresponds to the current thread running and Env to the environment.\<close>
 datatype tmid = Me | Env
 
-text \<open>Results associated with traces. Traces may correspond to incomplete, failed, or completed executions.\<close>
+text \<open>
+  Results associated with traces. Traces may correspond to incomplete, failed, or completed executions.\<close>
 datatype ('s, 'a) tmres = Failed | Incomplete | Result "('a \<times> 's)"
 
-abbreviation
-  map_tmres_rv :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s, 'a) tmres \<Rightarrow> ('s, 'b) tmres"
-where
+abbreviation map_tmres_rv :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s, 'a) tmres \<Rightarrow> ('s, 'b) tmres" where
   "map_tmres_rv f \<equiv> map_tmres id f"
 
 section "The Monad"
 
-text \<open> tmonad returns a set of non-deterministic  computations, including
+text \<open>
+  tmonad returns a set of non-deterministic  computations, including
   a trace as a list of "thread identifier" \<times> state, and an optional
-  pair result, state when the computation did not fail. \<close>
+  pair result, state when the computation did not fail.\<close>
 type_synonym ('s, 'a) tmonad = "'s \<Rightarrow> ((tmid \<times> 's) list \<times> ('s, 'a) tmres) set"
 
 text \<open>Returns monad results, ignoring failures and traces.\<close>
-definition
-  mres :: "((tmid \<times> 's) list \<times> ('s, 'a) tmres) set \<Rightarrow> ('a \<times> 's) set"
-where
+definition mres :: "((tmid \<times> 's) list \<times> ('s, 'a) tmres) set \<Rightarrow> ('a \<times> 's) set" where
   "mres r = Result -` (snd ` r)"
 
 text \<open>
   The definition of fundamental monad functions @{text return} and
   @{text bind}. The monad function @{text "return x"} does not change
-  the  state, does not fail, and returns @{text "x"}.
-\<close>
-definition
-  return :: "'a \<Rightarrow> ('s,'a) tmonad"
-where
+  the  state, does not fail, and returns @{text "x"}.\<close>
+definition return :: "'a \<Rightarrow> ('s,'a) tmonad" where
   "return a \<equiv> \<lambda>s. ({([], Result (a, s))})"
 
 text \<open>
@@ -67,58 +65,41 @@ text \<open>
   the combined operation is the union of the set of sets that is created
   by @{text g} applied to the result sets of @{text f}. The combined
   operation may have failed, if @{text f} may have failed or @{text g} may
-  have failed on any of the results of @{text f}.
-\<close>
-
-abbreviation (input)
-  fst_upd :: "('a \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c \<times> 'b"
-where
+  have failed on any of the results of @{text f}.\<close>
+abbreviation (input) fst_upd :: "('a \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c \<times> 'b" where
   "fst_upd f \<equiv> \<lambda>(a,b). (f a, b)"
 
-abbreviation (input)
-  snd_upd :: "('b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'c"
-where
+abbreviation (input) snd_upd :: "('b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'c" where
   "snd_upd f \<equiv> \<lambda>(a,b). (a, f b)"
 
-definition
-  bind :: "('s, 'a) tmonad \<Rightarrow> ('a \<Rightarrow> ('s, 'b) tmonad) \<Rightarrow>
-           ('s, 'b) tmonad" (infixl ">>=" 60)
-where
+definition bind ::
+  "('s, 'a) tmonad \<Rightarrow> ('a \<Rightarrow> ('s, 'b) tmonad) \<Rightarrow> ('s, 'b) tmonad" (infixl ">>=" 60)
+  where
   "bind f g \<equiv> \<lambda>s. \<Union>(xs, r) \<in> (f s). case r of Failed \<Rightarrow> {(xs, Failed)}
     | Incomplete \<Rightarrow> {(xs, Incomplete)}
     | Result (rv, s) \<Rightarrow> fst_upd (\<lambda>ys. ys @ xs) ` g rv s"
 
 text \<open>Sometimes it is convenient to write @{text bind} in reverse order.\<close>
-abbreviation(input)
-  bind_rev :: "('c \<Rightarrow> ('a, 'b) tmonad) \<Rightarrow> ('a, 'c) tmonad \<Rightarrow>
-               ('a, 'b) tmonad" (infixl "=<<" 60)
-where
+abbreviation(input) bind_rev ::
+  "('c \<Rightarrow> ('a, 'b) tmonad) \<Rightarrow> ('a, 'c) tmonad \<Rightarrow> ('a, 'b) tmonad" (infixl "=<<" 60)
+  where
   "g =<< f \<equiv> f >>= g"
 
 text \<open>
   The basic accessor functions of the state monad. @{text get} returns
   the current state as result, does not fail, and does not change the state.
   @{text "put s"} returns nothing (@{typ unit}), changes the current state
-  to @{text s} and does not fail.
-\<close>
-definition
-  get :: "('s,'s) tmonad"
-where
+  to @{text s} and does not fail.\<close>
+definition get :: "('s,'s) tmonad" where
   "get \<equiv> \<lambda>s. {([], Result (s, s))}"
 
-definition
-  put :: "'s \<Rightarrow> ('s, unit) tmonad"
-where
-  "put s \<equiv> \<lambda>st. {([], Result ((), s))}"
+definition put :: "'s \<Rightarrow> ('s, unit) tmonad" where
+  "put s \<equiv> \<lambda>_. {([], Result ((), s))}"
 
-definition
-  put_trace_elem :: "(tmid \<times> 's) \<Rightarrow> ('s, unit) tmonad"
-where
+definition put_trace_elem :: "(tmid \<times> 's) \<Rightarrow> ('s, unit) tmonad" where
   "put_trace_elem x = (\<lambda>s. {([], Incomplete), ([x], Result ((), s))})"
 
-primrec
-  put_trace :: "(tmid \<times> 's) list \<Rightarrow> ('s, unit) tmonad"
-where
+primrec put_trace :: "(tmid \<times> 's) list \<Rightarrow> ('s, unit) tmonad" where
     "put_trace [] = return ()"
   | "put_trace (x # xs) = (put_trace xs >>= (\<lambda>_. put_trace_elem x))"
 
@@ -129,154 +110,118 @@ text \<open>
   of the set @{text A}, does not change the state, and does not fail
   (even if the set is empty). @{text "f \<sqinter> g"} executes @{text f} or
   executes @{text g}. It retuns the union of results of @{text f} and
-  @{text g}, and may have failed if either may have failed.
-\<close>
-definition
-  select :: "'a set \<Rightarrow> ('s, 'a) tmonad"
-where
-  (* Should we have Failed when A = {} ? *)
+  @{text g}, and may have failed if either may have failed.\<close>
+definition select :: "'a set \<Rightarrow> ('s, 'a) tmonad" where
   "select A \<equiv> \<lambda>s. (Pair [] ` Result ` (A \<times> {s}))"
 
-definition
-  alternative :: "('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad \<Rightarrow>
-                  ('s,'a) tmonad"
-  (infixl "\<sqinter>" 20)
-where
+definition alternative :: "('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad"
+  (infixl "\<sqinter>" 20) where
   "f \<sqinter> g \<equiv> \<lambda>s. (f s \<union> g s)"
 
-
-text \<open> The @{text selet_f} function was left out here until we figure
-  out what variant we actually need.
-\<close>
+text \<open>
+  The @{text select_f} function was left out here until we figure
+  out what variant we actually need.\<close>
 
 subsection "Failure"
 
-text \<open> The monad function that always fails. Returns an empty set of
-results and sets the failure flag. \<close>
-definition
-  fail :: "('s, 'a) tmonad"
-where
- "fail \<equiv> \<lambda>s. {([], Failed)}"
-
-text \<open> Assertions: fail if the property @{text P} is not true \<close>
-definition
-  assert :: "bool \<Rightarrow> ('a, unit) tmonad"
-where
- "assert P \<equiv> if P then return () else fail"
-
-text \<open> Fail if the value is @{const None},
-  return result @{text v} for @{term "Some v"} \<close>
-definition
-  assert_opt :: "'a option \<Rightarrow> ('b, 'a) tmonad"
-where
- "assert_opt v \<equiv> case v of None \<Rightarrow> fail | Some v \<Rightarrow> return v"
-
-text \<open> An assertion that also can introspect the current state. \<close>
-
-definition
-  state_assert :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, unit) tmonad"
-where
+text \<open>
+  The monad function that always fails. Returns an empty set of results and sets the failure flag.\<close>
+definition fail :: "('s, 'a) tmonad" where
+  "fail \<equiv> \<lambda>s. {([], Failed)}"
+
+text \<open>Assertions: fail if the property @{text P} is not true\<close>
+definition assert :: "bool \<Rightarrow> ('a, unit) tmonad" where
+  "assert P \<equiv> if P then return () else fail"
+
+text \<open>Fail if the value is @{const None}, return result @{text v} for @{term "Some v"}\<close>
+definition assert_opt :: "'a option \<Rightarrow> ('b, 'a) tmonad" where
+  "assert_opt v \<equiv> case v of None \<Rightarrow> fail | Some v \<Rightarrow> return v"
+
+text \<open>An assertion that also can introspect the current state.\<close>
+definition state_assert :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, unit) tmonad" where
   "state_assert P \<equiv> get >>= (\<lambda>s. assert (P s))"
 
 subsection "Generic functions on top of the state monad"
 
-text \<open> Apply a function to the current state and return the result
-without changing the state. \<close>
-definition
-  gets :: "('s \<Rightarrow> 'a) \<Rightarrow> ('s, 'a) tmonad"
-where
- "gets f \<equiv> get >>= (\<lambda>s. return (f s))"
-
-text \<open> Modify the current state using the function passed in. \<close>
-definition
-  modify :: "('s \<Rightarrow> 's) \<Rightarrow> ('s, unit) tmonad"
-where
+text \<open>Apply a function to the current state and return the result without changing the state.\<close>
+definition gets :: "('s \<Rightarrow> 'a) \<Rightarrow> ('s, 'a) tmonad" where
+  "gets f \<equiv> get >>= (\<lambda>s. return (f s))"
+
+text \<open>Modify the current state using the function passed in.\<close>
+definition modify :: "('s \<Rightarrow> 's) \<Rightarrow> ('s, unit) tmonad" where
   "modify f \<equiv> get >>= (\<lambda>s. put (f s))"
 
-lemma simpler_gets_def: "gets f = (\<lambda>s. {([], Result ((f s), s))})"
- by (simp add: fun_eq_iff gets_def return_def bind_def get_def split_def)
+lemma simpler_gets_def:
+  "gets f = (\<lambda>s. {([], Result ((f s), s))})"
+  by (simp add: gets_def return_def bind_def get_def)
 
 lemma simpler_modify_def:
   "modify f = (\<lambda>s. {([], Result ((),(f s)))})"
-  by (simp add: fun_eq_iff modify_def bind_def get_def put_def split_def)
-
-text \<open> Execute the given monad when the condition is true,
-  return @{text "()"} otherwise. \<close>
-definition
-  "when" :: "bool \<Rightarrow> ('s, unit) tmonad \<Rightarrow>
-           ('s, unit) tmonad"
-where
+  by (simp add: modify_def bind_def get_def put_def)
+
+text \<open>Execute the given monad when the condition is true, return @{text "()"} otherwise.\<close>
+definition "when" :: "bool \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad" where
   "when P m \<equiv> if P then m else return ()"
 
-text \<open> Execute the given monad unless the condition is true,
-  return @{text "()"} otherwise. \<close>
-definition
-  unless :: "bool \<Rightarrow> ('s, unit) tmonad \<Rightarrow>
-            ('s, unit) tmonad"
-where
+text \<open>Execute the given monad unless the condition is true, return @{text "()"} otherwise.\<close>
+definition unless :: "bool \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad" where
   "unless P m \<equiv> when (\<not>P) m"
 
 text \<open>
   Perform a test on the current state, performing the left monad if
-  the result is true or the right monad if the result is false.
-\<close>
-definition
-  condition :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'r) tmonad \<Rightarrow> ('s, 'r) tmonad \<Rightarrow> ('s, 'r) tmonad"
-where
+  the result is true or the right monad if the result is false.\<close>
+definition condition ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'r) tmonad \<Rightarrow> ('s, 'r) tmonad \<Rightarrow> ('s, 'r) tmonad" where
   "condition P L R \<equiv> \<lambda>s. if (P s) then (L s) else (R s)"
 
 notation (output)
   condition  ("(condition (_)//  (_)//  (_))" [1000,1000,1000] 1000)
 
 text \<open>
-Apply an option valued function to the current state, fail
-if it returns @{const None}, return @{text v} if it returns
-@{term "Some v"}.
-\<close>
-definition
-  gets_the :: "('s \<Rightarrow> 'a option) \<Rightarrow> ('s, 'a) tmonad"
-where
+  Apply an option valued function to the current state, fail if it returns @{const None},
+  return @{text v} if it returns @{term "Some v"}.\<close>
+definition gets_the :: "('s \<Rightarrow> 'a option) \<Rightarrow> ('s, 'a) tmonad" where
   "gets_the f \<equiv> gets f >>= assert_opt"
 
 
-subsection \<open> The Monad Laws \<close>
+subsection \<open>The Monad Laws\<close>
 
 text \<open>An alternative definition of bind, sometimes more convenient.\<close>
 lemma bind_def2:
-  "bind f g \<equiv> (\<lambda>s. ((\<lambda>xs. (xs, Failed)) ` {xs. (xs, Failed) \<in> f s})
-    \<union> ((\<lambda>xs. (xs, Incomplete)) ` {xs. (xs, Incomplete) \<in> f s})
-    \<union> (\<Union>(xs, rv, s) \<in> {(xs, rv, s'). (xs, Result (rv, s')) \<in> f s}. fst_upd (\<lambda>ys. ys @ xs) ` g rv s))"
+  "bind f g \<equiv>
+     \<lambda>s. ((\<lambda>xs. (xs, Failed)) ` {xs. (xs, Failed) \<in> f s})
+         \<union> ((\<lambda>xs. (xs, Incomplete)) ` {xs. (xs, Incomplete) \<in> f s})
+         \<union> (\<Union>(xs, rv, s) \<in> {(xs, rv, s'). (xs, Result (rv, s')) \<in> f s}. fst_upd (\<lambda>ys. ys @ xs) ` g rv s)"
   apply (clarsimp simp add: bind_def fun_eq_iff
                             Un_Union_image split_def
                     intro!: eq_reflection)
-  apply (auto split: tmres.splits elim!:rev_bexI[where A="f x" for x])
-  apply (fastforce intro: image_eqI[rotated])
+  apply (fastforce split: tmres.splits elim!: rev_bexI[where A="f x" for x]
+                   intro: image_eqI[rotated])
   done
 
 lemma elem_bindE:
-  "(tr, res) \<in> bind f (\<lambda>x. g x) s
-    \<Longrightarrow> ((res = Incomplete | res = Failed) \<Longrightarrow> (tr, map_tmres undefined undefined res) \<in> f s \<Longrightarrow> P)
-    \<Longrightarrow> (\<And>tr' tr'' x s'. (tr', Result (x, s')) \<in> f s \<Longrightarrow> (tr'', res) \<in> g x s'
-        \<Longrightarrow> tr = tr'' @ tr' \<Longrightarrow> P)
-    \<Longrightarrow> P"
+  "\<lbrakk>(tr, res) \<in> bind f g s;
+    \<lbrakk>res = Incomplete \<or> res = Failed; (tr, map_tmres undefined undefined res) \<in> f s\<rbrakk> \<Longrightarrow> P;
+    \<And>tr' tr'' x s'. \<lbrakk>(tr', Result (x, s')) \<in> f s \<Longrightarrow> (tr'', res) \<in> g x s'; tr = tr'' @ tr'\<rbrakk> \<Longrightarrow> P\<rbrakk>
+   \<Longrightarrow> P"
   by (auto simp: bind_def2)
 
-text \<open> Each monad satisfies at least the following three laws. \<close>
-
-text \<open> @{term return} is absorbed at the left of a @{term bind},
-  applying the return value directly: \<close>
+text \<open>Each monad satisfies at least the following three laws.\<close>
 
 declare map_option.identity[simp]
 
-lemma return_bind [simp]: "(return x >>= f) = f x"
-  by (auto simp add: return_def bind_def split_def split:if_splits)
+text \<open>@{term return} is absorbed at the left of a @{term bind}, applying the return value directly:\<close>
+lemma return_bind[simp]:
+  "(return x >>= f) = f x"
+  by (simp add: return_def bind_def)
 
-text \<open> @{term return} is absorbed on the right of a @{term bind} \<close>
-lemma bind_return [simp]: "(m >>= return) = m"
-  by (auto simp add: fun_eq_iff bind_def return_def
+text \<open>@{term return} is absorbed on the right of a @{term bind}\<close>
+lemma bind_return[simp]:
+  "(m >>= return) = m"
+  by (auto simp: fun_eq_iff bind_def return_def
            split: tmres.splits)
 
-text \<open> @{term bind} is associative \<close>
+text \<open>@{term bind} is associative\<close>
 lemma bind_assoc:
   fixes m :: "('a,'b) tmonad"
   fixes f :: "'b \<Rightarrow> ('a,'c) tmonad"
@@ -293,7 +238,7 @@ lemma bind_assoc:
   apply (simp add: image_image)
   done
 
-section \<open> Adding Exceptions \<close>
+section \<open>Adding Exceptions\<close>
 
 text \<open>
   The type @{typ "('s,'a) tmonad"} gives us nondeterminism and
@@ -309,95 +254,61 @@ text \<open>
   we provide new names for the @{term return} and @{term bind} functions
   in this monad. We call them @{text returnOk} (for normal return values)
   and @{text bindE} (for composition). We also define @{text throwError}
-  to return an exceptional value.
-\<close>
-definition
-  returnOk :: "'a \<Rightarrow> ('s, 'e + 'a) tmonad"
-where
+  to return an exceptional value.\<close>
+definition returnOk :: "'a \<Rightarrow> ('s, 'e + 'a) tmonad" where
   "returnOk \<equiv> return o Inr"
 
-definition
-  throwError :: "'e \<Rightarrow> ('s, 'e + 'a) tmonad"
-where
+definition throwError :: "'e \<Rightarrow> ('s, 'e + 'a) tmonad" where
   "throwError \<equiv> return o Inl"
 
 text \<open>
   Lifting a function over the exception type: if the input is an
-  exception, return that exception; otherwise continue execution.
-\<close>
-definition
-  lift :: "('a \<Rightarrow> ('s, 'e + 'b) tmonad) \<Rightarrow>
-           'e +'a \<Rightarrow> ('s, 'e + 'b) tmonad"
-where
-  "lift f v \<equiv> case v of Inl e \<Rightarrow> throwError e
-                      | Inr v' \<Rightarrow> f v'"
+  exception, return that exception; otherwise continue execution.\<close>
+definition lift :: "('a \<Rightarrow> ('s, 'e + 'b) tmonad) \<Rightarrow> 'e +'a \<Rightarrow> ('s, 'e + 'b) tmonad" where
+  "lift f v \<equiv> case v of Inl e \<Rightarrow> throwError e | Inr v' \<Rightarrow> f v'"
 
 text \<open>
   The definition of @{term bind} in the exception monad (new
   name @{text bindE}): the same as normal @{term bind}, but
   the right-hand side is skipped if the left-hand side
-  produced an exception.
-\<close>
-definition
-  bindE :: "('s, 'e + 'a) tmonad \<Rightarrow>
-            ('a \<Rightarrow> ('s, 'e + 'b) tmonad) \<Rightarrow>
-            ('s, 'e + 'b) tmonad"  (infixl ">>=E" 60)
-where
-  "bindE f g \<equiv> bind f (lift g)"
-
+  produced an exception.\<close>
+definition bindE ::
+  "('s, 'e + 'a) tmonad \<Rightarrow> ('a \<Rightarrow> ('s, 'e + 'b) tmonad) \<Rightarrow> ('s, 'e + 'b) tmonad"
+  (infixl ">>=E" 60) where
+  "f >>=E g \<equiv> f >>= lift g"
 
 text \<open>
   Lifting a normal nondeterministic monad into the
   exception monad is achieved by always returning its
-  result as normal result and never throwing an exception.
-\<close>
-definition
-  liftE :: "('s,'a) tmonad \<Rightarrow> ('s, 'e+'a) tmonad"
-where
+  result as normal result and never throwing an exception.\<close>
+definition liftE :: "('s,'a) tmonad \<Rightarrow> ('s, 'e+'a) tmonad" where
   "liftE f \<equiv> f >>= (\<lambda>r. return (Inr r))"
 
-
 text \<open>
   Since the underlying type and @{text return} function changed,
-  we need new definitions for when and unless:
-\<close>
-definition
-  whenE :: "bool \<Rightarrow> ('s, 'e + unit) tmonad \<Rightarrow>
-            ('s, 'e + unit) tmonad"
-where
+  we need new definitions for when and unless:\<close>
+definition whenE :: "bool \<Rightarrow> ('s, 'e + unit) tmonad \<Rightarrow> ('s, 'e + unit) tmonad" where
   "whenE P f \<equiv> if P then f else returnOk ()"
 
-definition
-  unlessE :: "bool \<Rightarrow> ('s, 'e + unit) tmonad \<Rightarrow>
-            ('s, 'e + unit) tmonad"
-where
+definition unlessE :: "bool \<Rightarrow> ('s, 'e + unit) tmonad \<Rightarrow> ('s, 'e + unit) tmonad" where
   "unlessE P f \<equiv> if P then returnOk () else f"
 
-
 text \<open>
   Throwing an exception when the parameter is @{term None}, otherwise
-  returning @{term "v"} for @{term "Some v"}.
-\<close>
-definition
-  throw_opt :: "'e \<Rightarrow> 'a option \<Rightarrow> ('s, 'e + 'a) tmonad"
-where
-  "throw_opt ex x \<equiv>
-    case x of None \<Rightarrow> throwError ex | Some v \<Rightarrow> returnOk v"
-
+  returning @{term "v"} for @{term "Some v"}.\<close>
+definition throw_opt :: "'e \<Rightarrow> 'a option \<Rightarrow> ('s, 'e + 'a) tmonad" where
+  "throw_opt ex x \<equiv> case x of None \<Rightarrow> throwError ex | Some v \<Rightarrow> returnOk v"
 
 text \<open>
   Failure in the exception monad is redefined in the same way
   as @{const whenE} and @{const unlessE}, with @{term returnOk}
-  instead of @{term return}.
-\<close>
-definition
-  assertE :: "bool \<Rightarrow> ('a, 'e + unit) tmonad"
-where
+  instead of @{term return}.\<close>
+definition assertE :: "bool \<Rightarrow> ('a, 'e + unit) tmonad" where
   "assertE P \<equiv> if P then returnOk () else fail"
 
 subsection "Monad Laws for the Exception Monad"
 
-text \<open> More direct definition of @{const liftE}: \<close>
+text \<open>More direct definition of @{const liftE}:\<close>
 lemma liftE_def2:
   "liftE f = (\<lambda>s. snd_upd (map_tmres_rv Inr) ` (f s))"
   apply (clarsimp simp: fun_eq_iff liftE_def return_def split_def bind_def image_def)
@@ -414,52 +325,51 @@ lemma liftE_def2:
   apply (clarsimp split: tmres.splits)
   done
 
-text \<open> Left @{const returnOk} absorbtion over @{term bindE}: \<close>
-lemma returnOk_bindE [simp]: "(returnOk x >>=E f) = f x"
-  apply (unfold bindE_def returnOk_def)
-  apply (clarsimp simp: lift_def)
-  done
+text \<open>Left @{const returnOk} absorbtion over @{term bindE}:\<close>
+lemma returnOk_bindE[simp]: "(returnOk x >>=E f) = f x"
+  unfolding bindE_def returnOk_def
+  by (clarsimp simp: lift_def)
 
-lemma lift_return [simp]:
+lemma lift_return[simp]:
   "lift (return \<circ> Inr) = return"
-  by (simp add: fun_eq_iff lift_def throwError_def split: sum.splits)
+  by (auto simp: lift_def throwError_def split: sum.splits)
 
-text \<open> Right @{const returnOk} absorbtion over @{term bindE}: \<close>
-lemma bindE_returnOk [simp]: "(m >>=E returnOk) = m"
+text \<open>Right @{const returnOk} absorbtion over @{term bindE}:\<close>
+lemma bindE_returnOk[simp]:
+  "(m >>=E returnOk) = m"
   by (simp add: bindE_def returnOk_def)
 
-text \<open> Associativity of @{const bindE}: \<close>
+text \<open>Associativity of @{const bindE}:\<close>
 lemma bindE_assoc:
   "(m >>=E f) >>=E g = m >>=E (\<lambda>x. f x >>=E g)"
-  apply (simp add: bindE_def bind_assoc)
-  apply (rule arg_cong [where f="\<lambda>x. m >>= x"])
-  apply (rule ext)
-  apply (case_tac x, simp_all add: lift_def throwError_def)
-  done
+  unfolding bindE_def
+  by (fastforce simp: bind_assoc lift_def throwError_def
+                split: sum.splits
+                intro: arg_cong[where f="\<lambda>x. m >>= x"])
 
-text \<open> @{const returnOk} could also be defined via @{const liftE}: \<close>
+text \<open>@{const returnOk} could also be defined via @{const liftE}:\<close>
 lemma returnOk_liftE:
   "returnOk x = liftE (return x)"
   by (simp add: liftE_def returnOk_def)
 
-text \<open> Execution after throwing an exception is skipped: \<close>
-lemma throwError_bindE [simp]:
+text \<open>Execution after throwing an exception is skipped:\<close>
+lemma throwError_bindE[simp]:
   "(throwError E >>=E f) = throwError E"
-  by (simp add: fun_eq_iff bindE_def bind_def throwError_def lift_def return_def split_def)
+  by (simp add: bindE_def bind_def throwError_def lift_def return_def)
 
 
 section "Syntax"
 
-text \<open> This section defines traditional Haskell-like do-syntax
-  for the state monad in Isabelle. \<close>
+text \<open>This section defines traditional Haskell-like do-syntax
+  for the state monad in Isabelle.\<close>
 
-subsection "Syntax for the Nondeterministic State Monad"
+subsection "Syntax for the Interference Trace Monad"
 
-text \<open> We use @{text K_bind} to syntactically indicate the
-  case where the return argument of the left side of a @{term bind}
-  is ignored \<close>
-definition
-  K_bind_def [iff]: "K_bind \<equiv> \<lambda>x y. x"
+text \<open>
+  We use @{text K_bind} to syntactically indicate the case where the return argument
+  of the left side of a @{term bind} is ignored\<close>
+definition K_bind :: "'a \<Rightarrow> 'b \<Rightarrow> 'a" where
+  K_bind_def[iff]: "K_bind \<equiv> \<lambda>x y. x"
 
 nonterminal
   dobinds and dobind and nobind
@@ -479,7 +389,7 @@ translations
   "_do (_nobind b) e"      == "b >>= (CONST K_bind e)"
   "do x <- a; e od"        == "a >>= (\<lambda>x. e)"
 
-text \<open> Syntax examples: \<close>
+text \<open>Syntax examples:\<close>
 lemma "do x \<leftarrow> return 1;
           return (2::nat);
           return x
@@ -495,58 +405,12 @@ lemma "do x \<leftarrow> return 1;
        od = return 1"
   by simp
 
-subsection "Interference command"
-
-text \<open>Interference commands must be inserted in between actions that can be interfered with commands
-running in other threads. \<close>
-
-definition
-  last_st_tr :: "(tmid * 's) list \<Rightarrow> 's \<Rightarrow> 's"
-where
-  "last_st_tr tr s0 = (hd (map snd tr @ [s0]))"
-
-definition
-  env_steps :: "('s,unit) tmonad"
-where
-  "env_steps \<equiv>
-  do
-    s \<leftarrow> get;
-    \<comment> \<open>Add unfiltered environment events to the trace\<close>
-    xs \<leftarrow> select UNIV;
-    tr \<leftarrow> return (map (Pair Env) xs);
-    put_trace tr;
-    \<comment> \<open>Pick the last event of the trace as the final state\<close>
-    put (last_st_tr tr s)
-  od"
-
-definition
-  commit_step :: "('s, unit) tmonad"
-where
-  "commit_step \<equiv>
-  do
-    s \<leftarrow> get;
-    put_trace [(Me,s)]
-  od"
-
-definition
-  interference :: "('s,unit) tmonad"
-where
-  "interference \<equiv>
-  do
-    commit_step;
-    env_steps
-  od"
-
 subsection "Syntax for the Exception Monad"
 
 text \<open>
-  Since the exception monad is a different type, we
-  need to syntactically distinguish it in the syntax.
-  We use @{text doE}/@{text odE} for this, but can re-use
-  most of the productions from @{text do}/@{text od}
-  above.
-\<close>
-
+  Since the exception monad is a different type, we need to distinguish it in the syntax
+  if we want to avoid ambiguous terms. We use @{text doE}/@{text odE} for this, but can
+  re-use most of the productions from @{text do}/@{text od} above. \<close>
 syntax
   "_doE" :: "[dobinds, 'a] => 'a"  ("(doE ((_);//(_))//odE)" 100)
 
@@ -555,7 +419,7 @@ translations
   "_doE (_nobind b) e"      == "b >>=E (CONST K_bind e)"
   "doE x <- a; e odE"       == "a >>=E (\<lambda>x. e)"
 
-text \<open> Syntax examples: \<close>
+text \<open>Syntax examples:\<close>
 lemma "doE x \<leftarrow> returnOk 1;
            returnOk (2::nat);
            returnOk x
@@ -572,107 +436,110 @@ lemma "doE x \<leftarrow> returnOk 1;
   by simp
 
 
+subsection "Interference command"
+
+text \<open>
+  Interference commands must be inserted in between actions that can be interfered with by
+  commands running in other threads.\<close>
+
+definition last_st_tr :: "(tmid * 's) list \<Rightarrow> 's \<Rightarrow> 's" where
+  "last_st_tr tr s0 \<equiv> hd (map snd tr @ [s0])"
+
+definition env_steps :: "('s,unit) tmonad" where
+  "env_steps \<equiv>
+  do
+    s \<leftarrow> get;
+    \<comment> \<open>Add unfiltered environment events to the trace\<close>
+    xs \<leftarrow> select UNIV;
+    tr \<leftarrow> return (map (Pair Env) xs);
+    put_trace tr;
+    \<comment> \<open>Pick the last event of the trace as the final state\<close>
+    put (last_st_tr tr s)
+  od"
+
+definition commit_step :: "('s,unit) tmonad" where
+  "commit_step \<equiv>
+  do
+    s \<leftarrow> get;
+    put_trace [(Me,s)]
+  od"
+
+definition interference :: "('s,unit) tmonad" where
+  "interference \<equiv>
+  do
+    commit_step;
+    env_steps
+  od"
 
-section "Library of additional Monadic Functions and Combinators"
 
+section "Library of additional Monadic Functions and Combinators"
 
-text \<open> Lifting a normal function into the monad type: \<close>
-definition
-  liftM :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('s, 'b) tmonad"
-where
+text \<open>Lifting a normal function into the monad type:\<close>
+definition liftM :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('s, 'b) tmonad" where
   "liftM f m \<equiv> do x \<leftarrow> m; return (f x) od"
 
-text \<open> The same for the exception monad: \<close>
-definition
-  liftME :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s,'e+'a) tmonad \<Rightarrow> ('s,'e+'b) tmonad"
-where
+text \<open>The same for the exception monad:\<close>
+definition liftME :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s,'e+'a) tmonad \<Rightarrow> ('s,'e+'b) tmonad" where
   "liftME f m \<equiv> doE x \<leftarrow> m; returnOk (f x) odE"
 
-text \<open> Run a sequence of monads from left to right, ignoring return values. \<close>
-definition
-  sequence_x :: "('s, 'a) tmonad list \<Rightarrow> ('s, unit) tmonad"
-where
+text \<open>Run a sequence of monads from left to right, ignoring return values.\<close>
+definition sequence_x :: "('s, 'a) tmonad list \<Rightarrow> ('s, unit) tmonad" where
   "sequence_x xs \<equiv> foldr (\<lambda>x y. x >>= (\<lambda>_. y)) xs (return ())"
 
 text \<open>
   Map a monadic function over a list by applying it to each element
-  of the list from left to right, ignoring return values.
-\<close>
-definition
-  mapM_x :: "('a \<Rightarrow> ('s,'b) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s, unit) tmonad"
-where
+  of the list from left to right, ignoring return values.\<close>
+definition mapM_x :: "('a \<Rightarrow> ('s,'b) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s, unit) tmonad" where
   "mapM_x f xs \<equiv> sequence_x (map f xs)"
 
 text \<open>
   Map a monadic function with two parameters over two lists,
   going through both lists simultaneously, left to right, ignoring
-  return values.
-\<close>
-definition
-  zipWithM_x :: "('a \<Rightarrow> 'b \<Rightarrow> ('s,'c) tmonad) \<Rightarrow>
-                 'a list \<Rightarrow> 'b list \<Rightarrow> ('s, unit) tmonad"
-where
+  return values.\<close>
+definition zipWithM_x ::
+  "('a \<Rightarrow> 'b \<Rightarrow> ('s,'c) tmonad) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> ('s, unit) tmonad" where
   "zipWithM_x f xs ys \<equiv> sequence_x (zipWith f xs ys)"
 
-
-text \<open> The same three functions as above, but returning a list of
-return values instead of @{text unit} \<close>
-definition
-  sequence :: "('s, 'a) tmonad list \<Rightarrow> ('s, 'a list) tmonad"
-where
+text \<open>
+  The same three functions as above, but returning a list of
+  return values instead of @{text unit}\<close>
+definition sequence :: "('s, 'a) tmonad list \<Rightarrow> ('s, 'a list) tmonad" where
   "sequence xs \<equiv> let mcons = (\<lambda>p q. p >>= (\<lambda>x. q >>= (\<lambda>y. return (x#y))))
                  in foldr mcons xs (return [])"
 
-definition
-  mapM :: "('a \<Rightarrow> ('s,'b) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s, 'b list) tmonad"
-where
+definition mapM :: "('a \<Rightarrow> ('s,'b) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s, 'b list) tmonad" where
   "mapM f xs \<equiv> sequence (map f xs)"
 
-definition
-  zipWithM :: "('a \<Rightarrow> 'b \<Rightarrow> ('s,'c) tmonad) \<Rightarrow>
-                 'a list \<Rightarrow> 'b list \<Rightarrow> ('s, 'c list) tmonad"
-where
+definition zipWithM ::
+  "('a \<Rightarrow> 'b \<Rightarrow> ('s,'c) tmonad) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> ('s, 'c list) tmonad" where
   "zipWithM f xs ys \<equiv> sequence (zipWith f xs ys)"
 
-definition
-  foldM :: "('b \<Rightarrow> 'a \<Rightarrow> ('s, 'a) tmonad) \<Rightarrow> 'b list \<Rightarrow> 'a \<Rightarrow> ('s, 'a) tmonad"
-where
+definition foldM :: "('b \<Rightarrow> 'a \<Rightarrow> ('s, 'a) tmonad) \<Rightarrow> 'b list \<Rightarrow> 'a \<Rightarrow> ('s, 'a) tmonad" where
   "foldM m xs a \<equiv> foldr (\<lambda>p q. q >>= m p) xs (return a) "
 
-definition
-  foldME ::"('b \<Rightarrow> 'a \<Rightarrow> ('s,('e + 'b)) tmonad) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> ('s, ('e + 'b)) tmonad"
-where "foldME m a xs \<equiv> foldr (\<lambda>p q. q >>=E swp m p) xs (returnOk a)"
+definition foldME ::
+  "('b \<Rightarrow> 'a \<Rightarrow> ('s,('e + 'b)) tmonad) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> ('s, ('e + 'b)) tmonad" where
+  "foldME m a xs \<equiv> foldr (\<lambda>p q. q >>=E swp m p) xs (returnOk a)"
 
-text \<open> The sequence and map functions above for the exception monad,
-with and without lists of return value \<close>
-definition
-  sequenceE_x :: "('s, 'e+'a) tmonad list \<Rightarrow> ('s, 'e+unit) tmonad"
-where
+text \<open>
+  The sequence and map functions above for the exception monad, with and without
+  lists of return value\<close>
+definition sequenceE_x :: "('s, 'e+'a) tmonad list \<Rightarrow> ('s, 'e+unit) tmonad" where
   "sequenceE_x xs \<equiv> foldr (\<lambda>x y. doE _ <- x; y odE) xs (returnOk ())"
 
-definition
-  mapME_x :: "('a \<Rightarrow> ('s,'e+'b) tmonad) \<Rightarrow> 'a list \<Rightarrow>
-              ('s,'e+unit) tmonad"
-where
+definition mapME_x :: "('a \<Rightarrow> ('s,'e+'b) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s,'e+unit) tmonad" where
   "mapME_x f xs \<equiv> sequenceE_x (map f xs)"
 
-definition
-  sequenceE :: "('s, 'e+'a) tmonad list \<Rightarrow> ('s, 'e+'a list) tmonad"
-where
+definition sequenceE :: "('s, 'e+'a) tmonad list \<Rightarrow> ('s, 'e+'a list) tmonad" where
   "sequenceE xs \<equiv> let mcons = (\<lambda>p q. p >>=E (\<lambda>x. q >>=E (\<lambda>y. returnOk (x#y))))
-                 in foldr mcons xs (returnOk [])"
+                   in foldr mcons xs (returnOk [])"
 
-definition
-  mapME :: "('a \<Rightarrow> ('s,'e+'b) tmonad) \<Rightarrow> 'a list \<Rightarrow>
-              ('s,'e+'b list) tmonad"
-where
+definition mapME :: "('a \<Rightarrow> ('s,'e+'b) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s,'e+'b list) tmonad" where
   "mapME f xs \<equiv> sequenceE (map f xs)"
 
 
-text \<open> Filtering a list using a monadic function as predicate: \<close>
-primrec
-  filterM :: "('a \<Rightarrow> ('s, bool) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s, 'a list) tmonad"
-where
+text \<open>Filtering a list using a monadic function as predicate:\<close>
+primrec filterM :: "('a \<Rightarrow> ('s, bool) tmonad) \<Rightarrow> 'a list \<Rightarrow> ('s, 'a list) tmonad" where
   "filterM P []       = return []"
 | "filterM P (x # xs) = do
      b  <- P x;
@@ -680,13 +547,10 @@ where
      return (if b then (x # ys) else ys)
    od"
 
-text \<open> @{text select_state} takes a relationship between
-  states, and outputs nondeterministically a state
-  related to the input state. \<close>
-
-definition
-  state_select :: "('s \<times> 's) set \<Rightarrow> ('s, unit) tmonad"
-where
+text \<open>
+  @{text select_state} takes a relationship between states, and outputs
+  nondeterministically a state related to the input state.\<close>
+definition state_select :: "('s \<times> 's) set \<Rightarrow> ('s, unit) tmonad" where
   "state_select r \<equiv> (do
     s \<leftarrow> get;
     S \<leftarrow> return {s'. (s, s') \<in> r};
@@ -694,17 +558,15 @@ where
     s' \<leftarrow> select S;
     put s'
   od)"
+
+
 section "Catching and Handling Exceptions"
 
 text \<open>
   Turning an exception monad into a normal state monad
-  by catching and handling any potential exceptions:
-\<close>
-definition
-  catch :: "('s, 'e + 'a) tmonad \<Rightarrow>
-            ('e \<Rightarrow> ('s, 'a) tmonad) \<Rightarrow>
-            ('s, 'a) tmonad" (infix "<catch>" 10)
-where
+  by catching and handling any potential exceptions:\<close>
+definition catch ::
+  "('s, 'e + 'a) tmonad \<Rightarrow> ('e \<Rightarrow> ('s, 'a) tmonad) \<Rightarrow> ('s, 'a) tmonad" (infix "<catch>" 10) where
   "f <catch> handler \<equiv>
      do x \<leftarrow> f;
         case x of
@@ -715,13 +577,10 @@ where
 text \<open>
   Handling exceptions, but staying in the exception monad.
   The handler may throw a type of exceptions different from
-  the left side.
-\<close>
-definition
-  handleE' :: "('s, 'e1 + 'a) tmonad \<Rightarrow>
-               ('e1 \<Rightarrow> ('s, 'e2 + 'a) tmonad) \<Rightarrow>
-               ('s, 'e2 + 'a) tmonad" (infix "<handle2>" 10)
-where
+  the left side.\<close>
+definition handleE' ::
+  "('s, 'e1 + 'a) tmonad \<Rightarrow> ('e1 \<Rightarrow> ('s, 'e2 + 'a) tmonad) \<Rightarrow> ('s, 'e2 + 'a) tmonad"
+  (infix "<handle2>" 10) where
   "f <handle2> handler \<equiv>
    do
       v \<leftarrow> f;
@@ -733,27 +592,19 @@ where
 text \<open>
   A type restriction of the above that is used more commonly in
   practice: the exception handle (potentially) throws exception
-  of the same type as the left-hand side.
-\<close>
-definition
-  handleE :: "('s, 'x + 'a) tmonad \<Rightarrow>
-              ('x \<Rightarrow> ('s, 'x + 'a) tmonad) \<Rightarrow>
-              ('s, 'x + 'a) tmonad" (infix "<handle>" 10)
-where
+  of the same type as the left-hand side.\<close>
+definition handleE ::
+  "('s, 'x + 'a) tmonad \<Rightarrow> ('x \<Rightarrow> ('s, 'x + 'a) tmonad) \<Rightarrow> ('s, 'x + 'a) tmonad"
+  (infix "<handle>" 10) where
   "handleE \<equiv> handleE'"
 
-
 text \<open>
   Handling exceptions, and additionally providing a continuation
-  if the left-hand side throws no exception:
-\<close>
-definition
-  handle_elseE :: "('s, 'e + 'a) tmonad \<Rightarrow>
-                   ('e \<Rightarrow> ('s, 'ee + 'b) tmonad) \<Rightarrow>
-                   ('a \<Rightarrow> ('s, 'ee + 'b) tmonad) \<Rightarrow>
-                   ('s, 'ee + 'b) tmonad"
-  ("_ <handle> _ <else> _" 10)
-where
+  if the left-hand side throws no exception:\<close>
+definition handle_elseE ::
+  "('s, 'e + 'a) tmonad \<Rightarrow> ('e \<Rightarrow> ('s, 'ee + 'b) tmonad) \<Rightarrow> ('a \<Rightarrow> ('s, 'ee + 'b) tmonad) \<Rightarrow>
+   ('s, 'ee + 'b) tmonad"
+  ("_ <handle> _ <else> _" 10) where
   "f <handle> handler <else> continue \<equiv>
    do v \<leftarrow> f;
    case v of Inl e  \<Rightarrow> handler e
@@ -765,57 +616,53 @@ subsection "Loops"
 text \<open>
   Loops are handled using the following inductive predicate;
   non-termination is represented using the failure flag of the
-  monad.
-\<close>
-inductive_set
-  whileLoop_results :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> (('r \<times> 's) \<times> ((tmid \<times> 's) list \<times> ('s, 'r) tmres)) set"
-  for C B
-where
+  monad.\<close>
+
+inductive_set whileLoop_results ::
+  "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> (('r \<times> 's) \<times> ((tmid \<times> 's) list \<times> ('s, 'r) tmres)) set"
+  for C B where
     "\<lbrakk> \<not> C r s \<rbrakk> \<Longrightarrow> ((r, s), ([], Result (r, s))) \<in> whileLoop_results C B"
   | "\<lbrakk> C r s; (ts, Failed) \<in> B r s \<rbrakk> \<Longrightarrow> ((r, s), (ts, Failed)) \<in> whileLoop_results C B"
   | "\<lbrakk> C r s; (ts, Incomplete) \<in> B r s \<rbrakk> \<Longrightarrow> ((r, s), (ts, Incomplete)) \<in> whileLoop_results C B"
   | "\<lbrakk> C r s; (ts, Result (r', s')) \<in> B r s; ((r', s'), (ts',z)) \<in> whileLoop_results C B  \<rbrakk>
        \<Longrightarrow> ((r, s), (ts'@ts,z)) \<in> whileLoop_results C B"
 
+\<comment> \<open>FIXME: there are fewer lemmas here than in NonDetMonad and I don't understand this well enough
+  to know whether this is correct or not.\<close>
 inductive_cases whileLoop_results_cases_result_end: "((x,y), ([],Result r)) \<in> whileLoop_results C B"
 inductive_cases whileLoop_results_cases_fail: "((x,y), (ts, Failed)) \<in> whileLoop_results C B"
 inductive_cases whileLoop_results_cases_incomplete: "((x,y), (ts, Incomplete)) \<in> whileLoop_results C B"
 
 inductive_simps whileLoop_results_simps_valid: "((x,y), ([], Result z)) \<in> whileLoop_results C B"
 
-inductive
-  whileLoop_terminates :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> 's \<Rightarrow> bool"
-  for C B
-where
+inductive whileLoop_terminates ::
+  "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> 's \<Rightarrow> bool"
+  for C B where
     "\<not> C r s \<Longrightarrow> whileLoop_terminates C B r s"
   | "\<lbrakk> C r s; \<forall>(r', s') \<in> Result -` snd ` (B r s). whileLoop_terminates C B r' s' \<rbrakk>
         \<Longrightarrow> whileLoop_terminates C B r s"
 
-
 inductive_cases whileLoop_terminates_cases: "whileLoop_terminates C B r s"
 inductive_simps whileLoop_terminates_simps: "whileLoop_terminates C B r s"
 
-definition
-  whileLoop :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> ('s, 'r) tmonad"
-where
+definition whileLoop ::
+  "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> ('s, 'r) tmonad" where
   "whileLoop C B \<equiv> (\<lambda>r s. {(ts, res). ((r,s), ts,res) \<in> whileLoop_results C B})"
 
 notation (output)
   whileLoop  ("(whileLoop (_)//  (_))" [1000, 1000] 1000)
 
-definition
-  whileLoopT :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> ('s, 'r) tmonad"
-where
+\<comment> \<open>FIXME: why does this differ to Nondet_Monad?\<close>
+definition whileLoopT ::
+  "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> ('s, 'r) tmonad" where
   "whileLoopT C B \<equiv> (\<lambda>r s. {(ts, res). ((r,s), ts,res) \<in> whileLoop_results C B
                                          \<and> whileLoop_terminates C B r s})"
 
 notation (output)
   whileLoopT  ("(whileLoopT (_)//  (_))" [1000, 1000] 1000)
 
-definition
-  whileLoopE :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'e + 'r) tmonad)
-      \<Rightarrow> 'r \<Rightarrow> ('s, ('e + 'r)) tmonad"
-where
+definition whileLoopE ::
+  "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'e + 'r) tmonad) \<Rightarrow> 'r \<Rightarrow> ('s, ('e + 'r)) tmonad" where
   "whileLoopE C body \<equiv>
       \<lambda>r. whileLoop (\<lambda>r s. (case r of Inr v \<Rightarrow> C v s | _ \<Rightarrow> False)) (lift body) (Inr r)"
 
@@ -824,13 +671,9 @@ notation (output)
 
 subsection "Await command"
 
-text \<open> @{term "Await c f"} blocks the execution until the @{term "c"} is true,
-      and atomically executes @{term "f"}.
-\<close>
-
-definition
-  Await :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,unit) tmonad"
-where
+text \<open>@{term "Await c f"} blocks the execution until @{term "c"} is true,
+      and then atomically executes @{term "f"}.\<close>
+definition Await :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,unit) tmonad" where
   "Await c \<equiv>
   do
     s \<leftarrow> get;
@@ -843,19 +686,21 @@ where
     put (last_st_tr tr s)
   od"
 
+
 section "Hoare Logic"
 
 subsection "Validity"
 
-text \<open> This section defines a Hoare logic for partial correctness for
-  the nondeterministic state monad as well as the exception monad.
+text \<open>
+  This section defines a Hoare logic for partial correctness for
+  the interference trace monad as well as the exception monad.
   The logic talks only about the behaviour part of the monad and ignores
   the failure flag.
 
   The logic is defined semantically. Rules work directly on the
   validity predicate.
 
-  In the nondeterministic state monad, validity is a triple of precondition,
+  In the interference trace monad, validity is a triple of precondition,
   monad, and postcondition. The precondition is a function from state to
   bool (a state predicate), the postcondition is a function from return value
   to state to bool. A triple is valid if for all states that satisfy the
@@ -864,52 +709,40 @@ text \<open> This section defines a Hoare logic for partial correctness for
   the empty set, the triple is trivially valid. This means @{term "assert P"}
   does not require us to prove that @{term P} holds, but rather allows us
   to assume @{term P}! Proving non-failure is done via separate predicate and
-  calculus (see below).
-\<close>
-
+  calculus (see below).\<close>
 
-definition
-  valid :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>")
-where
+definition valid :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>") where
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). Q r s')"
 
 text \<open>
   We often reason about invariant predicates. The following provides shorthand syntax
-  that avoids repeating potentially long predicates.
-\<close>
-abbreviation (input)
-  invariant :: "('s,'a) tmonad \<Rightarrow> ('s \<Rightarrow> bool) \<Rightarrow> bool" ("_ \<lbrace>_\<rbrace>" [59,0] 60)
-where
+  that avoids repeating potentially long predicates.\<close>
+abbreviation (input) invariant ::
+  "('s,'a) tmonad \<Rightarrow> ('s \<Rightarrow> bool) \<Rightarrow> bool" ("_ \<lbrace>_\<rbrace>" [59,0] 60) where
   "invariant f P \<equiv> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. P\<rbrace>"
 
-text \<open>rg_pred type: Rely-Guaranty predicates (state before => state after => bool)\<close>
-type_synonym 's rg_pred = "'s \<Rightarrow> 's \<Rightarrow> bool"
-
-
 text \<open>
   Validity for the exception monad is similar and build on the standard
   validity above. Instead of one postcondition, we have two: one for
-  normal and one for exceptional results.
-\<close>
-definition
-  validE :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow>
-             ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow>
-             ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)" )
-where
+  normal and one for exceptional results.\<close>
+definition validE ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)" ) where
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<lbrace>P\<rbrace> f \<lbrace> \<lambda>v s. case v of Inr r \<Rightarrow> Q r s | Inl e \<Rightarrow> E e s \<rbrace>"
+
+lemma validE_def2:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). case r of Inr b \<Rightarrow> Q b s' | Inl a \<Rightarrow> E a s')"
+  by (unfold valid_def validE_def)
 (*
-text \<open> Validity for exception monad with interferences. Not as easy to phrase
- as we need to  \<close>
-definition
-  validIE :: "('s, 'a + 'b) tmonad \<Rightarrow>
+text \<open>Validity for exception monad with interferences. Not as easy to phrase
+ as we need to \<close>
+definition validIE :: "('s, 'a + 'b) tmonad \<Rightarrow>
              's rg_pred \<Rightarrow>
              's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
              ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
              ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
- ("_ //PRE _//RELY _//GUAR _//POST _//EXC _" [59,0,0,0,0,0] 60)
-where
+ ("_ //PRE _//RELY _//GUAR _//POST _//EXC _" [59,0,0,0,0,0] 60) where
   "validIE f P R G Q E \<equiv> f SAT [P,R,G,\<lambda>v. case v of Inr r \<Rightarrow> Q r | Inl e \<Rightarrow> E e]"
 
 abbreviation (input)
@@ -923,81 +756,66 @@ abbreviation (input)
   "validIEsat f P R G Q E \<equiv> validIE f P R G Q E"
  *)
 text \<open>
-  The following two instantiations are convenient to separate reasoning
-  for exceptional and normal case.
-\<close>
-definition
-  validE_R :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow>
-               ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-   ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>, -")
-where
+  The following two instantiations are convenient to separate reasoning for exceptional and
+  normal case.\<close>
+(* Narrator: they are in fact not convenient, and are now considered a mistake that should have
+             been an abbreviation instead. *)
+definition validE_R :: (* FIXME lib: this should be an abbreviation *)
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>, -") where
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<equiv> validE P f Q (\<lambda>x y. True)"
 
-definition
-  validE_E :: "('s \<Rightarrow> bool) \<Rightarrow>  ('s, 'e + 'a) tmonad \<Rightarrow>
-               ('e \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-   ("\<lbrace>_\<rbrace>/ _ /-, \<lbrace>_\<rbrace>")
-where
+definition validE_E :: (* FIXME lib: this should be an abbreviation *)
+  "('s \<Rightarrow> bool) \<Rightarrow>  ('s, 'e + 'a) tmonad \<Rightarrow> ('e \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /-, \<lbrace>_\<rbrace>") where
   "\<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace> \<equiv> validE P f (\<lambda>x y. True) Q"
 
 
-text \<open> Abbreviations for trivial postconditions (taking three arguments): \<close>
+text \<open>rg_pred type: Rely-Guaranty predicates (state before => state after => bool)\<close>
+type_synonym 's rg_pred = "'s \<Rightarrow> 's \<Rightarrow> bool"
+
+text \<open>Abbreviations for trivial postconditions (taking three arguments):\<close>
 abbreviation(input)
-  toptoptop :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>\<top>")
-where
+  toptoptop :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>\<top>") where
   "\<top>\<top>\<top> \<equiv> \<lambda>_ _ _. True"
 
 abbreviation(input)
-  botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>")
-where
+  botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>") where
   "\<bottom>\<bottom>\<bottom> \<equiv> \<lambda>_ _ _. False"
 
 
 subsection "Determinism"
 
-text \<open> A monad of type @{text tmonad} is deterministic iff it
-returns an empty trace, exactly one state and result and does not fail \<close>
-definition
-  det :: "('a,'s) tmonad \<Rightarrow> bool"
-where
+text \<open>
+  A monad of type @{text tmonad} is deterministic iff it
+  returns an empty trace, exactly one state and result and does not fail\<close>
+definition det :: "('a,'s) tmonad \<Rightarrow> bool" where
   "det f \<equiv> \<forall>s. \<exists>r. f s = {([], Result r)}"
 
-text \<open> A deterministic @{text tmonad} can be turned
-  into a normal state monad: \<close>
-definition
-  the_run_state :: "('s,'a) tmonad \<Rightarrow> 's \<Rightarrow> 'a \<times> 's"
-where
+text \<open>A deterministic @{text tmonad} can be turned into a normal state monad:\<close>
+definition the_run_state :: "('s,'a) tmonad \<Rightarrow> 's \<Rightarrow> 'a \<times> 's" where
   "the_run_state M \<equiv> \<lambda>s. THE s'. mres (M s) = {s'}"
 
 
 subsection "Non-Failure"
 
 text \<open>
-  We can formulate non-failure separately from validity.
+  With the failure flag, we can formulate non-failure separately from validity.
+  A monad @{text m} does not fail under precondition @{text P}, if for no start
+  state that satisfies the precondition it sets the failure flag.
 \<close>
-definition
-  no_fail :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> bool"
-where
+definition no_fail :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> bool" where
   "no_fail P m \<equiv> \<forall>s. P s \<longrightarrow> Failed \<notin> snd ` (m s)"
 
 text \<open>
-  It is often desired to prove non-failure and a Hoare triple
-  simultaneously, as the reasoning is often similar. The following
-  definitions allow such reasoning to take place.
-\<close>
+  It is often desired to prove non-failure and a Hoare triple simultaneously, as the reasoning
+  is often similar. The following definitions allow such reasoning to take place.\<close>
 
-definition
-  validNF ::"('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-      ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>!")
-where
+definition validNF ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>!") where
   "validNF P f Q \<equiv> valid P f Q \<and> no_fail P f"
 
-definition
-  validE_NF :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow>
-             ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow>
-             ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>!)")
-where
+definition validE_NF ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>!)") where
   "validE_NF P f Q E \<equiv> validE P f Q E \<and> no_fail P f"
 
 lemma validE_NF_alt_def:
@@ -1007,39 +825,31 @@ lemma validE_NF_alt_def:
 (* text \<open>
   Usually, well-formed monads constructed from the primitives
   above will have the following property: if they return an
-  empty set of results, they will have the failure flag set.
-\<close>
-definition
-  empty_fail :: "('s,'a) tmonad \<Rightarrow> bool"
-where
+  empty set of results, they will have the failure flag set.\<close>
+definition empty_fail :: "('s,'a) tmonad \<Rightarrow> bool" where
   "empty_fail m \<equiv> \<forall>s. fst (m s) = {} \<longrightarrow> snd (m s)"
 
 text \<open>
   Useful in forcing otherwise unknown executions to have
-  the @{const empty_fail} property.
-\<close>
-definition
-  mk_ef :: "'a set \<times> bool \<Rightarrow> 'a set \<times> bool"
-where
+  the @{const empty_fail} property.\<close>
+definition mk_ef :: "'a set \<times> bool \<Rightarrow> 'a set \<times> bool" where
   "mk_ef S \<equiv> (fst S, fst S = {} \<or> snd S)"
  *)
 section "Basic exception reasoning"
 
 text \<open>
-  The following predicates @{text no_throw} and @{text no_return} allow
-  reasoning that functions in the exception monad either do
-  no throw an exception or never return normally.
-\<close>
+  The predicates @{text no_throw} and @{text no_return} allow us to reason about functions in
+  the exception monad that never throw an exception or never return normally.\<close>
 
-definition "no_throw P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace> \<lambda>_ _. True \<rbrace>,\<lbrace> \<lambda>_ _. False \<rbrace>"
+definition no_throw :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow> bool" where
+  "no_throw P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace> \<lambda>_ _. True \<rbrace>,\<lbrace> \<lambda>_ _. False \<rbrace>"
 
-definition "no_return P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace>\<lambda>_ _. False\<rbrace>,\<lbrace>\<lambda>_ _. True \<rbrace>"
+definition no_return :: "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'b + 'c) tmonad \<Rightarrow> bool" where
+  "no_return P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace>\<lambda>_ _. False\<rbrace>,\<lbrace>\<lambda>_ _. True \<rbrace>"
 
 section "Trace monad Parallel"
 
-definition
-  parallel :: "('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad"
-where
+definition parallel :: "('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad" where
   "parallel f g = (\<lambda>s. {(xs, rv). \<exists>f_steps. length f_steps = length xs
     \<and> (map (\<lambda>(f_step, (id, s)). (if f_step then id else Env, s)) (zip f_steps xs), rv) \<in> f s
     \<and> (map (\<lambda>(f_step, (id, s)). (if f_step then Env else id, s)) (zip f_steps xs), rv) \<in> g s})"
@@ -1072,8 +882,7 @@ lemma parallel_def3:
   by (simp add: parallel_def2, rule ext, auto simp: image_def)
 
 primrec
-  trace_steps :: "(tmid \<times> 's) list \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's \<times> 's) set"
-where
+  trace_steps :: "(tmid \<times> 's) list \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's \<times> 's) set" where
   "trace_steps (elem # trace) s0 = {(fst elem, s0, snd elem)} \<union> trace_steps trace (snd elem)"
 | "trace_steps [] s0 = {}"
 
@@ -1091,14 +900,10 @@ next
     done
 qed
 
-definition
-  rely_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool"
-where
+definition rely_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
   "rely_cond R s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Env \<longrightarrow> R s0 s)"
 
-definition
-  guar_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool"
-where
+definition guar_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
   "guar_cond G s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Me \<longrightarrow> G s0 s)"
 
 lemma rg_empty_conds[simp]:
@@ -1106,21 +911,15 @@ lemma rg_empty_conds[simp]:
   "guar_cond G s0s []"
   by (simp_all add: rely_cond_def guar_cond_def)
 
-definition
-  rely :: "('s, 'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> 's \<Rightarrow> ('s, 'a) tmonad"
-where
+definition rely :: "('s, 'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> 's \<Rightarrow> ('s, 'a) tmonad" where
   "rely f R s0s \<equiv> (\<lambda>s. f s \<inter> ({tr. rely_cond R s0s tr} \<times> UNIV))"
 
-definition
-  prefix_closed :: "('s, 'a) tmonad \<Rightarrow> bool"
-where
+definition prefix_closed :: "('s, 'a) tmonad \<Rightarrow> bool" where
   "prefix_closed f = (\<forall>s. \<forall>x xs. (x # xs) \<in> fst ` f s \<longrightarrow> (xs, Incomplete) \<in> f s)"
 
-definition
-  validI :: "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's rg_pred \<Rightarrow> ('s,'a) tmonad
-    \<Rightarrow> 's rg_pred \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)")
-where
+definition validI ::
+  "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's rg_pred \<Rightarrow> ('s,'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)") where
   "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> \<equiv> prefix_closed f \<and> (\<forall>s0 s. P s0 s
     \<longrightarrow> (\<forall>tr res. (tr, res) \<in> (rely f R s0 s) \<longrightarrow> guar_cond G s0 tr
         \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
@@ -1129,13 +928,14 @@ lemma in_rely:
   "\<lbrakk> (tr, res) \<in> f s; rely_cond R s0s tr \<rbrakk> \<Longrightarrow> (tr, res) \<in> rely f R s0s s"
   by (simp add: rely_def)
 
-lemmas validI_D = validI_def[THEN meta_eq_to_obj_eq, THEN iffD1,
-    THEN conjunct2, rule_format, OF _ _ in_rely]
+lemmas validI_D =
+  validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, rule_format, OF _ _ in_rely]
 lemmas validI_GD = validI_D[THEN conjunct1]
 lemmas validI_rvD = validI_D[THEN conjunct2, rule_format, rotated -1, OF refl]
 lemmas validI_prefix_closed = validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct1]
-lemmas validI_prefix_closed_T = validI_prefix_closed[where P="\<lambda>_ _. False" and R="\<lambda>_ _. False"
-    and G="\<lambda>_ _. True" and Q="\<lambda>_ _ _. True"]
+lemmas validI_prefix_closed_T =
+  validI_prefix_closed[where P="\<lambda>_ _. False" and R="\<lambda>_ _. False" and G="\<lambda>_ _. True"
+                         and Q="\<lambda>_ _ _. True"]
 
 lemmas prefix_closedD1 = prefix_closed_def[THEN iffD1, rule_format]
 

From ff808a094409945c430610a9f343b6c9c95cba77 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Wed, 19 Jul 2023 22:12:09 +1000
Subject: [PATCH 2/5] lib/monads: refactor trace monad theories

This splits material out of Trace_Monad and Trace_VCG and into more
specific theories, following the same approach and structure as the
nondet theories. This commit is mainly focused on definitions and lemmas
that also appear in the nondet monad; trace monad concepts are left
where they are for now.

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 lib/Monads/ROOT                             |    1 +
 lib/Monads/trace/Trace_Det.thy              |   75 +
 lib/Monads/trace/Trace_In_Monad.thy         |  137 +
 lib/Monads/trace/Trace_Lemmas.thy           |  404 +--
 lib/Monads/trace/Trace_Lemmas_Old.thy       |  335 ++
 lib/Monads/trace/Trace_Monad.thy            |  174 +-
 lib/Monads/trace/Trace_Monad_Equations.thy  |   48 +
 lib/Monads/trace/Trace_More_VCG.thy         |   20 +
 lib/Monads/trace/Trace_No_Fail.thy          |  142 +
 lib/Monads/trace/Trace_No_Throw.thy         |   28 +
 lib/Monads/trace/Trace_Sat.thy              |  111 +
 lib/Monads/trace/Trace_Strengthen_Setup.thy |   46 +
 lib/Monads/trace/Trace_Total.thy            |  346 +++
 lib/Monads/trace/Trace_VCG.thy              | 3111 +++++++------------
 14 files changed, 2427 insertions(+), 2551 deletions(-)
 create mode 100644 lib/Monads/trace/Trace_Det.thy
 create mode 100644 lib/Monads/trace/Trace_In_Monad.thy
 create mode 100644 lib/Monads/trace/Trace_Lemmas_Old.thy
 create mode 100644 lib/Monads/trace/Trace_Monad_Equations.thy
 create mode 100644 lib/Monads/trace/Trace_More_VCG.thy
 create mode 100644 lib/Monads/trace/Trace_No_Fail.thy
 create mode 100644 lib/Monads/trace/Trace_No_Throw.thy
 create mode 100644 lib/Monads/trace/Trace_Sat.thy
 create mode 100644 lib/Monads/trace/Trace_Strengthen_Setup.thy
 create mode 100644 lib/Monads/trace/Trace_Total.thy

diff --git a/lib/Monads/ROOT b/lib/Monads/ROOT
index 5cfb076f10..5fe32ad49e 100644
--- a/lib/Monads/ROOT
+++ b/lib/Monads/ROOT
@@ -48,6 +48,7 @@ session Monads (lib) = HOL +
     Trace_Monad
     Trace_Lemmas
     Trace_VCG
+    Trace_Det
     Strengthen
     Nondet_Strengthen_Setup
     Strengthen_Demo
diff --git a/lib/Monads/trace/Trace_Det.thy b/lib/Monads/trace/Trace_Det.thy
new file mode 100644
index 0000000000..4b17f18dbf
--- /dev/null
+++ b/lib/Monads/trace/Trace_Det.thy
@@ -0,0 +1,75 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_Det
+  imports
+    Trace_Monad
+begin
+
+subsection "Determinism"
+
+text \<open>
+  A monad of type @{text tmonad} is deterministic iff it
+  returns an empty trace, exactly one state and result and does not fail\<close>
+definition det :: "('a,'s) tmonad \<Rightarrow> bool" where
+  "det f \<equiv> \<forall>s. \<exists>r. f s = {([], Result r)}"
+
+text \<open>A deterministic @{text tmonad} can be turned into a normal state monad:\<close>
+definition the_run_state :: "('s,'a) tmonad \<Rightarrow> 's \<Rightarrow> 'a \<times> 's" where
+  "the_run_state M \<equiv> \<lambda>s. THE s'. mres (M s) = {s'}"
+
+
+lemma det_set_iff:
+  "det f \<Longrightarrow> (r \<in> mres (f s)) = (mres (f s) = {r})"
+  unfolding det_def mres_def
+  by (fastforce elim: allE[where x=s])
+
+lemma return_det[iff]:
+  "det (return x)"
+  by (simp add: det_def return_def)
+
+lemma put_det[iff]:
+  "det (put s)"
+  by (simp add: det_def put_def)
+
+lemma get_det[iff]:
+  "det get"
+  by (simp add: det_def get_def)
+
+lemma det_gets[iff]:
+  "det (gets f)"
+  by (auto simp add: gets_def det_def get_def return_def bind_def)
+
+lemma det_UN:
+  "det f \<Longrightarrow> (\<Union>x \<in> mres (f s). g x) = (g (THE x. x \<in> mres (f s)))"
+  unfolding det_def mres_def
+  apply simp
+  apply (drule spec [of _ s])
+  apply (clarsimp simp: vimage_def)
+  done
+
+lemma bind_detI[simp, intro!]:
+  "\<lbrakk> det f; \<forall>x. det (g x) \<rbrakk> \<Longrightarrow> det (f >>= g)"
+  unfolding bind_def det_def
+  apply clarsimp
+  apply (erule_tac x=s in allE)
+  apply clarsimp
+  done
+
+lemma det_modify[iff]:
+  "det (modify f)"
+  by (simp add: modify_def)
+
+lemma the_run_stateI:
+  "mres (M s) = {s'} \<Longrightarrow> the_run_state M s = s'"
+  by (simp add: the_run_state_def)
+
+lemma the_run_state_det:
+  "\<lbrakk> s' \<in> mres (M s); det M \<rbrakk> \<Longrightarrow> the_run_state M s = s'"
+  by (simp add: the_run_stateI det_set_iff)
+
+end
diff --git a/lib/Monads/trace/Trace_In_Monad.thy b/lib/Monads/trace/Trace_In_Monad.thy
new file mode 100644
index 0000000000..073d4096be
--- /dev/null
+++ b/lib/Monads/trace/Trace_In_Monad.thy
@@ -0,0 +1,137 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_In_Monad
+  imports Trace_Lemmas
+begin
+
+section \<open>Reasoning directly about states\<close>
+
+(* Lemmas about terms of the form "(v, s') \<in> mres (m s)" *)
+
+lemma in_throwError:
+  "((v, s') \<in> mres (throwError e s)) = (v = Inl e \<and> s' = s)"
+  by (simp add: throwError_def return_def mres_def)
+
+lemma in_returnOk:
+  "((v', s') \<in> mres (returnOk v s)) = (v' = Inr v \<and> s' = s)"
+  by (simp add: returnOk_def return_def mres_def)
+
+lemma in_bind:
+  "((r,s') \<in> mres ((do x \<leftarrow> f; g x od) s)) =
+   (\<exists>s'' x. (x, s'') \<in> mres (f s) \<and> (r, s') \<in> mres (g x s''))"
+  by (force simp: bind_def split_def mres_def split: tmres.splits)
+
+lemma in_bindE_R:
+  "((Inr r,s') \<in> mres ((doE x \<leftarrow> f; g x odE) s)) =
+  (\<exists>s'' x. (Inr x, s'') \<in> mres (f s) \<and> (Inr r, s') \<in> mres (g x s''))"
+  unfolding bindE_def lift_def split_def in_bind
+  by (force simp: throwError_def return_def mres_def split: sum.splits)
+
+lemma in_bindE_L:
+  "((Inl r, s') \<in> mres ((doE x \<leftarrow> f; g x odE) s)) \<Longrightarrow>
+   (\<exists>s'' x. (Inr x, s'') \<in> mres (f s) \<and> (Inl r, s') \<in> mres (g x s'')) \<or> ((Inl r, s') \<in> mres (f s))"
+  by (simp add: bindE_def in_bind)
+     (force simp: return_def throwError_def lift_def split_def mres_def split: sum.splits if_split_asm)
+
+lemma in_return:
+  "(r, s') \<in> mres (return v s) = (r = v \<and> s' = s)"
+  by (simp add: return_def mres_def)
+
+lemma in_liftE:
+  "((v, s') \<in> mres (liftE f s)) = (\<exists>v'. v = Inr v' \<and> (v', s') \<in> mres (f s))"
+  by (force simp: liftE_def in_bind in_return)
+
+lemma in_whenE:
+  "((v, s') \<in> mres (whenE P f s)) = ((P \<longrightarrow> (v, s') \<in> mres (f s)) \<and> (\<not>P \<longrightarrow> v = Inr () \<and> s' = s))"
+  by (simp add: whenE_def in_returnOk)
+
+lemma inl_whenE:
+  "((Inl x, s') \<in> mres (whenE P f s)) = (P \<and> (Inl x, s') \<in> mres (f s))"
+  by (auto simp add: in_whenE)
+
+lemma in_fail:
+  "r \<in> mres (fail s) = False"
+  by (simp add: fail_def mres_def)
+
+lemma in_assert:
+  "(r, s') \<in> mres (assert P s) = (P \<and> s' = s)"
+  by (simp add: assert_def return_def fail_def mres_def)
+
+lemma in_assertE:
+  "(r, s') \<in> mres (assertE P s) = (P \<and> r = Inr () \<and> s' = s)"
+  by (simp add: assertE_def returnOk_def return_def fail_def mres_def)
+
+lemma in_assert_opt:
+  "(r, s') \<in> mres (assert_opt v s) = (v = Some r \<and> s' = s)"
+  by (auto simp: assert_opt_def in_fail in_return split: option.splits)
+
+lemma in_get:
+  "(r, s') \<in> mres (get s) = (r = s \<and> s' = s)"
+  by (simp add: get_def mres_def)
+
+lemma in_gets:
+  "(r, s') \<in> mres (gets f s) = (r = f s \<and> s' = s)"
+  by (simp add: simpler_gets_def mres_def)
+
+lemma in_put:
+  "(r, s') \<in> mres (put x s) = (s' = x \<and> r = ())"
+  by (simp add: put_def mres_def)
+
+lemma in_when:
+  "(v, s') \<in> mres (when P f s) = ((P \<longrightarrow> (v, s') \<in> mres (f s)) \<and> (\<not>P \<longrightarrow> v = () \<and> s' = s))"
+  by (simp add: when_def in_return)
+
+lemma in_modify:
+  "(v, s') \<in> mres (modify f s) = (s'=f s \<and> v = ())"
+  by (auto simp add: modify_def bind_def get_def put_def mres_def)
+
+lemma gets_the_in_monad:
+  "((v, s') \<in> mres (gets_the f s)) = (s' = s \<and> f s = Some v)"
+  by (auto simp: gets_the_def in_bind in_gets in_assert_opt split: option.split)
+
+lemma in_alternative:
+  "(r,s') \<in> mres ((f \<sqinter> g) s) = ((r,s') \<in> mres (f s) \<or> (r,s') \<in> mres (g s))"
+  by (auto simp add: alternative_def mres_def)
+
+lemma in_liftM:
+  "((r, s') \<in> mres (liftM t f s)) = (\<exists>r'. (r', s') \<in> mres (f s) \<and> r = t r')"
+  by (simp add: liftM_def in_return in_bind)
+
+lemma in_bindE:
+  "(rv, s') \<in> mres ((f >>=E (\<lambda>rv'. g rv')) s) =
+   ((\<exists>ex. rv = Inl ex \<and> (Inl ex, s') \<in> mres (f s)) \<or>
+    (\<exists>rv' s''. (rv, s') \<in> mres (g rv' s'') \<and> (Inr rv', s'') \<in> mres (f s)))"
+  apply (clarsimp simp: bindE_def in_bind lift_def in_throwError)
+  apply (safe del: disjCI; strengthen subst[where P="\<lambda>x. x \<in> mres (f s)", mk_strg I _ E];
+         auto simp: in_throwError split: sum.splits)
+  done
+
+lemmas in_monad = inl_whenE in_whenE in_liftE in_bind in_bindE_L
+                  in_bindE_R in_returnOk in_throwError in_fail
+                  in_assertE in_assert in_return in_assert_opt
+                  in_get in_gets in_put in_when (* unlessE_whenE *)
+                  (* unless_when *) in_modify gets_the_in_monad
+                  in_alternative in_liftM
+
+lemma bind_det_exec:
+  "mres (a s) = {(r,s')} \<Longrightarrow> mres ((a >>= b) s) = mres (b r s')"
+  by (simp add: in_bind set_eq_iff)
+
+lemma in_bind_det_exec:
+  "mres (a s) = {(r,s')} \<Longrightarrow> (s'' \<in> mres ((a >>= b) s)) = (s'' \<in> mres (b r s'))"
+  by (cases s'', simp add: in_bind)
+
+lemma exec_put:
+  "(put s' >>= m) s = m () s'"
+  by (simp add: bind_def put_def mres_def split_def)
+
+lemma bind_execI:
+  "\<lbrakk> (r'',s'') \<in> mres (f s); \<exists>x \<in> mres (g r'' s''). P x \<rbrakk> \<Longrightarrow> \<exists>x \<in> mres ((f >>= g) s). P x"
+  by (force simp: Bex_def in_bind)
+
+end
diff --git a/lib/Monads/trace/Trace_Lemmas.thy b/lib/Monads/trace/Trace_Lemmas.thy
index 6b5533d811..9ce793eea7 100644
--- a/lib/Monads/trace/Trace_Lemmas.thy
+++ b/lib/Monads/trace/Trace_Lemmas.thy
@@ -1,379 +1,89 @@
 (*
+ * Copyright 2023, Proofcraft Pty Ltd
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
+
 theory Trace_Lemmas
-imports Trace_VCG
+  imports Trace_Monad
 begin
 
-lemma mapM_Cons:
-  "mapM f (x # xs) = do
-    y \<leftarrow> f x;
-    ys \<leftarrow> mapM f xs;
-    return (y # ys)
-  od"
-  and mapM_Nil:
-  "mapM f [] = return []"
-  by (simp_all add: mapM_def sequence_def)
-
-lemma mapM_x_Cons:
-  "mapM_x f (x # xs) = do
-    y \<leftarrow> f x;
-    mapM_x f xs
-  od"
-  and mapM_x_Nil:
-  "mapM_x f [] = return ()"
-  by (simp_all add: mapM_x_def sequence_x_def)
-
-lemma mapM_append:
-  "mapM f (xs @ ys) = (do
-    fxs \<leftarrow> mapM f xs;
-    fys \<leftarrow> mapM f ys;
-    return (fxs @ fys)
-  od)"
-  by (induct xs, simp_all add: mapM_Cons mapM_Nil bind_assoc)
-
-lemma mapM_x_append:
-  "mapM_x f (xs @ ys) = (do
-    x \<leftarrow> mapM_x f xs;
-    mapM_x f ys
-  od)"
-  by (induct xs, simp_all add: mapM_x_Cons mapM_x_Nil bind_assoc)
-
-lemma mapM_map:
-  "mapM f (map g xs) = mapM (f o g) xs"
-  by (induct xs; simp add: mapM_Nil mapM_Cons)
-
-lemma mapM_x_map:
-  "mapM_x f (map g xs) = mapM_x (f o g) xs"
-  by (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
-
-primrec
-  repeat_n :: "nat \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
-where
-    "repeat_n 0 f = return ()"
-  | "repeat_n (Suc n) f = do f; repeat_n n f od"
-
-lemma repeat_n_mapM_x:
-  "repeat_n n f = mapM_x (\<lambda>_. f) (replicate n ())"
-  by (induct n, simp_all add: mapM_x_Cons mapM_x_Nil)
-
-definition
-  repeat :: "('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
-where
-  "repeat f = do n \<leftarrow> select UNIV; repeat_n n f od"
-
-definition
-  env_step :: "('s,unit) tmonad"
-where
-  "env_step =
-  (do
-    s' \<leftarrow> select UNIV;
-    put_trace_elem (Env, s');
-    put s'
-  od)"
-
-abbreviation
-  "env_n_steps n \<equiv> repeat_n n env_step"
-
-lemma elem_select_bind:
-  "(tr, res) \<in> (do x \<leftarrow> select S; f x od) s
-    = (\<exists>x \<in> S. (tr, res) \<in> f x s)"
-  by (simp add: bind_def select_def)
-
-lemma select_bind_UN:
-  "(do x \<leftarrow> select S; f x od) = (\<lambda>s. \<Union>x \<in> S. f x s)"
-  by (rule ext, auto simp: elem_select_bind)
-
-lemma select_early:
-  "S \<noteq> {}
-    \<Longrightarrow> do x \<leftarrow> f; y \<leftarrow> select S; g x y od
-        = do y \<leftarrow> select S; x \<leftarrow> f; g x y od"
-  apply (simp add: bind_def select_def Sigma_def)
-  apply (rule ext)
-  apply (fastforce elim: rev_bexI image_eqI[rotated] split: tmres.split_asm)
-  done
-
-lemma repeat_n_choice:
-  "S \<noteq> {}
-    \<Longrightarrow> repeat_n n (do x \<leftarrow> select S; f x od)
-        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S \<and> length xs = n}; mapM_x f xs od)"
-  apply (induct n; simp?)
-   apply (simp add: select_def bind_def mapM_x_Nil cong: conj_cong)
-  apply (simp add: select_early bind_assoc)
-  apply (subst select_early)
-   apply simp
-   apply (auto intro: exI[where x="replicate n xs" for n xs])[1]
-  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
-  apply (simp only: conj_comms[where Q="length xs = n" for xs n])
-  apply (simp only: ex_simps[symmetric] conj_assoc length_Suc_conv, simp)
-  apply (auto simp: mapM_x_Cons)
-  done
-
-lemma repeat_choice:
-  "S \<noteq> {}
-    \<Longrightarrow> repeat (do x \<leftarrow> select S; f x od)
-        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S}; mapM_x f xs od)"
-  apply (simp add: repeat_def repeat_n_choice)
-  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
-  done
-
-lemma put_trace_append:
-  "put_trace (xs @ ys) = do put_trace ys; put_trace xs od"
-  by (induct xs; simp add: bind_assoc)
-
-lemma put_trace_elem_put_comm:
-  "do y \<leftarrow> put_trace_elem x; put s od
-    = do y \<leftarrow> put s; put_trace_elem x od"
-  by (simp add: put_def put_trace_elem_def bind_def insert_commute)
-
-lemma put_trace_put_comm:
-  "do y \<leftarrow> put_trace xs; put s od
-    = do y \<leftarrow> put s; put_trace xs od"
-  apply (rule sym; induct xs; simp)
-  apply (simp add: bind_assoc put_trace_elem_put_comm)
-  apply (simp add: bind_assoc[symmetric])
-  done
-
-lemma mapM_x_comm:
-  "(\<forall>x \<in> set xs. do y \<leftarrow> g; f x od = do y \<leftarrow> f x; g od)
-    \<Longrightarrow> do y \<leftarrow> g; mapM_x f xs od = do y \<leftarrow> mapM_x f xs; g od"
-  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
-  apply (simp add: bind_assoc[symmetric], simp add: bind_assoc)
-  done
-
-lemma mapM_x_split:
-  "(\<forall>x \<in> set xs. \<forall>y \<in> set xs. do z \<leftarrow> g y; f x od = do (z :: unit) \<leftarrow> f x; g y od)
-    \<Longrightarrow> mapM_x (\<lambda>x. do z \<leftarrow> f x; g x od) xs = do y \<leftarrow> mapM_x f xs; mapM_x g xs od"
-  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons bind_assoc)
-  apply (subst bind_assoc[symmetric], subst mapM_x_comm[where f=f and g="g x" for x])
-   apply simp
-  apply (simp add: bind_assoc)
-  done
-
-lemma mapM_x_put:
-  "mapM_x put xs = unless (xs = []) (put (last xs))"
-  apply (induct xs rule: rev_induct)
-   apply (simp add: mapM_x_Nil unless_def when_def)
-  apply (simp add: mapM_x_append mapM_x_Cons mapM_x_Nil)
-  apply (simp add: bind_def unless_def when_def put_def return_def)
-  done
-
-lemma put_trace_mapM_x:
-  "put_trace xs = mapM_x put_trace_elem (rev xs)"
-  by (induct xs; simp add: mapM_x_Nil mapM_x_append mapM_x_Cons)
+section \<open>General Lemmas Regarding the Interference Trace Monad\<close>
 
-lemma rev_surj:
-  "surj rev"
-  by (rule_tac f=rev in surjI, simp)
+subsection \<open>Congruence Rules for the Function Package\<close>
 
-lemma select_image:
-  "select (f ` S) = do x \<leftarrow> select S; return (f x) od"
-  by (auto simp add: bind_def select_def return_def Sigma_def)
+\<comment> \<open>FIXME: where should this go\<close>
+lemma in_mres:
+  "(tr, Result (rv, s)) \<in> S \<Longrightarrow> (rv, s) \<in> mres S"
+  by (fastforce simp: mres_def intro: image_eqI[rotated])
 
-lemma env_steps_repeat:
-  "env_steps = repeat env_step"
-  apply (simp add: env_step_def repeat_choice env_steps_def
-                   select_early)
-  apply (simp add: put_trace_elem_put_comm)
-  apply (simp add: mapM_x_split put_trace_elem_put_comm put_trace_put_comm
-                   mapM_x_put)
-  apply (simp add: put_trace_mapM_x rev_map mapM_x_map o_def)
-  apply (subst rev_surj[symmetric], simp add: select_image bind_assoc)
-  apply (rule arg_cong2[where f=bind, OF refl ext])
-  apply (simp add: bind_def get_def put_def unless_def when_def return_def)
-  apply (simp add: last_st_tr_def hd_map hd_rev)
-  done
-
-lemma repeat_n_plus:
-  "repeat_n (n + m) f = do repeat_n n f; repeat_n m f od"
-  by (induct n; simp add: bind_assoc)
-
-lemma repeat_eq_twice[simp]:
-  "(do x \<leftarrow> repeat f; repeat f od) = repeat f"
-  apply (simp add: repeat_def select_early)
-  apply (simp add: bind_assoc repeat_n_plus[symmetric, simplified])
-  apply (simp add: bind_def select_def Sigma_def)
-  apply (rule ext, fastforce intro: exI[where x=0])
-  done
-
-lemmas bind_then_eq = arg_cong2[where f=bind, OF _ refl]
-lemmas repeat_eq_twice_then[simp]
-    = repeat_eq_twice[THEN bind_then_eq, simplified bind_assoc]
-
-lemmas env_steps_eq_twice[simp]
-    = repeat_eq_twice[where f=env_step, folded env_steps_repeat]
-lemmas env_steps_eq_twice_then[simp]
-    = env_steps_eq_twice[THEN bind_then_eq, simplified bind_assoc]
-
-lemmas mapM_collapse_append = mapM_append[symmetric, THEN bind_then_eq,
-    simplified bind_assoc, simplified]
-
-lemma prefix_closed_mapM[rule_format, wp_split]:
-  "(\<forall>x \<in> set xs. prefix_closed (f x)) \<Longrightarrow> prefix_closed (mapM f xs)"
-  apply (induct xs)
-   apply (simp add: mapM_def sequence_def)
-  apply (clarsimp simp: mapM_Cons)
-  apply (intro prefix_closed_bind allI; clarsimp)
+lemma bind_apply_cong':
+  "\<lbrakk>f s = f' s'; (\<forall>rv st. (rv, st) \<in> mres (f s) \<longrightarrow> g rv st = g' rv st)\<rbrakk>
+   \<Longrightarrow> bind f g s = bind f' g' s'"
+  apply (simp add: bind_def)
+  apply (rule SUP_cong; simp?)
+  apply (clarsimp split: tmres.split)
+  apply (drule spec2, drule mp, erule in_mres)
+  apply simp
   done
 
-lemma modify_id:
-  "modify id = return ()"
-  by (simp add: modify_def get_def bind_def put_def return_def)
+lemmas bind_apply_cong = bind_apply_cong'[rule_format, fundef_cong]
 
-lemma modify_modify:
-  "(do x \<leftarrow> modify f; modify (g x) od) = modify (g () o f)"
-  by (simp add: bind_def simpler_modify_def)
 
-lemmas modify_modify_bind = arg_cong2[where f=bind,
-  OF modify_modify refl, simplified bind_assoc]
+subsection \<open>Simplifying Monads\<close>
 
-lemma select_single:
-  "select {x} = return x"
-  by (simp add: select_def return_def)
+lemma fail_update[iff]:
+  "fail (f s) = fail s"
+  by (simp add: fail_def)
 
-lemma put_then_get[unfolded K_bind_def]:
-  "do put s; get od = do put s; return s od"
-  by (simp add: put_def bind_def get_def return_def)
+lemma assert_A_True[simp]:
+  "assert True = return ()"
+  by (simp add: assert_def)
 
-lemmas put_then_get_then
-    = put_then_get[THEN bind_then_eq, simplified bind_assoc return_bind]
 
-lemmas bind_promote_If
-    = if_distrib[where f="\<lambda>f. bind f g" for g]
-      if_distrib[where f="\<lambda>g. bind f g" for f]
+subsection \<open>Lifting and Alternative Basic Definitions\<close>
 
-lemma bind_promote_If2:
-  "do x \<leftarrow> f; if P then g x else h x od
-    = (if P then bind f g else bind f h)"
-  by simp
+lemma liftE_liftM:
+  "liftE = liftM Inr"
+  by (auto simp: liftE_def liftM_def)
 
-lemma exec_put_trace[unfolded K_bind_def]:
-  "(do put_trace xs; f od) s
-    = (\<Union>n \<in> {n. 0 < n \<and> n \<le> length xs}. {(drop n xs, Incomplete)})
-        \<union> ((\<lambda>(a, b). (a @ xs, b)) ` f s)"
-  apply (simp add: put_trace_eq_drop bind_def)
-  apply (safe; (clarsimp split: if_split_asm)?;
-      fastforce intro: bexI[where x=0] rev_bexI)
+lemma liftME_liftM:
+  "liftME f = liftM (case_sum Inl (Inr \<circ> f))"
+  unfolding liftME_def liftM_def bindE_def returnOk_def lift_def
+  apply (rule ext, rename_tac x)
+  apply (rule_tac f="bind x" in arg_cong)
+  apply (fastforce simp: throwError_def split: sum.splits)
   done
 
-lemma if_fun_lift:
-  "(if P then f else g) x = (if P then f x else g x)"
-  by simp
+lemma liftE_bindE:
+  "liftE a >>=E b = a >>= b"
+  by (simp add: liftE_def bindE_def lift_def bind_assoc)
 
-lemma UN_If_distrib:
-  "(\<Union>x \<in> S. if P x then A x else B x)
-    = ((\<Union>x \<in> S \<inter> {x. P x}. A x) \<union> (\<Union>x \<in> S \<inter> {x. \<not> P x}. B x))"
-  by (fastforce split: if_split_asm)
+lemma liftM_id[simp]:
+  "liftM id = id"
+  by (auto simp: liftM_def)
 
-lemma Await_redef:
-  "Await P = do
-    s1 \<leftarrow> select {s. P s};
-    env_steps;
-    s \<leftarrow> get;
-    select (if P s then {()} else {})
-  od"
-  apply (simp add: Await_def env_steps_def bind_assoc)
-  apply (cases "{s. P s} = {}")
-   apply (simp add: select_def bind_def get_def)
-  apply (rule ext)
-  apply (simp add: exec_get select_bind_UN put_then_get_then)
-  apply (simp add: bind_promote_If2 if_fun_lift if_distrib[where f=select])
-  apply (simp add: exec_put_trace cong: if_cong)
-  apply (simp add: put_def bind_def select_def cong: if_cong)
-  apply (strengthen equalityI)
-  apply clarsimp
-  apply (strengthen exI[where x="s # xs" for s xs])
-  apply (strengthen exI[where x="Suc n" for n])
-  apply simp
-  apply blast
-  done
-
-lemma bind_apply_cong':
-  "f s = f' s
-    \<Longrightarrow> (\<forall>rv s'. (rv, s') \<in> mres (f s) \<longrightarrow> g rv s' = g' rv s')
-    \<Longrightarrow> bind f g s = bind f' g' s"
-  apply (simp add: bind_def)
-  apply (rule SUP_cong; simp?)
-  apply (clarsimp split: tmres.split)
-  apply (drule spec2, drule mp, erule in_mres)
-  apply simp
-  done
+lemma liftM_bind:
+  "liftM t f >>= g = (f >>= (\<lambda>x. g (t x)))"
+  by (simp add: liftM_def bind_assoc)
 
-lemmas bind_apply_cong = bind_apply_cong'[rule_format]
+lemma gets_bind_ign:
+  "gets f >>= (\<lambda>x. m) = m"
+  by (simp add: bind_def simpler_gets_def)
 
-lemma select_empty_bind[simp]:
-  "select {} >>= f = select {}"
-  by (simp add: select_def bind_def)
+lemma exec_get:
+  "(get >>= f) x = f x x"
+  by (simp add: get_def bind_def)
 
-lemma fail_bind[simp]:
-  "fail >>= f = fail"
-  by (simp add: bind_def fail_def)
+lemmas get_bind_apply = exec_get (* FIXME lib: eliminate *)
 
-lemma eq_Me_neq_Env:
-  "(x = Me) = (x \<noteq> Env)"
-  by (cases x; simp)
+lemma exec_gets:
+  "(gets f >>= m) s = m (f s) s"
+  by (simp add: simpler_gets_def bind_def)
 
-lemma validI_invariant_imp:
-  assumes v: "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-    and P: "\<forall>s0 s. P s0 s \<longrightarrow> I s0"
-    and R: "\<forall>s0 s. I s0 \<longrightarrow> R s0 s \<longrightarrow> I s"
-    and G: "\<forall>s0 s. I s0 \<longrightarrow> G s0 s \<longrightarrow> I s"
-  shows "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. I s0 \<and> I s \<and> G s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. I s0 \<and> Q rv s0 s\<rbrace>"
-proof -
-  { fix tr s0 i
-  assume r: "rely_cond R s0 tr" and g: "guar_cond G s0 tr"
-    and I: "I s0"
-  hence imp: "\<forall>(_, s, s') \<in> trace_steps (rev tr) s0. I s \<longrightarrow> I s'"
-    apply (clarsimp simp: guar_cond_def rely_cond_def)
-    apply (drule(1) bspec)+
-    apply (clarsimp simp: eq_Me_neq_Env)
-    apply (metis R G)
-    done
-  hence "i < length tr \<longrightarrow> I (snd (rev tr ! i))"
-    using I
-    apply (induct i)
-     apply (clarsimp simp: neq_Nil_conv[where xs="rev tr" for tr, simplified])
-    apply clarsimp
-    apply (drule bspec, fastforce simp add: trace_steps_nth)
-    apply simp
-    done
-  }
-  note I = this
-  show ?thesis
-    using v
-    apply (clarsimp simp: validI_def rely_def imp_conjL)
-    apply (drule spec2, drule(1) mp)+
-    apply clarsimp
-    apply (frule P[rule_format])
-    apply (clarsimp simp: guar_cond_def trace_steps_nth I last_st_tr_def
-                          hd_append last_rev[symmetric]
-                          last_conv_nth rev_map)
-    done
-qed
-
-lemma validI_guar_post_conj_lift:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G1\<rbrace>,\<lbrace>Q1\<rbrace>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G2\<rbrace>,\<lbrace>Q2\<rbrace>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. G1 s0 s \<and> G2 s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. Q1 rv s0 s \<and> Q2 rv s0 s\<rbrace>"
-  apply (frule validI_prefix_closed)
-  apply (subst validI_def, clarsimp simp: rely_def)
-  apply (drule(3) validI_D)+
-  apply (auto simp: guar_cond_def)
-  done
-
-lemmas modify_prefix_closed[simp] =
-  modify_wp[THEN valid_validI_wp[OF no_trace_all(3)], THEN validI_prefix_closed]
-lemmas await_prefix_closed[simp] = Await_sync_twp[THEN validI_prefix_closed]
-
-lemma repeat_prefix_closed[intro!]:
-  "prefix_closed f \<Longrightarrow> prefix_closed (repeat f)"
-  apply (simp add: repeat_def)
-  apply (rule prefix_closed_bind; clarsimp)
-  apply (rename_tac n)
-  apply (induct_tac n; simp)
-  apply (auto intro: prefix_closed_bind)
-  done
+lemma bind_eqI:
+  "\<lbrakk> f = f'; \<And>x. g x = g' x \<rbrakk> \<Longrightarrow> f >>= g = f' >>= g'"
+  by (auto simp: bind_def split_def)
 
 end
diff --git a/lib/Monads/trace/Trace_Lemmas_Old.thy b/lib/Monads/trace/Trace_Lemmas_Old.thy
new file mode 100644
index 0000000000..2c5bc81e67
--- /dev/null
+++ b/lib/Monads/trace/Trace_Lemmas_Old.thy
@@ -0,0 +1,335 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_Lemmas_Old
+  imports
+    Trace_More_VCG
+    Trace_Monad_Equations
+begin
+
+lemma mapM_Cons:
+  "mapM f (x # xs) = do
+    y \<leftarrow> f x;
+    ys \<leftarrow> mapM f xs;
+    return (y # ys)
+  od"
+  and mapM_Nil:
+  "mapM f [] = return []"
+  by (simp_all add: mapM_def sequence_def)
+
+lemma mapM_x_Cons:
+  "mapM_x f (x # xs) = do
+    y \<leftarrow> f x;
+    mapM_x f xs
+  od"
+  and mapM_x_Nil:
+  "mapM_x f [] = return ()"
+  by (simp_all add: mapM_x_def sequence_x_def)
+
+lemma mapM_append:
+  "mapM f (xs @ ys) = (do
+    fxs \<leftarrow> mapM f xs;
+    fys \<leftarrow> mapM f ys;
+    return (fxs @ fys)
+  od)"
+  by (induct xs, simp_all add: mapM_Cons mapM_Nil bind_assoc)
+
+lemma mapM_x_append:
+  "mapM_x f (xs @ ys) = (do
+    x \<leftarrow> mapM_x f xs;
+    mapM_x f ys
+  od)"
+  by (induct xs, simp_all add: mapM_x_Cons mapM_x_Nil bind_assoc)
+
+lemma mapM_map:
+  "mapM f (map g xs) = mapM (f o g) xs"
+  by (induct xs; simp add: mapM_Nil mapM_Cons)
+
+lemma mapM_x_map:
+  "mapM_x f (map g xs) = mapM_x (f o g) xs"
+  by (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
+
+primrec
+  repeat_n :: "nat \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
+where
+    "repeat_n 0 f = return ()"
+  | "repeat_n (Suc n) f = do f; repeat_n n f od"
+
+lemma repeat_n_mapM_x:
+  "repeat_n n f = mapM_x (\<lambda>_. f) (replicate n ())"
+  by (induct n, simp_all add: mapM_x_Cons mapM_x_Nil)
+
+definition
+  repeat :: "('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
+where
+  "repeat f = do n \<leftarrow> select UNIV; repeat_n n f od"
+
+definition
+  env_step :: "('s,unit) tmonad"
+where
+  "env_step =
+  (do
+    s' \<leftarrow> select UNIV;
+    put_trace_elem (Env, s');
+    put s'
+  od)"
+
+abbreviation
+  "env_n_steps n \<equiv> repeat_n n env_step"
+
+lemma elem_select_bind:
+  "(tr, res) \<in> (do x \<leftarrow> select S; f x od) s
+    = (\<exists>x \<in> S. (tr, res) \<in> f x s)"
+  by (simp add: bind_def select_def)
+
+lemma select_bind_UN:
+  "(do x \<leftarrow> select S; f x od) = (\<lambda>s. \<Union>x \<in> S. f x s)"
+  by (rule ext, auto simp: elem_select_bind)
+
+lemma select_early:
+  "S \<noteq> {}
+    \<Longrightarrow> do x \<leftarrow> f; y \<leftarrow> select S; g x y od
+        = do y \<leftarrow> select S; x \<leftarrow> f; g x y od"
+  apply (simp add: bind_def select_def Sigma_def)
+  apply (rule ext)
+  apply (fastforce elim: rev_bexI image_eqI[rotated] split: tmres.split_asm)
+  done
+
+lemma repeat_n_choice:
+  "S \<noteq> {}
+    \<Longrightarrow> repeat_n n (do x \<leftarrow> select S; f x od)
+        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S \<and> length xs = n}; mapM_x f xs od)"
+  apply (induct n; simp?)
+   apply (simp add: select_def bind_def mapM_x_Nil cong: conj_cong)
+  apply (simp add: select_early bind_assoc)
+  apply (subst select_early)
+   apply simp
+   apply (auto intro: exI[where x="replicate n xs" for n xs])[1]
+  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
+  apply (simp only: conj_comms[where Q="length xs = n" for xs n])
+  apply (simp only: ex_simps[symmetric] conj_assoc length_Suc_conv, simp)
+  apply (auto simp: mapM_x_Cons)
+  done
+
+lemma repeat_choice:
+  "S \<noteq> {}
+    \<Longrightarrow> repeat (do x \<leftarrow> select S; f x od)
+        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S}; mapM_x f xs od)"
+  apply (simp add: repeat_def repeat_n_choice)
+  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
+  done
+
+lemma put_trace_append:
+  "put_trace (xs @ ys) = do put_trace ys; put_trace xs od"
+  by (induct xs; simp add: bind_assoc)
+
+lemma put_trace_elem_put_comm:
+  "do y \<leftarrow> put_trace_elem x; put s od
+    = do y \<leftarrow> put s; put_trace_elem x od"
+  by (simp add: put_def put_trace_elem_def bind_def insert_commute)
+
+lemma put_trace_put_comm:
+  "do y \<leftarrow> put_trace xs; put s od
+    = do y \<leftarrow> put s; put_trace xs od"
+  apply (rule sym; induct xs; simp)
+  apply (simp add: bind_assoc put_trace_elem_put_comm)
+  apply (simp add: bind_assoc[symmetric])
+  done
+
+lemma mapM_x_comm:
+  "(\<forall>x \<in> set xs. do y \<leftarrow> g; f x od = do y \<leftarrow> f x; g od)
+    \<Longrightarrow> do y \<leftarrow> g; mapM_x f xs od = do y \<leftarrow> mapM_x f xs; g od"
+  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
+  apply (simp add: bind_assoc[symmetric], simp add: bind_assoc)
+  done
+
+lemma mapM_x_split:
+  "(\<forall>x \<in> set xs. \<forall>y \<in> set xs. do z \<leftarrow> g y; f x od = do (z :: unit) \<leftarrow> f x; g y od)
+    \<Longrightarrow> mapM_x (\<lambda>x. do z \<leftarrow> f x; g x od) xs = do y \<leftarrow> mapM_x f xs; mapM_x g xs od"
+  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons bind_assoc)
+  apply (subst bind_assoc[symmetric], subst mapM_x_comm[where f=f and g="g x" for x])
+   apply simp
+  apply (simp add: bind_assoc)
+  done
+
+lemma mapM_x_put:
+  "mapM_x put xs = unless (xs = []) (put (last xs))"
+  apply (induct xs rule: rev_induct)
+   apply (simp add: mapM_x_Nil unless_def when_def)
+  apply (simp add: mapM_x_append mapM_x_Cons mapM_x_Nil)
+  apply (simp add: bind_def unless_def when_def put_def return_def)
+  done
+
+lemma put_trace_mapM_x:
+  "put_trace xs = mapM_x put_trace_elem (rev xs)"
+  by (induct xs; simp add: mapM_x_Nil mapM_x_append mapM_x_Cons)
+
+lemma rev_surj:
+  "surj rev"
+  by (rule_tac f=rev in surjI, simp)
+
+lemma select_image:
+  "select (f ` S) = do x \<leftarrow> select S; return (f x) od"
+  by (auto simp add: bind_def select_def return_def Sigma_def)
+
+lemma env_steps_repeat:
+  "env_steps = repeat env_step"
+  apply (simp add: env_step_def repeat_choice env_steps_def
+                   select_early)
+  apply (simp add: put_trace_elem_put_comm)
+  apply (simp add: mapM_x_split put_trace_elem_put_comm put_trace_put_comm
+                   mapM_x_put)
+  apply (simp add: put_trace_mapM_x rev_map mapM_x_map o_def)
+  apply (subst rev_surj[symmetric], simp add: select_image bind_assoc)
+  apply (rule arg_cong2[where f=bind, OF refl ext])
+  apply (simp add: bind_def get_def put_def unless_def when_def return_def)
+  apply (simp add: last_st_tr_def hd_map hd_rev)
+  done
+
+lemma repeat_n_plus:
+  "repeat_n (n + m) f = do repeat_n n f; repeat_n m f od"
+  by (induct n; simp add: bind_assoc)
+
+lemma repeat_eq_twice[simp]:
+  "(do x \<leftarrow> repeat f; repeat f od) = repeat f"
+  apply (simp add: repeat_def select_early)
+  apply (simp add: bind_assoc repeat_n_plus[symmetric, simplified])
+  apply (simp add: bind_def select_def Sigma_def)
+  apply (rule ext, fastforce intro: exI[where x=0])
+  done
+
+lemmas repeat_eq_twice_then[simp]
+    = repeat_eq_twice[THEN bind_then_eq, simplified bind_assoc]
+
+lemmas env_steps_eq_twice[simp]
+    = repeat_eq_twice[where f=env_step, folded env_steps_repeat]
+lemmas env_steps_eq_twice_then[simp]
+    = env_steps_eq_twice[THEN bind_then_eq, simplified bind_assoc]
+
+lemmas mapM_collapse_append = mapM_append[symmetric, THEN bind_then_eq,
+    simplified bind_assoc, simplified]
+
+lemma prefix_closed_mapM[rule_format, wp_split]:
+  "(\<forall>x \<in> set xs. prefix_closed (f x)) \<Longrightarrow> prefix_closed (mapM f xs)"
+  apply (induct xs)
+   apply (simp add: mapM_def sequence_def)
+  apply (clarsimp simp: mapM_Cons)
+  apply (intro prefix_closed_bind allI; clarsimp)
+  done
+
+lemmas bind_promote_If
+    = if_distrib[where f="\<lambda>f. bind f g" for g]
+      if_distrib[where f="\<lambda>g. bind f g" for f]
+
+lemma bind_promote_If2:
+  "do x \<leftarrow> f; if P then g x else h x od
+    = (if P then bind f g else bind f h)"
+  by simp
+
+lemma exec_put_trace[unfolded K_bind_def]:
+  "(do put_trace xs; f od) s
+    = (\<Union>n \<in> {n. 0 < n \<and> n \<le> length xs}. {(drop n xs, Incomplete)})
+        \<union> ((\<lambda>(a, b). (a @ xs, b)) ` f s)"
+  apply (simp add: put_trace_eq_drop bind_def)
+  apply (safe; (clarsimp split: if_split_asm)?;
+      fastforce intro: bexI[where x=0] rev_bexI)
+  done
+
+lemma UN_If_distrib:
+  "(\<Union>x \<in> S. if P x then A x else B x)
+    = ((\<Union>x \<in> S \<inter> {x. P x}. A x) \<union> (\<Union>x \<in> S \<inter> {x. \<not> P x}. B x))"
+  by (fastforce split: if_split_asm)
+
+lemma Await_redef:
+  "Await P = do
+    s1 \<leftarrow> select {s. P s};
+    env_steps;
+    s \<leftarrow> get;
+    select (if P s then {()} else {})
+  od"
+  apply (simp add: Await_def env_steps_def bind_assoc)
+  apply (cases "{s. P s} = {}")
+   apply (simp add: select_def bind_def get_def)
+  apply (rule ext)
+  apply (simp add: exec_get select_bind_UN put_then_get_then)
+  apply (simp add: bind_promote_If2 if_distribR if_distrib[where f=select])
+  apply (simp add: exec_put_trace cong: if_cong)
+  apply (simp add: put_def bind_def select_def cong: if_cong)
+  apply (strengthen equalityI)
+  apply clarsimp
+  apply (strengthen exI[where x="s # xs" for s xs])
+  apply (strengthen exI[where x="Suc n" for n])
+  apply simp
+  apply blast
+  done
+
+lemma eq_Me_neq_Env:
+  "(x = Me) = (x \<noteq> Env)"
+  by (cases x; simp)
+
+lemma validI_invariant_imp:
+  assumes v: "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+    and P: "\<forall>s0 s. P s0 s \<longrightarrow> I s0"
+    and R: "\<forall>s0 s. I s0 \<longrightarrow> R s0 s \<longrightarrow> I s"
+    and G: "\<forall>s0 s. I s0 \<longrightarrow> G s0 s \<longrightarrow> I s"
+  shows "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. I s0 \<and> I s \<and> G s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. I s0 \<and> Q rv s0 s\<rbrace>"
+proof -
+  { fix tr s0 i
+  assume r: "rely_cond R s0 tr" and g: "guar_cond G s0 tr"
+    and I: "I s0"
+  hence imp: "\<forall>(_, s, s') \<in> trace_steps (rev tr) s0. I s \<longrightarrow> I s'"
+    apply (clarsimp simp: guar_cond_def rely_cond_def)
+    apply (drule(1) bspec)+
+    apply (clarsimp simp: eq_Me_neq_Env)
+    apply (metis R G)
+    done
+  hence "i < length tr \<longrightarrow> I (snd (rev tr ! i))"
+    using I
+    apply (induct i)
+     apply (clarsimp simp: neq_Nil_conv[where xs="rev tr" for tr, simplified])
+    apply clarsimp
+    apply (drule bspec, fastforce simp add: trace_steps_nth)
+    apply simp
+    done
+  }
+  note I = this
+  show ?thesis
+    using v
+    apply (clarsimp simp: validI_def rely_def imp_conjL)
+    apply (drule spec2, drule(1) mp)+
+    apply clarsimp
+    apply (frule P[rule_format])
+    apply (clarsimp simp: guar_cond_def trace_steps_nth I last_st_tr_def
+                          hd_append last_rev[symmetric]
+                          last_conv_nth rev_map)
+    done
+qed
+
+lemma validI_guar_post_conj_lift:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G1\<rbrace>,\<lbrace>Q1\<rbrace>
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G2\<rbrace>,\<lbrace>Q2\<rbrace>
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. G1 s0 s \<and> G2 s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. Q1 rv s0 s \<and> Q2 rv s0 s\<rbrace>"
+  apply (frule validI_prefix_closed)
+  apply (subst validI_def, clarsimp simp: rely_def)
+  apply (drule(3) validI_D)+
+  apply (auto simp: guar_cond_def)
+  done
+
+lemmas modify_prefix_closed[simp] =
+  modify_wp[THEN valid_validI_wp[OF no_trace_all(3)], THEN validI_prefix_closed]
+lemmas await_prefix_closed[simp] = Await_sync_twp[THEN validI_prefix_closed]
+
+lemma repeat_prefix_closed[intro!]:
+  "prefix_closed f \<Longrightarrow> prefix_closed (repeat f)"
+  apply (simp add: repeat_def)
+  apply (rule prefix_closed_bind; clarsimp)
+  apply (rename_tac n)
+  apply (induct_tac n; simp)
+  apply (auto intro: prefix_closed_bind)
+  done
+
+end
diff --git a/lib/Monads/trace/Trace_Monad.thy b/lib/Monads/trace/Trace_Monad.thy
index 21ea924db8..3de9644457 100644
--- a/lib/Monads/trace/Trace_Monad.thy
+++ b/lib/Monads/trace/Trace_Monad.thy
@@ -202,7 +202,7 @@ lemma bind_def2:
 lemma elem_bindE:
   "\<lbrakk>(tr, res) \<in> bind f g s;
     \<lbrakk>res = Incomplete \<or> res = Failed; (tr, map_tmres undefined undefined res) \<in> f s\<rbrakk> \<Longrightarrow> P;
-    \<And>tr' tr'' x s'. \<lbrakk>(tr', Result (x, s')) \<in> f s \<Longrightarrow> (tr'', res) \<in> g x s'; tr = tr'' @ tr'\<rbrakk> \<Longrightarrow> P\<rbrakk>
+    \<And>tr' tr'' x s'. \<lbrakk>(tr', Result (x, s')) \<in> f s; (tr'', res) \<in> g x s'; tr = tr'' @ tr'\<rbrakk> \<Longrightarrow> P\<rbrakk>
    \<Longrightarrow> P"
   by (auto simp: bind_def2)
 
@@ -687,166 +687,6 @@ definition Await :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,unit) tmonad" whe
   od"
 
 
-section "Hoare Logic"
-
-subsection "Validity"
-
-text \<open>
-  This section defines a Hoare logic for partial correctness for
-  the interference trace monad as well as the exception monad.
-  The logic talks only about the behaviour part of the monad and ignores
-  the failure flag.
-
-  The logic is defined semantically. Rules work directly on the
-  validity predicate.
-
-  In the interference trace monad, validity is a triple of precondition,
-  monad, and postcondition. The precondition is a function from state to
-  bool (a state predicate), the postcondition is a function from return value
-  to state to bool. A triple is valid if for all states that satisfy the
-  precondition, all result values and result states that are returned by
-  the monad satisfy the postcondition. Note that if the computation returns
-  the empty set, the triple is trivially valid. This means @{term "assert P"}
-  does not require us to prove that @{term P} holds, but rather allows us
-  to assume @{term P}! Proving non-failure is done via separate predicate and
-  calculus (see below).\<close>
-
-definition valid :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>") where
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). Q r s')"
-
-text \<open>
-  We often reason about invariant predicates. The following provides shorthand syntax
-  that avoids repeating potentially long predicates.\<close>
-abbreviation (input) invariant ::
-  "('s,'a) tmonad \<Rightarrow> ('s \<Rightarrow> bool) \<Rightarrow> bool" ("_ \<lbrace>_\<rbrace>" [59,0] 60) where
-  "invariant f P \<equiv> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. P\<rbrace>"
-
-text \<open>
-  Validity for the exception monad is similar and build on the standard
-  validity above. Instead of one postcondition, we have two: one for
-  normal and one for exceptional results.\<close>
-definition validE ::
-  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)" ) where
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<lbrace>P\<rbrace> f \<lbrace> \<lambda>v s. case v of Inr r \<Rightarrow> Q r s | Inl e \<Rightarrow> E e s \<rbrace>"
-
-lemma validE_def2:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). case r of Inr b \<Rightarrow> Q b s' | Inl a \<Rightarrow> E a s')"
-  by (unfold valid_def validE_def)
-(*
-text \<open>Validity for exception monad with interferences. Not as easy to phrase
- as we need to \<close>
-definition validIE :: "('s, 'a + 'b) tmonad \<Rightarrow>
-             's rg_pred \<Rightarrow>
-             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
-             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
-             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
- ("_ //PRE _//RELY _//GUAR _//POST _//EXC _" [59,0,0,0,0,0] 60) where
-  "validIE f P R G Q E \<equiv> f SAT [P,R,G,\<lambda>v. case v of Inr r \<Rightarrow> Q r | Inl e \<Rightarrow> E e]"
-
-abbreviation (input)
-  validIEsat :: "('s, 'a + 'b) tmonad \<Rightarrow>
-             's rg_pred \<Rightarrow>
-             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
-             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
-             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
-  ("_ //SAT [_, _, _, _, _]" [59,0,0,0,0,0] 60)
-  where
-  "validIEsat f P R G Q E \<equiv> validIE f P R G Q E"
- *)
-text \<open>
-  The following two instantiations are convenient to separate reasoning for exceptional and
-  normal case.\<close>
-(* Narrator: they are in fact not convenient, and are now considered a mistake that should have
-             been an abbreviation instead. *)
-definition validE_R :: (* FIXME lib: this should be an abbreviation *)
-  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>, -") where
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<equiv> validE P f Q (\<lambda>x y. True)"
-
-definition validE_E :: (* FIXME lib: this should be an abbreviation *)
-  "('s \<Rightarrow> bool) \<Rightarrow>  ('s, 'e + 'a) tmonad \<Rightarrow> ('e \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /-, \<lbrace>_\<rbrace>") where
-  "\<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace> \<equiv> validE P f (\<lambda>x y. True) Q"
-
-
-text \<open>rg_pred type: Rely-Guaranty predicates (state before => state after => bool)\<close>
-type_synonym 's rg_pred = "'s \<Rightarrow> 's \<Rightarrow> bool"
-
-text \<open>Abbreviations for trivial postconditions (taking three arguments):\<close>
-abbreviation(input)
-  toptoptop :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>\<top>") where
-  "\<top>\<top>\<top> \<equiv> \<lambda>_ _ _. True"
-
-abbreviation(input)
-  botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>") where
-  "\<bottom>\<bottom>\<bottom> \<equiv> \<lambda>_ _ _. False"
-
-
-subsection "Determinism"
-
-text \<open>
-  A monad of type @{text tmonad} is deterministic iff it
-  returns an empty trace, exactly one state and result and does not fail\<close>
-definition det :: "('a,'s) tmonad \<Rightarrow> bool" where
-  "det f \<equiv> \<forall>s. \<exists>r. f s = {([], Result r)}"
-
-text \<open>A deterministic @{text tmonad} can be turned into a normal state monad:\<close>
-definition the_run_state :: "('s,'a) tmonad \<Rightarrow> 's \<Rightarrow> 'a \<times> 's" where
-  "the_run_state M \<equiv> \<lambda>s. THE s'. mres (M s) = {s'}"
-
-
-subsection "Non-Failure"
-
-text \<open>
-  With the failure flag, we can formulate non-failure separately from validity.
-  A monad @{text m} does not fail under precondition @{text P}, if for no start
-  state that satisfies the precondition it sets the failure flag.
-\<close>
-definition no_fail :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> bool" where
-  "no_fail P m \<equiv> \<forall>s. P s \<longrightarrow> Failed \<notin> snd ` (m s)"
-
-text \<open>
-  It is often desired to prove non-failure and a Hoare triple simultaneously, as the reasoning
-  is often similar. The following definitions allow such reasoning to take place.\<close>
-
-definition validNF ::
-  "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>!") where
-  "validNF P f Q \<equiv> valid P f Q \<and> no_fail P f"
-
-definition validE_NF ::
-  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>!)") where
-  "validE_NF P f Q E \<equiv> validE P f Q E \<and> no_fail P f"
-
-lemma validE_NF_alt_def:
-  "\<lbrace> P \<rbrace> B \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>! = \<lbrace> P \<rbrace> B \<lbrace> \<lambda>v s. case v of Inl e \<Rightarrow> E e s | Inr r \<Rightarrow> Q r s \<rbrace>!"
-  by (clarsimp simp: validE_NF_def validE_def validNF_def)
-
-(* text \<open>
-  Usually, well-formed monads constructed from the primitives
-  above will have the following property: if they return an
-  empty set of results, they will have the failure flag set.\<close>
-definition empty_fail :: "('s,'a) tmonad \<Rightarrow> bool" where
-  "empty_fail m \<equiv> \<forall>s. fst (m s) = {} \<longrightarrow> snd (m s)"
-
-text \<open>
-  Useful in forcing otherwise unknown executions to have
-  the @{const empty_fail} property.\<close>
-definition mk_ef :: "'a set \<times> bool \<Rightarrow> 'a set \<times> bool" where
-  "mk_ef S \<equiv> (fst S, fst S = {} \<or> snd S)"
- *)
-section "Basic exception reasoning"
-
-text \<open>
-  The predicates @{text no_throw} and @{text no_return} allow us to reason about functions in
-  the exception monad that never throw an exception or never return normally.\<close>
-
-definition no_throw :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow> bool" where
-  "no_throw P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace> \<lambda>_ _. True \<rbrace>,\<lbrace> \<lambda>_ _. False \<rbrace>"
-
-definition no_return :: "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'b + 'c) tmonad \<Rightarrow> bool" where
-  "no_return P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace>\<lambda>_ _. False\<rbrace>,\<lbrace>\<lambda>_ _. True \<rbrace>"
-
 section "Trace monad Parallel"
 
 definition parallel :: "('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad" where
@@ -900,6 +740,18 @@ next
     done
 qed
 
+text \<open>rg_pred type: Rely-Guaranty predicates (state before => state after => bool)\<close>
+type_synonym 's rg_pred = "'s \<Rightarrow> 's \<Rightarrow> bool"
+
+text \<open>Abbreviations for trivial postconditions (taking three arguments):\<close>
+abbreviation(input)
+  toptoptop :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>\<top>") where
+  "\<top>\<top>\<top> \<equiv> \<lambda>_ _ _. True"
+
+abbreviation(input)
+  botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>") where
+  "\<bottom>\<bottom>\<bottom> \<equiv> \<lambda>_ _ _. False"
+
 definition rely_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
   "rely_cond R s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Env \<longrightarrow> R s0 s)"
 
diff --git a/lib/Monads/trace/Trace_Monad_Equations.thy b/lib/Monads/trace/Trace_Monad_Equations.thy
new file mode 100644
index 0000000000..4fef376434
--- /dev/null
+++ b/lib/Monads/trace/Trace_Monad_Equations.thy
@@ -0,0 +1,48 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+(* Equations between monads. Conclusions of the form "f = g" where f and g are monads.
+   Should not be Hoare triples (those go into a different theory). *)
+
+theory Trace_Monad_Equations
+  imports
+    Trace_Lemmas
+begin
+
+lemmas bind_then_eq = arg_cong2[where f=bind, OF _ refl]
+
+lemma modify_id:
+  "modify id = return ()"
+  by (simp add: modify_def get_def bind_def put_def return_def)
+
+lemma modify_modify:
+  "(do x \<leftarrow> modify f; modify (g x) od) = modify (g () o f)"
+  by (simp add: bind_def simpler_modify_def)
+
+lemmas modify_modify_bind = arg_cong2[where f=bind,
+  OF modify_modify refl, simplified bind_assoc]
+
+lemma select_single:
+  "select {x} = return x"
+  by (simp add: select_def return_def)
+
+lemma put_then_get[unfolded K_bind_def]:
+  "do put s; get od = do put s; return s od"
+  by (simp add: put_def bind_def get_def return_def)
+
+lemmas put_then_get_then
+    = put_then_get[THEN bind_then_eq, simplified bind_assoc return_bind]
+
+lemma select_empty_bind[simp]:
+  "select {} >>= f = select {}"
+  by (simp add: select_def bind_def)
+
+lemma fail_bind[simp]:
+  "fail >>= f = fail"
+  by (simp add: bind_def fail_def)
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_More_VCG.thy b/lib/Monads/trace/Trace_More_VCG.thy
new file mode 100644
index 0000000000..9a12ec1eeb
--- /dev/null
+++ b/lib/Monads/trace/Trace_More_VCG.thy
@@ -0,0 +1,20 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+(* Partial correctness Hoare logic lemmas over the trace monad. Hoare triples, lifting lemmas, etc.
+   If it doesn't contain a Hoare triple it likely doesn't belong in here. *)
+
+theory Trace_More_VCG
+  imports
+    Trace_VCG
+begin
+
+lemma hoare_pre_tautI:
+  "\<lbrakk> \<lbrace>A and P\<rbrace> a \<lbrace>B\<rbrace>; \<lbrace>A and not P\<rbrace> a \<lbrace>B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> a \<lbrace>B\<rbrace>"
+  by (fastforce simp: valid_def split_def pred_conj_def pred_neg_def)
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_No_Fail.thy b/lib/Monads/trace/Trace_No_Fail.thy
new file mode 100644
index 0000000000..0a8fbf5212
--- /dev/null
+++ b/lib/Monads/trace/Trace_No_Fail.thy
@@ -0,0 +1,142 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+(* Lemmas about the no_fail predicate. *)
+
+theory Trace_No_Fail
+  imports
+    Trace_In_Monad
+    Trace_VCG
+    WPSimp
+begin
+
+subsection "Non-Failure"
+
+text \<open>
+  With the failure flag, we can formulate non-failure separately from validity.
+  A monad @{text m} does not fail under precondition @{text P}, if for no start
+  state that satisfies the precondition it sets the failure flag.
+\<close>
+definition no_fail :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> bool" where
+  "no_fail P m \<equiv> \<forall>s. P s \<longrightarrow> Failed \<notin> snd ` (m s)"
+
+
+subsection \<open>@{method wpc} setup\<close>
+
+lemma no_fail_pre[wp_pre]:
+  "\<lbrakk> no_fail P f; \<And>s. Q s \<Longrightarrow> P s\<rbrakk> \<Longrightarrow> no_fail Q f"
+  by (simp add: no_fail_def)
+
+lemma wpc_helper_no_fail_final:
+  "no_fail Q f \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') (no_fail P f)"
+  by (clarsimp simp: wpc_helper_def elim!: no_fail_pre)
+
+wpc_setup "\<lambda>m. no_fail P m" wpc_helper_no_fail_final
+
+
+subsection \<open>Bundles\<close>
+
+bundle no_pre = hoare_pre [wp_pre del] no_fail_pre [wp_pre del]
+
+
+subsection \<open>Lemmas\<close>
+
+lemma no_failD:
+  "\<lbrakk> no_fail P m; P s \<rbrakk> \<Longrightarrow> Failed \<notin> snd ` m s"
+  by (simp add: no_fail_def)
+
+lemma no_fail_modify[wp,simp]:
+  "no_fail \<top> (modify f)"
+  by (simp add: no_fail_def modify_def get_def put_def bind_def)
+
+lemma no_fail_gets_simp[simp]:
+  "no_fail P (gets f)"
+  unfolding no_fail_def gets_def get_def return_def bind_def
+  by simp
+
+lemma no_fail_gets[wp]:
+  "no_fail \<top> (gets f)"
+  by simp
+
+lemma no_fail_select[simp]:
+  "no_fail \<top> (select S)"
+  by (simp add: no_fail_def select_def image_def)
+
+lemma no_fail_alt[wp]:
+  "\<lbrakk> no_fail P f; no_fail Q g \<rbrakk> \<Longrightarrow> no_fail (P and Q) (f \<sqinter> g)"
+  by (auto simp: no_fail_def alternative_def)
+
+lemma no_fail_return[simp, wp]:
+  "no_fail \<top> (return x)"
+  by (simp add: return_def no_fail_def)
+
+lemma no_fail_get[simp, wp]:
+  "no_fail \<top> get"
+  by (simp add: get_def no_fail_def)
+
+lemma no_fail_put[simp, wp]:
+  "no_fail \<top> (put s)"
+  by (simp add: put_def no_fail_def)
+
+lemma no_fail_when[wp]:
+  "(P \<Longrightarrow> no_fail Q f) \<Longrightarrow> no_fail (if P then Q else \<top>) (when P f)"
+  by (simp add: when_def)
+
+lemma no_fail_unless[wp]:
+  "(\<not>P \<Longrightarrow> no_fail Q f) \<Longrightarrow> no_fail (if P then \<top> else Q) (unless P f)"
+  by (simp add: unless_def when_def)
+
+lemma no_fail_fail[simp, wp]:
+  "no_fail \<bottom> fail"
+  by (simp add: fail_def no_fail_def)
+
+lemma no_fail_assert[simp, wp]:
+  "no_fail (\<lambda>_. P) (assert P)"
+  by (simp add: assert_def)
+
+lemma no_fail_assert_opt[simp, wp]:
+  "no_fail (\<lambda>_. P \<noteq> None) (assert_opt P)"
+  by (simp add: assert_opt_def split: option.splits)
+
+lemma no_fail_case_option[wp]:
+  assumes f: "no_fail P f"
+  assumes g: "\<And>x. no_fail (Q x) (g x)"
+  shows "no_fail (if x = None then P else Q (the x)) (case_option f g x)"
+  by (clarsimp simp add: f g)
+
+lemma no_fail_if[wp]:
+  "\<lbrakk> P \<Longrightarrow> no_fail Q f; \<not>P \<Longrightarrow> no_fail R g \<rbrakk> \<Longrightarrow> no_fail (if P then Q else R) (if P then f else g)"
+  by simp
+
+lemma no_fail_apply[wp]:
+  "no_fail P (f (g x)) \<Longrightarrow> no_fail P (f $ g x)"
+  by simp
+
+lemma no_fail_undefined[simp, wp]:
+  "no_fail \<bottom> undefined"
+  by (simp add: no_fail_def)
+
+lemma no_fail_returnOK[simp, wp]:
+  "no_fail \<top> (returnOk x)"
+  by (simp add: returnOk_def)
+
+lemma no_fail_bind[wp]:
+  "\<lbrakk> no_fail P f; \<And>x. no_fail (R x) (g x); \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> no_fail (P and Q) (f >>= (\<lambda>rv. g rv))"
+  apply (simp add: no_fail_def bind_def2 image_Un image_image
+                   in_image_constant)
+  apply (intro allI conjI impI)
+   apply (fastforce simp: image_def)
+  apply clarsimp
+  apply (drule(1) post_by_hoare, erule in_mres)
+  apply (fastforce simp: image_def)
+  done
+
+lemma no_fail_or:
+  "\<lbrakk>no_fail P a; no_fail Q a\<rbrakk> \<Longrightarrow> no_fail (P or Q) a"
+  by (clarsimp simp: no_fail_def)
+
+end
diff --git a/lib/Monads/trace/Trace_No_Throw.thy b/lib/Monads/trace/Trace_No_Throw.thy
new file mode 100644
index 0000000000..c98ac96598
--- /dev/null
+++ b/lib/Monads/trace/Trace_No_Throw.thy
@@ -0,0 +1,28 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+(* Lemmas about no_throw. Usually should have a conclusion "no_throw P m".
+   Includes some monad equations that have no_throw as a main assumption.  *)
+
+theory Trace_No_Throw
+  imports
+    Trace_VCG
+begin
+
+section "Basic exception reasoning"
+
+text \<open>
+  The predicates @{text no_throw} and @{text no_return} allow us to reason about functions in
+  the exception monad that never throw an exception or never return normally.\<close>
+
+definition no_throw :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow> bool" where
+  "no_throw P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace> \<lambda>_ _. True \<rbrace>,\<lbrace> \<lambda>_ _. False \<rbrace>"
+
+definition no_return :: "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'b + 'c) tmonad \<Rightarrow> bool" where
+  "no_return P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace>\<lambda>_ _. False\<rbrace>,\<lbrace>\<lambda>_ _. True \<rbrace>"
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_Sat.thy b/lib/Monads/trace/Trace_Sat.thy
new file mode 100644
index 0000000000..2f40ec7b78
--- /dev/null
+++ b/lib/Monads/trace/Trace_Sat.thy
@@ -0,0 +1,111 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_Sat
+  imports
+    Trace_Monad
+    WPSimp
+begin
+
+section \<open>Satisfiability\<close>
+
+text \<open>
+  The dual to validity: an existential instead of a universal quantifier for the post condition.
+  In refinement, it is often sufficient to know that there is one state that satisfies a condition.\<close>
+definition exs_valid ::
+  "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace> _ \<exists>\<lbrace>_\<rbrace>") where
+  "\<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<exists>(rv, s') \<in> mres (f s). Q rv s')"
+
+text \<open>The above for the exception monad\<close>
+definition ex_exs_validE ::
+  "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'e + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('e \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace> _ \<exists>\<lbrace>_\<rbrace>, \<lbrace>_\<rbrace>") where
+  "\<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace> \<equiv> \<lbrace>P\<rbrace> f  \<exists>\<lbrace>\<lambda>rv. case rv of Inl e \<Rightarrow> E e | Inr v \<Rightarrow> Q v\<rbrace>"
+
+
+subsection \<open>Set up for @{method wp}\<close>
+
+definition exs_postcondition where
+  "exs_postcondition P f \<equiv> \<lambda>a b. \<exists>(rv, s) \<in> f a b. P rv s"
+
+lemma exs_valid_is_triple[wp_trip]:
+  "exs_valid P f Q = triple_judgement P f (exs_postcondition Q (\<lambda>s f. mres (f s)))"
+  by (simp add: triple_judgement_def exs_postcondition_def exs_valid_def)
+
+
+subsection \<open>Rules\<close>
+
+lemma exs_hoare_post_imp:
+  "\<lbrakk>\<And>r s. Q r s \<Longrightarrow> R r s; \<lbrace>P\<rbrace> a \<exists>\<lbrace>Q\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<exists>\<lbrace>R\<rbrace>"
+  unfolding exs_valid_def by blast
+
+lemma use_exs_valid:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>; P s \<rbrakk> \<Longrightarrow> \<exists>(r, s') \<in> mres (f s). Q r s'"
+  by (simp add: exs_valid_def)
+
+lemma exs_valid_weaken_pre[wp_pre]:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<exists>\<lbrace>Q\<rbrace>; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>"
+  by (clarsimp simp: exs_valid_def)
+
+lemma exs_valid_chain:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>; \<And>s. R s \<Longrightarrow> P s; \<And>r s. Q r s \<Longrightarrow> S r s \<rbrakk> \<Longrightarrow> \<lbrace>R\<rbrace> f \<exists>\<lbrace>S\<rbrace>"
+  by (fastforce simp: exs_valid_def Bex_def)
+
+lemma exs_valid_assume_pre:
+  "\<lbrakk> \<And>s. P s \<Longrightarrow> \<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>"
+  by (fastforce simp: exs_valid_def)
+
+lemma exs_valid_bind[wp_split]:
+  "\<lbrakk> \<And>rv. \<lbrace>B rv\<rbrace> g rv \<exists>\<lbrace>C\<rbrace>; \<lbrace>A\<rbrace> f \<exists>\<lbrace>B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> f >>= (\<lambda>rv. g rv) \<exists>\<lbrace>C\<rbrace>"
+  apply atomize
+  apply (clarsimp simp: exs_valid_def bind_def2 mres_def)
+  apply (drule spec, drule(1) mp, clarsimp)
+  apply (drule spec2, drule(1) mp, clarsimp)
+  apply (simp add: image_def bex_Un)
+  apply (strengthen subst[where P="\<lambda>x. x \<in> f s" for s, mk_strg I _ E], simp)
+  apply (fastforce elim: rev_bexI)
+  done
+
+lemma exs_valid_return[wp]:
+  "\<lbrace>Q v\<rbrace> return v \<exists>\<lbrace>Q\<rbrace>"
+  by (clarsimp simp: exs_valid_def return_def mres_def)
+
+lemma exs_valid_select[wp]:
+  "\<lbrace>\<lambda>s. \<exists>r \<in> S. Q r s\<rbrace> select S \<exists>\<lbrace>Q\<rbrace>"
+  apply (clarsimp simp: exs_valid_def select_def mres_def)
+  apply (auto simp add: image_def)
+  done
+
+lemma exs_valid_get[wp]:
+  "\<lbrace>\<lambda>s. Q s s\<rbrace> get \<exists>\<lbrace> Q \<rbrace>"
+  by (clarsimp simp: exs_valid_def get_def mres_def)
+
+lemma exs_valid_gets[wp]:
+  "\<lbrace>\<lambda>s. Q (f s) s\<rbrace> gets f \<exists>\<lbrace>Q\<rbrace>"
+  by (clarsimp simp: gets_def) wp
+
+lemma exs_valid_put[wp]:
+  "\<lbrace>Q v\<rbrace> put v \<exists>\<lbrace>Q\<rbrace>"
+  by (clarsimp simp: put_def exs_valid_def mres_def)
+
+lemma exs_valid_fail[wp]:
+  "\<lbrace>\<lambda>s. False\<rbrace> fail \<exists>\<lbrace>Q\<rbrace>"
+  unfolding fail_def exs_valid_def
+  by simp
+
+lemma exs_valid_state_assert[wp]:
+    "\<lbrace> \<lambda>s. Q () s \<and> G s \<rbrace> state_assert G \<exists>\<lbrace> Q \<rbrace>"
+  by (clarsimp simp: state_assert_def exs_valid_def get_def
+           assert_def bind_def2 return_def mres_def)
+
+lemmas exs_valid_guard = exs_valid_state_assert
+
+lemma exs_valid_condition[wp]:
+  "\<lbrakk> \<lbrace>P\<rbrace> l \<exists>\<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> r \<exists>\<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. (C s \<and> P s) \<or> (\<not> C s \<and> P' s)\<rbrace> condition C l r \<exists>\<lbrace>Q\<rbrace>"
+  by (clarsimp simp: condition_def exs_valid_def split: sum.splits)
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_Strengthen_Setup.thy b/lib/Monads/trace/Trace_Strengthen_Setup.thy
new file mode 100644
index 0000000000..bd978d60c1
--- /dev/null
+++ b/lib/Monads/trace/Trace_Strengthen_Setup.thy
@@ -0,0 +1,46 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_Strengthen_Setup
+  imports
+    Strengthen
+    Trace_No_Fail
+    Trace_VCG
+begin
+
+section \<open>Strengthen setup.\<close>
+
+context strengthen_implementation begin
+
+lemma strengthen_hoare[strg]:
+  "\<lbrakk>\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s)\<rbrakk>
+   \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>)"
+  by (cases F, auto elim: hoare_strengthen_post)
+
+lemma strengthen_validE_R_cong[strg]:
+  "\<lbrakk>\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s)\<rbrakk>
+   \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, -) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, -)"
+  by (cases F, auto intro: hoare_post_imp_R)
+
+lemma strengthen_validE_cong[strg]:
+  "\<lbrakk>\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s); \<And>r s. st F (\<longrightarrow>) (S r s) (T r s)\<rbrakk>
+   \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>S\<rbrace>) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>T\<rbrace>)"
+  by (cases F, auto elim: hoare_post_impErr)
+
+lemma strengthen_validE_E_cong[strg]:
+  "\<lbrakk>\<And>r s. st F (\<longrightarrow>) (S r s) (T r s)\<rbrakk>
+   \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f -, \<lbrace>S\<rbrace>) (\<lbrace>P\<rbrace> f -, \<lbrace>T\<rbrace>)"
+  by (cases F, auto elim: hoare_post_impErr simp: validE_E_def)
+
+lemma strengthen_validI[strg]:
+  "\<lbrakk>\<And>r s0 s. st F (\<longrightarrow>) (Q r s0 s) (Q' r s0 s)\<rbrakk>
+   \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace>,\<lbrace>G\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>Q\<rbrace>) (\<lbrace>P\<rbrace>,\<lbrace>G\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>Q'\<rbrace>)"
+  by (cases F, auto elim: validI_strengthen_post)
+
+end
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_Total.thy b/lib/Monads/trace/Trace_Total.thy
new file mode 100644
index 0000000000..97c804807c
--- /dev/null
+++ b/lib/Monads/trace/Trace_Total.thy
@@ -0,0 +1,346 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+(* Total correctness Hoare logic for the Trace_Monad (= valid + no_fail) *)
+
+theory Trace_Total
+  imports Trace_No_Fail
+begin
+
+section \<open>Total correctness for Trace_Monad and Trace_Monad with exceptions\<close>
+
+subsection Definitions
+
+text \<open>
+  It is often desired to prove non-failure and a Hoare triple simultaneously, as the reasoning
+  is often similar. The following definitions allow such reasoning to take place.\<close>
+
+definition validNF ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>!") where
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>! \<equiv> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<and> no_fail P f"
+
+lemma validNF_alt_def:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>! = (\<forall>s. P s \<longrightarrow> ((\<forall>(r', s') \<in> mres (f s). Q r' s') \<and> Failed \<notin> snd ` (f s)))"
+  by (auto simp: validNF_def valid_def no_fail_def)
+
+definition validE_NF ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>!)") where
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>! \<equiv> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace> \<and> no_fail P f"
+
+lemma validE_NF_alt_def:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>! = \<lbrace>P\<rbrace> f \<lbrace>\<lambda>v s. case v of Inl e \<Rightarrow> E e s | Inr r \<Rightarrow> Q r s\<rbrace>!"
+  by (clarsimp simp: validE_NF_def validE_def validNF_def)
+
+
+subsection \<open>@{method wpc} setup\<close>
+
+lemma wpc_helper_validNF:
+  "\<lbrace>Q\<rbrace> g \<lbrace>S\<rbrace>! \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> g \<lbrace>S\<rbrace>!"
+  unfolding wpc_helper_def
+  by clarsimp (metis hoare_vcg_precond_imp no_fail_pre validNF_def)
+
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>!" wpc_helper_validNF
+
+
+subsection \<open>Basic @{const validNF} theorems\<close>
+
+lemma validNF[intro?]: (* FIXME lib: should be validNFI *)
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>; no_fail P f \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!"
+  by (clarsimp simp: validNF_def)
+
+lemma validNF_valid:
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>"
+  by (clarsimp simp: validNF_def)
+
+lemma validNF_no_fail:
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>! \<rbrakk> \<Longrightarrow> no_fail P f"
+  by (clarsimp simp: validNF_def)
+
+lemma snd_validNF:
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!; P s \<rbrakk> \<Longrightarrow> Failed \<notin> snd ` (f s)"
+  by (clarsimp simp: validNF_def no_fail_def)
+
+lemma use_validNF:
+  "\<lbrakk> (r', s') \<in> mres (f s); \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!; P s \<rbrakk> \<Longrightarrow> Q r' s'"
+  by (fastforce simp: validNF_def valid_def)
+
+
+subsection \<open>@{const validNF} weakest precondition rules\<close>
+
+lemma validNF_return[wp]:
+  "\<lbrace> P x \<rbrace> return x \<lbrace> P \<rbrace>!"
+  by (wp validNF)+
+
+lemma validNF_get[wp]:
+  "\<lbrace> \<lambda>s. P s s  \<rbrace> get \<lbrace> P \<rbrace>!"
+  by (wp validNF)+
+
+lemma validNF_put[wp]:
+  "\<lbrace> \<lambda>s. P () x  \<rbrace> put x \<lbrace> P \<rbrace>!"
+  by (wp validNF)+
+
+lemma validNF_K_bind[wp]:
+  "\<lbrace> P \<rbrace> x \<lbrace> Q \<rbrace>! \<Longrightarrow> \<lbrace> P \<rbrace> K_bind x f \<lbrace> Q \<rbrace>!"
+  by simp
+
+lemma validNF_fail[wp]:
+  "\<lbrace> \<lambda>s. False \<rbrace> fail \<lbrace> Q \<rbrace>!"
+  by (clarsimp simp: validNF_def fail_def no_fail_def)
+
+lemma validNF_prop[wp_unsafe]:
+  "\<lbrakk> no_fail (\<lambda>s. P) f \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s. P \<rbrace> f \<lbrace> \<lambda>rv s. P \<rbrace>!"
+  by (wp validNF)+
+
+lemma validNF_post_conj[intro!]:
+  "\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> Q \<rbrace>!; \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> a \<lbrace> Q and R \<rbrace>!"
+  by (auto simp: validNF_def)
+
+lemma validNF_pre_disj[intro!]:
+  "\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>!; \<lbrace> Q \<rbrace> a \<lbrace> R \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P or Q \<rbrace> a \<lbrace> R \<rbrace>!"
+  by (rule validNF) (auto dest: validNF_valid validNF_no_fail intro: no_fail_or)
+
+text \<open>
+  Set up combination rules for @{method wp}, which also requires a @{text wp_trip} rule for
+  @{const validNF}.\<close>
+definition validNF_property :: "('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> ('s,'a) tmonad \<Rightarrow> bool" where
+  "validNF_property Q s b \<equiv> Failed \<notin> snd ` (b s) \<and> (\<forall>(r', s') \<in> mres (b s). Q r' s')"
+
+lemma validNF_is_triple[wp_trip]:
+  "validNF P f Q = triple_judgement P f (validNF_property Q)"
+  by (auto simp: validNF_def triple_judgement_def validNF_property_def no_fail_def valid_def)
+
+lemma validNF_weaken_pre[wp_pre]:
+  "\<lbrakk>\<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>!; \<And>s. P s \<Longrightarrow> Q s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>!"
+  by (metis hoare_pre_imp no_fail_pre validNF_def)
+
+lemma validNF_post_comb_imp_conj:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>!; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
+  by (fastforce simp: validNF_def valid_def)
+
+lemma validNF_post_comb_conj_L:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
+  by (fastforce simp: validNF_def valid_def no_fail_def)
+
+lemma validNF_post_comb_conj_R:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
+  by (fastforce simp: validNF_def valid_def no_fail_def)
+
+lemma validNF_post_comb_conj:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
+  by (fastforce simp: validNF_def valid_def no_fail_def)
+
+lemma validNF_if_split[wp_split]:
+  "\<lbrakk>P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>S\<rbrace>!; \<not> P \<Longrightarrow> \<lbrace>R\<rbrace> g \<lbrace>S\<rbrace>!\<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not> P \<longrightarrow> R s)\<rbrace> if P then f else g \<lbrace>S\<rbrace>!"
+  by simp
+
+lemma validNF_vcg_conj_lift:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
+  by (fastforce intro!: validNF_post_conj[unfolded pred_conj_def] intro: validNF_weaken_pre)
+
+lemma validNF_vcg_disj_lift:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<or> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<or> Q' rv s\<rbrace>!"
+  by (auto  simp: validNF_def no_fail_def intro!: hoare_vcg_disj_lift)
+
+lemma validNF_vcg_all_lift[wp]:
+  "\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>!"
+  by (auto simp: validNF_def no_fail_def intro!: hoare_vcg_all_lift)
+
+lemma validNF_bind[wp_split]:
+  "\<lbrakk> \<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>C\<rbrace>!"
+  unfolding validNF_def
+  by (auto intro: hoare_seq_ext no_fail_bind[where P=Q and Q=Q for Q, simplified])
+
+lemmas validNF_seq_ext = validNF_bind
+
+
+subsection "validNF compound rules"
+
+lemma validNF_state_assert[wp]:
+  "\<lbrace> \<lambda>s. P () s \<and> G s  \<rbrace> state_assert G \<lbrace> P \<rbrace>!"
+  apply (rule validNF)
+  apply wpsimp
+  apply (clarsimp simp: no_fail_def state_assert_def
+              bind_def2 assert_def return_def get_def)
+  done
+
+lemma validNF_modify[wp]:
+  "\<lbrace> \<lambda>s. P () (f s) \<rbrace> modify f \<lbrace> P \<rbrace>!"
+  apply (clarsimp simp: modify_def)
+  apply wp
+  done
+
+lemma validNF_gets[wp]:
+  "\<lbrace>\<lambda>s. P (f s) s\<rbrace> gets f \<lbrace>P\<rbrace>!"
+  apply (clarsimp simp: gets_def)
+  apply wp
+  done
+
+lemma validNF_condition[wp]:
+  "\<lbrakk> \<lbrace> Q \<rbrace> A \<lbrace>P\<rbrace>!; \<lbrace> R \<rbrace> B \<lbrace>P\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. if C s then Q s else R s\<rbrace> condition C A B \<lbrace>P\<rbrace>!"
+  apply rule
+   apply (drule validNF_valid)+
+   apply (erule (1) condition_wp)
+  apply (drule validNF_no_fail)+
+  apply (clarsimp simp: no_fail_def condition_def)
+  done
+
+lemma validNF_assert[wp]:
+    "\<lbrace> (\<lambda>s. P) and (R ()) \<rbrace> assert P \<lbrace> R \<rbrace>!"
+  apply (rule validNF)
+   apply (clarsimp simp: valid_def in_return)
+  apply (clarsimp simp: no_fail_def return_def)
+  done
+
+lemma validNF_false_pre:
+  "\<lbrace> \<lambda>_. False \<rbrace> P \<lbrace> Q \<rbrace>!"
+  by (clarsimp simp: validNF_def no_fail_def)
+
+lemma validNF_chain:
+   "\<lbrakk>\<lbrace>P'\<rbrace> a \<lbrace>R'\<rbrace>!; \<And>s. P s \<Longrightarrow> P' s; \<And>r s. R' r s \<Longrightarrow> R r s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>!"
+  by (fastforce simp: validNF_def valid_def no_fail_def Ball_def)
+
+lemma validNF_case_prod[wp]:
+  "\<lbrakk> \<And>x y. validNF (P x y) (B x y) Q \<rbrakk> \<Longrightarrow> validNF (case_prod P v) (case_prod (\<lambda>x y. B x y) v) Q"
+  by (metis prod.exhaust split_conv)
+
+lemma validE_NF_case_prod[wp]:
+    "\<lbrakk> \<And>a b. \<lbrace>P a b\<rbrace> f a b \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow>
+          \<lbrace>case x of (a, b) \<Rightarrow> P a b\<rbrace> case x of (a, b) \<Rightarrow> f a b \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!"
+  apply (clarsimp simp: validE_NF_alt_def)
+  apply (erule validNF_case_prod)
+  done
+
+lemma no_fail_is_validNF_True: "no_fail P s = (\<lbrace> P \<rbrace> s \<lbrace> \<lambda>_ _. True \<rbrace>!)"
+  by (clarsimp simp: no_fail_def validNF_def valid_def)
+
+
+subsection \<open>@{const validNF} reasoning in the exception monad\<close>
+
+lemma validE_NF[intro?]:
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>; no_fail P f \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>!"
+  by (clarsimp simp: validE_NF_def)
+
+lemma validE_NF_valid:
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>"
+  by (clarsimp simp: validE_NF_def)
+
+lemma validE_NF_no_fail:
+  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>! \<rbrakk> \<Longrightarrow> no_fail P f"
+  by (clarsimp simp: validE_NF_def)
+
+lemma validE_NF_weaken_pre[wp_pre]:
+  "\<lbrakk>\<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>!; \<And>s. P s \<Longrightarrow> Q s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>!"
+  by (simp add: validE_NF_alt_def validNF_weaken_pre)
+
+lemma validE_NF_post_comb_conj_L:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace>\<lambda>_ _. True\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>, \<lbrace>E\<rbrace>!"
+  unfolding validE_NF_alt_def
+  by (fastforce simp: validE_def validNF_def valid_def no_fail_def split: sum.splits)
+
+lemma validE_NF_post_comb_conj_R:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>\<lambda>_ _. True\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>, \<lbrace>E\<rbrace>!"
+  unfolding validE_NF_alt_def validE_def validNF_def valid_def no_fail_def
+  by (force split: sum.splits)
+
+lemma validE_NF_post_comb_conj:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>, \<lbrace>E\<rbrace>!"
+  unfolding validE_NF_alt_def validE_def validNF_def valid_def no_fail_def
+  by (force split: sum.splits)
+
+lemma validE_NF_chain:
+  "\<lbrakk> \<lbrace>P'\<rbrace> a \<lbrace>R'\<rbrace>,\<lbrace>E'\<rbrace>!; \<And>s. P s \<Longrightarrow> P' s; \<And>r' s'. R' r' s' \<Longrightarrow> R r' s';
+     \<And>r'' s''. E' r'' s'' \<Longrightarrow> E r'' s''\<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. P s \<rbrace> a \<lbrace>\<lambda>r' s'. R r' s'\<rbrace>,\<lbrace>\<lambda>r'' s''. E r'' s''\<rbrace>!"
+  by (fastforce simp: validE_NF_def validE_def2 no_fail_def Ball_def split: sum.splits)
+
+lemma validE_NF_bind_wp[wp]:
+  "\<lbrakk>\<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>, \<lbrace>E\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> f >>=E (\<lambda>x. g x) \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>!"
+  apply (unfold validE_NF_alt_def bindE_def)
+  apply (rule validNF_bind [rotated])
+   apply assumption
+  apply (clarsimp simp: lift_def throwError_def split: sum.splits)
+    apply wpsimp
+  done
+
+lemma validNF_catch[wp]:
+  "\<lbrakk>\<And>x. \<lbrace>E x\<rbrace> handler x \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f <catch> (\<lambda>x. handler x) \<lbrace>Q\<rbrace>!"
+  apply (unfold validE_NF_alt_def catch_def)
+  apply (rule validNF_bind [rotated])
+   apply assumption
+  apply (clarsimp simp: lift_def throwError_def split: sum.splits)
+  apply wp
+  done
+
+lemma validNF_throwError[wp]:
+  "\<lbrace>E e\<rbrace> throwError e \<lbrace>P\<rbrace>, \<lbrace>E\<rbrace>!"
+  by (unfold validE_NF_alt_def throwError_def o_def) wpsimp
+
+lemma validNF_returnOk[wp]:
+  "\<lbrace>P e\<rbrace> returnOk e \<lbrace>P\<rbrace>, \<lbrace>E\<rbrace>!"
+ by (clarsimp simp: validE_NF_alt_def returnOk_def) wpsimp
+
+lemma validNF_whenE[wp]:
+  "(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>!) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>!"
+  unfolding whenE_def by clarsimp wp
+
+lemma validNF_nobindE[wp]:
+  "\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>\<lambda>r s. B s\<rbrace>,\<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> doE f; g odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>!"
+  by clarsimp wp
+
+text \<open>
+  Set up triple rules for @{term validE_NF} so that we can use @{method wp} combinator rules.\<close>
+definition validE_NF_property ::
+  "('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> ('s, 'c+'a) tmonad \<Rightarrow> bool" where
+  "validE_NF_property Q E s b \<equiv>
+   Failed \<notin> snd ` (b s) \<and> (\<forall>(r', s') \<in> mres (b s). case r' of Inl x \<Rightarrow> E x s' | Inr x \<Rightarrow> Q x s')"
+
+lemma validE_NF_is_triple[wp_trip]:
+  "validE_NF P f Q E = triple_judgement P f (validE_NF_property Q E)"
+  by (fastforce simp: validE_NF_def validE_def2 no_fail_def triple_judgement_def
+                      validE_NF_property_def
+                split: sum.splits)
+
+lemma validNF_cong:
+  "\<lbrakk> \<And>s. P s = P' s; \<And>s. P s \<Longrightarrow> m s = m' s;
+     \<And>r' s' s. \<lbrakk> P s; (r', s') \<in> mres (m s) \<rbrakk> \<Longrightarrow> Q r' s' = Q' r' s' \<rbrakk> \<Longrightarrow>
+   (\<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>!) = (\<lbrace>P'\<rbrace> m' \<lbrace>Q'\<rbrace>!)"
+  by (fastforce simp: validNF_alt_def)
+
+lemma validE_NF_liftE[wp]:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>! \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
+  by (wpsimp simp: validE_NF_alt_def liftE_def)
+
+lemma validE_NF_handleE'[wp]:
+  "\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>! \<rbrakk> \<Longrightarrow>
+   \<lbrace>P\<rbrace> f <handle2> (\<lambda>x. handler x) \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
+  unfolding validE_NF_alt_def handleE'_def
+  apply (erule validNF_bind[rotated])
+  apply (clarsimp split: sum.splits)
+  apply wpsimp
+  done
+
+lemma validE_NF_handleE[wp]:
+  "\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>! \<rbrakk> \<Longrightarrow>
+   \<lbrace>P\<rbrace> f <handle> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
+  unfolding handleE_def
+  by (metis validE_NF_handleE')
+
+lemma validE_NF_condition[wp]:
+  "\<lbrakk> \<lbrace> Q \<rbrace> A \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!; \<lbrace> R \<rbrace> B \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!\<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. if C s then Q s else R s\<rbrace> condition C A B \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!"
+  apply rule
+   apply (drule validE_NF_valid)+
+   apply wp
+  apply (drule validE_NF_no_fail)+
+  apply (clarsimp simp: no_fail_def condition_def)
+  done
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_VCG.thy b/lib/Monads/trace/Trace_VCG.thy
index 9bdc420918..944650d4a7 100644
--- a/lib/Monads/trace/Trace_VCG.thy
+++ b/lib/Monads/trace/Trace_VCG.thy
@@ -1,633 +1,152 @@
 (*
+ * Copyright 2023, Proofcraft Pty Ltd
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
-theory Trace_VCG
-imports
-  Trace_Monad
-  Fun_Pred_Syntax
-  WPSimp
-begin
-
-lemma trace_steps_append:
-  "trace_steps (xs @ ys) s
-    = trace_steps xs s \<union> trace_steps ys (last_st_tr (rev xs) s)"
-  by (induct xs arbitrary: s, simp_all add: last_st_tr_def hd_append)
-
-lemma rely_cond_append:
-  "rely_cond R s (xs @ ys) = (rely_cond R s ys \<and> rely_cond R (last_st_tr ys s) xs)"
-  by (simp add: rely_cond_def trace_steps_append ball_Un conj_comms)
-
-lemma guar_cond_append:
-  "guar_cond G s (xs @ ys) = (guar_cond G s ys \<and> guar_cond G (last_st_tr ys s) xs)"
-  by (simp add: guar_cond_def trace_steps_append ball_Un conj_comms)
-
-lemma prefix_closed_bind:
-  "prefix_closed f \<Longrightarrow> (\<forall>x. prefix_closed (g x)) \<Longrightarrow> prefix_closed (f >>= g)"
-  apply (subst prefix_closed_def, clarsimp simp: bind_def)
-  apply (auto simp: Cons_eq_append_conv split: tmres.split_asm
-             dest!: prefix_closedD[rotated];
-    fastforce elim: rev_bexI)
-  done
-
-lemmas prefix_closed_bind[rule_format, wp_split]
-
-lemma last_st_tr_append[simp]:
-  "last_st_tr (tr @ tr') s = last_st_tr tr (last_st_tr tr' s)"
-  by (simp add: last_st_tr_def hd_append)
-
-lemma last_st_tr_Nil[simp]:
-  "last_st_tr [] s = s"
-  by (simp add: last_st_tr_def)
-
-lemma last_st_tr_Cons[simp]:
-  "last_st_tr (x # xs) s = snd x"
-  by (simp add: last_st_tr_def)
-
-lemma bind_twp[wp_split]:
-  "\<lbrakk>  \<And>r. \<lbrace>Q' r\<rbrace>,\<lbrace>R\<rbrace> g r \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f >>= (\<lambda>r. g r) \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (subst validI_def, rule conjI)
-   apply (blast intro: prefix_closed_bind validI_prefix_closed)
-  apply (clarsimp simp: bind_def rely_def)
-  apply (drule(2) validI_D)
-   apply (clarsimp simp: rely_cond_append split: tmres.split_asm)
-  apply (clarsimp split: tmres.split_asm)
-  apply (drule meta_spec, frule(2) validI_D)
-   apply (clarsimp simp: rely_cond_append split: if_split_asm)
-  apply (clarsimp simp: guar_cond_append)
-  done
-
-lemma trace_steps_rev_drop_nth:
-  "trace_steps (rev (drop n tr)) s
-        = (\<lambda>i. (fst (rev tr ! i), (if i = 0 then s else snd (rev tr ! (i - 1))),
-            snd (rev tr ! i))) ` {..< length tr - n}"
-  apply (simp add: trace_steps_nth)
-  apply (intro image_cong refl)
-  apply (simp add: rev_nth)
-  done
-
-lemma prefix_closed_drop:
-  "(tr, res) \<in> f s \<Longrightarrow> prefix_closed f \<Longrightarrow> \<exists>res'. (drop n tr, res') \<in> f s"
-proof (induct n arbitrary: res)
-  case 0 then show ?case by auto
-next
-  case (Suc n)
-  have drop_1: "\<And>tr res. (tr, res) \<in> f s \<Longrightarrow> \<exists>res'. (drop 1 tr, res') \<in> f s"
-    by (case_tac tr; fastforce dest: prefix_closedD[rotated] intro: Suc)
-  show ?case
-    using Suc.hyps[OF Suc.prems]
-    by (metis drop_1[simplified] drop_drop add_0 add_Suc)
-qed
-
-lemma validI_GD_drop:
-  "\<lbrakk> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>; P s0 s; (tr, res) \<in> f s;
-        rely_cond R s0 (drop n tr) \<rbrakk>
-    \<Longrightarrow> guar_cond G s0 (drop n tr)"
-  apply (drule prefix_closed_drop[where n=n], erule validI_prefix_closed)
-  apply (auto dest: validI_GD)
-  done
-
-lemma parallel_prefix_closed[wp_split]:
-  "prefix_closed f \<Longrightarrow> prefix_closed g
-    \<Longrightarrow> prefix_closed (parallel f g)"
-  apply (subst prefix_closed_def, clarsimp simp: parallel_def)
-  apply (case_tac f_steps; clarsimp)
-  apply (drule(1) prefix_closedD)+
-  apply fastforce
-  done
-
-lemma rely_cond_drop:
-  "rely_cond R s0 xs \<Longrightarrow> rely_cond R s0 (drop n xs)"
-  using rely_cond_append[where xs="take n xs" and ys="drop n xs"]
-  by simp
-
-lemma rely_cond_is_drop:
-  "rely_cond R s0 xs
-    \<Longrightarrow> (ys = drop (length xs - length ys) xs)
-    \<Longrightarrow> rely_cond R s0 ys"
-  by (metis rely_cond_drop)
-
-lemma bounded_rev_nat_induct:
-  "(\<And>n. N \<le> n \<Longrightarrow> P n) \<Longrightarrow> (\<And>n. n < N \<Longrightarrow> P (Suc n) \<Longrightarrow> P n)
-    \<Longrightarrow> P n"
-  by (induct diff\<equiv>"N - n" arbitrary: n; simp)
-
-lemma drop_n_induct:
-  "P [] \<Longrightarrow> (\<And>n. n < length xs \<Longrightarrow> P (drop (Suc n) xs) \<Longrightarrow> P (drop n xs))
-    \<Longrightarrow> P (drop n xs)"
-  by (induct len\<equiv>"length (drop n xs)" arbitrary: n xs; simp)
-
-lemma guar_cond_Cons_eq:
-  "guar_cond R s0 (x # xs)
-        = (guar_cond R s0 xs \<and> (fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
-  by (cases "fst x"; simp add: guar_cond_def trace_steps_append conj_comms)
-
-lemma guar_cond_Cons:
-  "guar_cond R s0 xs
-    \<Longrightarrow> fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
-    \<Longrightarrow> guar_cond R s0 (x # xs)"
-  by (simp add: guar_cond_Cons_eq)
-
-lemma guar_cond_drop_Suc_eq:
-  "n < length xs
-    \<Longrightarrow> guar_cond R s0 (drop n xs) = (guar_cond R s0 (drop (Suc n) xs)
-        \<and> (fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
-  apply (rule trans[OF _ guar_cond_Cons_eq])
-  apply (simp add: Cons_nth_drop_Suc)
-  done
-
-lemma guar_cond_drop_Suc:
-  "guar_cond R s0 (drop (Suc n) xs)
-    \<Longrightarrow> fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
-    \<Longrightarrow> guar_cond R s0 (drop n xs)"
-  by (case_tac "n < length xs"; simp add: guar_cond_drop_Suc_eq)
-
-lemma rely_cond_Cons_eq:
-  "rely_cond R s0 (x # xs)
-        = (rely_cond R s0 xs \<and> (fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
-  by (simp add: rely_cond_def trace_steps_append conj_comms)
-
-lemma rely_cond_Cons:
-  "rely_cond R s0 xs
-    \<Longrightarrow> fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
-    \<Longrightarrow> rely_cond R s0 (x # xs)"
-  by (simp add: rely_cond_Cons_eq)
-
-lemma rely_cond_drop_Suc_eq:
-  "n < length xs
-    \<Longrightarrow> rely_cond R s0 (drop n xs) = (rely_cond R s0 (drop (Suc n) xs)
-        \<and> (fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
-  apply (rule trans[OF _ rely_cond_Cons_eq])
-  apply (simp add: Cons_nth_drop_Suc)
-  done
-
-lemma rely_cond_drop_Suc:
-  "rely_cond R s0 (drop (Suc n) xs)
-    \<Longrightarrow> fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
-    \<Longrightarrow> rely_cond R s0 (drop n xs)"
-  by (cases "n < length xs"; simp add: rely_cond_drop_Suc_eq)
-
-lemma last_st_tr_map_zip_hd:
-  "length flags = length tr
-    \<Longrightarrow> tr \<noteq> [] \<longrightarrow> snd (f (hd flags, hd tr)) = snd (hd tr)
-    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
-  apply (cases tr; simp)
-  apply (cases flags; simp)
-  apply (simp add: fun_eq_iff)
-  done
-
-lemma last_st_tr_drop_map_zip_hd:
-  "length flags = length tr
-    \<Longrightarrow> n < length tr \<longrightarrow> snd (f (flags ! n, tr ! n)) = snd (tr ! n)
-    \<Longrightarrow> last_st_tr (drop n (map f (zip flags tr))) = last_st_tr (drop n tr)"
-  apply (simp add: drop_map drop_zip)
-  apply (rule last_st_tr_map_zip_hd; clarsimp)
-  apply (simp add: hd_drop_conv_nth)
-  done
-
-lemma last_st_tr_map_zip:
-  "length flags = length tr
-    \<Longrightarrow> \<forall>fl tmid s. snd (f (fl, (tmid, s))) = s
-    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
-  apply (erule last_st_tr_map_zip_hd)
-  apply (clarsimp simp: neq_Nil_conv)
-  done
-
-lemma parallel_rely_induct:
-  assumes preds: "(tr, v) \<in> parallel f g s" "Pf s0 s" "Pg s0 s"
-  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f' \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
-     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g' \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
-     "f s \<subseteq> f' s" "g s \<subseteq> g' s"
-  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
-     "Gf \<le> Rg" "Gg \<le> Rf"
-  and rely: "rely_cond R s0 (drop n tr)"
-  shows "\<exists>tr_f tr_g. (tr_f, v) \<in> f s \<and> (tr_g, v) \<in> g s
-      \<and> rely_cond Rf s0 (drop n tr_f) \<and> rely_cond Rg s0 (drop n tr_g)
-      \<and> map snd tr_f = map snd tr \<and> map snd tr_g = map snd tr
-      \<and> (\<forall>i \<le> length tr. last_st_tr (drop i tr_g) s0 = last_st_tr (drop i tr_f) s0)
-      \<and> guar_cond G s0 (drop n tr)"
-  (is "\<exists>ys zs. _ \<and> _ \<and> ?concl ys zs")
-proof -
-  obtain ys zs where tr: "tr = map parallel_mrg (zip ys zs)"
-      and all2: "list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs"
-      and ys: "(ys, v) \<in> f s" and zs: "(zs, v) \<in> g s"
-    using preds
-    by (clarsimp simp: parallel_def2)
-  note len[simp] = list_all2_lengthD[OF all2]
-
-  have ys': "(ys, v) \<in> f' s" and zs': "(zs, v) \<in> g' s"
-    using ys zs validI by auto
-
-  note rely_f_step = validI_GD_drop[OF validI(1) preds(2) ys' rely_cond_drop_Suc]
-  note rely_g_step = validI_GD_drop[OF validI(2) preds(3) zs' rely_cond_drop_Suc]
-
-  note snd[simp] = list_all2_nthD[OF all2, THEN conjunct2]
-
-  have "?concl ys zs"
-    using rely tr all2 rely_f_step rely_g_step
-    apply (induct n rule: bounded_rev_nat_induct)
-     apply (subst drop_all, assumption)
-     apply clarsimp
-     apply (simp add: list_all2_conv_all_nth last_st_tr_def drop_map[symmetric]
-                      hd_drop_conv_nth hd_append)
-     apply (fastforce simp: split_def intro!: nth_equalityI)
-     apply clarsimp
-    apply (erule_tac x=n in meta_allE)+
-    apply (drule meta_mp, erule rely_cond_is_drop, simp)
-    apply (subst(asm) rely_cond_drop_Suc_eq[where xs="map f xs" for f xs], simp)
-    apply (clarsimp simp: last_st_tr_drop_map_zip_hd if_split[where P="\<lambda>x. x = Env"]
-                          split_def)
-    apply (intro conjI; (rule guar_cond_drop_Suc rely_cond_drop_Suc, assumption))
-      apply (auto simp: guar_cond_drop_Suc_eq last_st_tr_drop_map_zip_hd
-                 intro: compat[THEN predicate2D])
-    done
-
-  thus ?thesis
-    using ys zs
-    by auto
-qed
-
-lemmas parallel_rely_induct0 = parallel_rely_induct[where n=0, simplified]
-
-lemma rg_validI:
-  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
-     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
-  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
-     "Gf \<le> Rg" "Gg \<le> Rf"
-  shows "\<lbrace>Pf and Pg\<rbrace>,\<lbrace>R\<rbrace> parallel f g \<lbrace>G\<rbrace>,\<lbrace>\<lambda>rv. Qf rv and Qg rv\<rbrace>"
-  apply (clarsimp simp: validI_def rely_def pred_conj_def
-                        parallel_prefix_closed validI[THEN validI_prefix_closed])
-  apply (drule(3) parallel_rely_induct0[OF _ _ _ validI order_refl order_refl compat])
-  apply clarsimp
-  apply (drule(2) validI[THEN validI_rvD])+
-  apply (simp add: last_st_tr_def)
-  done
-
-lemma validI_weaken_pre[wp_pre]:
-  "\<lbrace>P'\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<And>s0 s. P s0 s \<Longrightarrow> P' s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (simp add: validI_def, blast)
-
-lemma rely_weaken:
-  "(\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
-    \<Longrightarrow> (tr, res) \<in> rely f R s s0 \<Longrightarrow> (tr, res) \<in> rely f R' s s0"
-  by (simp add: rely_def rely_cond_def, blast)
-
-lemma validI_weaken_rely[wp_pre]:
-  "\<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: validI_def)
-  by (metis rely_weaken)
 
-lemma validI_strengthen_post:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace>
-    \<Longrightarrow> (\<forall>v s0 s. Q' v s0 s \<longrightarrow> Q v s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (simp add: validI_def)
-
-lemma validI_strengthen_guar:
-  "\<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G'\<rbrace>, \<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<forall>s0 s. G' s0 s \<longrightarrow> G s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>"
-  by (force simp: validI_def guar_cond_def)
-
-lemma rely_prim[simp]:
-  "rely (\<lambda>s. insert (v s) (f s)) R s0 = (\<lambda>s. {x. x = v s \<and> rely_cond R s0 (fst x)} \<union> (rely f R s0 s))"
-  "rely (\<lambda>s. {}) R s0 = (\<lambda>_. {})"
-  by (auto simp: rely_def prod_eq_iff)
-
-lemma prefix_closed_put_trace_elem[iff]:
-  "prefix_closed (put_trace_elem x)"
-  by (clarsimp simp: prefix_closed_def put_trace_elem_def)
-
-lemma prefix_closed_return[iff]:
-  "prefix_closed (return x)"
-  by (simp add: prefix_closed_def return_def)
-
-lemma prefix_closed_put_trace[iff]:
-  "prefix_closed (put_trace tr)"
-  by (induct tr; clarsimp simp: prefix_closed_bind)
-
-lemma put_trace_eq_drop:
-  "put_trace xs s
-    = ((\<lambda>n. (drop n xs, if n = 0 then Result ((), s) else Incomplete)) ` {.. length xs})"
-  apply (induct xs)
-   apply (clarsimp simp: return_def)
-  apply (clarsimp simp: put_trace_elem_def bind_def)
-  apply (simp add: atMost_Suc_eq_insert_0 image_image)
-  apply (rule equalityI; clarsimp)
-   apply (split if_split_asm; clarsimp)
-   apply (auto intro: image_eqI[where x=0])[1]
-  apply (rule rev_bexI, simp)
-  apply clarsimp
-  done
-
-lemma put_trace_res:
-  "(tr, res) \<in> put_trace xs s
-    \<Longrightarrow> \<exists>n. tr = drop n xs \<and> n \<le> length xs
-        \<and> res = (case n of 0 \<Rightarrow> Result ((), s) | _ \<Rightarrow> Incomplete)"
-  apply (clarsimp simp: put_trace_eq_drop)
-  apply (case_tac n; auto intro: exI[where x=0])
-  done
-
-lemma put_trace_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>n. rely_cond R s0 (drop n xs) \<longrightarrow> guar_cond G s0 (drop n xs))
-    \<and> (rely_cond R s0 xs \<longrightarrow> Q () (last_st_tr xs s0) s)\<rbrace>,\<lbrace>R\<rbrace> put_trace xs \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (clarsimp simp: validI_def rely_def)
-  apply (drule put_trace_res)
-  apply (clarsimp; clarsimp split: nat.split_asm)
-  done
-
-lemmas put_trace_elem_twp = put_trace_twp[where xs="[x]" for x, simplified]
-
-lemma prefix_closed_select[iff]:
-  "prefix_closed (select S)"
-  by (simp add: prefix_closed_def select_def image_def)
-
-lemma select_wp[wp]: "\<lbrace>\<lambda>s. \<forall>x \<in> S. Q x s\<rbrace> select S \<lbrace>Q\<rbrace>"
-  by (simp add: select_def valid_def mres_def image_def)
-
-lemma rely_cond_rtranclp:
-  "rely_cond R s (map (Pair Env) xs) \<Longrightarrow> rtranclp R s (last_st_tr (map (Pair Env) xs) s)"
-  apply (induct xs arbitrary: s rule: rev_induct)
-   apply simp
-  apply (clarsimp simp add: rely_cond_def)
-  apply (erule converse_rtranclp_into_rtranclp)
-  apply simp
-  done
-
-lemma put_wp[wp]:
-  "\<lbrace>\<lambda>_. Q () s\<rbrace> put s \<lbrace>Q\<rbrace>"
-  by (simp add: put_def valid_def mres_def)
-
-lemma get_wp[wp]:
-  "\<lbrace>\<lambda>s. Q s s\<rbrace> get \<lbrace>Q\<rbrace>"
-  by (simp add: get_def valid_def mres_def)
-
-lemma bind_wp[wp_split]:
-  "\<lbrakk>  \<And>r. \<lbrace>Q' r\<rbrace> g r \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>f \<lbrace>Q'\<rbrace> \<rbrakk>
-    \<Longrightarrow> \<lbrace>P\<rbrace>  f >>= (\<lambda>r. g r) \<lbrace>Q\<rbrace>"
-  by (fastforce simp: valid_def bind_def2 mres_def intro: image_eqI[rotated])
-
-lemma modify_wp[wp]:
-  "\<lbrace>\<lambda>s. Q () (f s)\<rbrace> modify f \<lbrace>Q\<rbrace>"
-  unfolding modify_def
-  by wp
-
-definition
-  no_trace :: "('s,'a) tmonad  \<Rightarrow> bool"
-where
-  "no_trace f = (\<forall>tr res s. (tr, res) \<in> f s \<longrightarrow> tr = [] \<and> res \<noteq> Incomplete)"
-
-lemmas no_traceD = no_trace_def[THEN iffD1, rule_format]
-
-lemma no_trace_emp:
-  "no_trace f \<Longrightarrow> (tr, r) \<in> f s \<Longrightarrow> tr = []"
-  by (simp add: no_traceD)
-
-lemma no_trace_Incomplete_mem:
-  "no_trace f \<Longrightarrow> (tr, Incomplete) \<notin> f s"
-  by (auto dest: no_traceD)
-
-lemma no_trace_Incomplete_eq:
-  "no_trace f \<Longrightarrow> (tr, res) \<in> f s \<Longrightarrow> res \<noteq> Incomplete"
-  by (auto dest: no_traceD)
-
-lemma no_trace_prefix_closed:
-  "no_trace f \<Longrightarrow> prefix_closed f"
-  by (auto simp add: prefix_closed_def dest: no_trace_emp)
-
-(* Attempt to define triple_judgement to use valid_validI_wp as wp_comb rule.
-   It doesn't work. It seems that wp_comb rules cannot take more than 1 assumption *)
-lemma validI_is_triple:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> =
-     triple_judgement (\<lambda>(s0, s). prefix_closed f \<longrightarrow> P s0 s) f
-                      (\<lambda>(s0,s) f. prefix_closed f \<and> (\<forall>tr res. (tr, res) \<in> rely f R s0 s
-                          \<longrightarrow> guar_cond G s0 tr
-                              \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
-  apply (simp add: triple_judgement_def validI_def )
-  apply (cases "prefix_closed f"; simp)
-  done
-
-lemma valid_is_triple:
-  "valid P f Q =
-      triple_judgement P f
-           (\<lambda>s f. (\<forall>(r,s') \<in> (mres (f s)). Q r s'))"
-  by (simp add: triple_judgement_def valid_def mres_def)
-
-lemma no_trace_is_triple:
-  "no_trace f = triple_judgement \<top> f (\<lambda>() f. id no_trace f)"
-  by (simp add: triple_judgement_def split: unit.split)
-
-lemmas [wp_trip] = valid_is_triple validI_is_triple no_trace_is_triple
-
-lemma valid_validI_wp[wp_comb]:
-  "no_trace f \<Longrightarrow> (\<And>s0. \<lbrace>P s0\<rbrace> f \<lbrace>\<lambda>v. Q v s0 \<rbrace>)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (fastforce simp: rely_def validI_def valid_def mres_def no_trace_prefix_closed dest: no_trace_emp
-    elim: image_eqI[rotated])
-
-(* Since valid_validI_wp in wp_comb doesn't work, we add the rules directly in the wp set *)
-lemma no_trace_prim:
-  "no_trace get"
-  "no_trace (put s)"
-  "no_trace (modify f)"
-  "no_trace (return v)"
-  "no_trace fail"
-  by (simp_all add: no_trace_def get_def put_def modify_def bind_def
-                    return_def select_def fail_def)
-
-lemma no_trace_select:
-  "no_trace (select S)"
-  by (clarsimp simp add: no_trace_def select_def)
-
-lemma no_trace_bind:
-  "no_trace f \<Longrightarrow> \<forall>rv. no_trace (g rv)
-    \<Longrightarrow> no_trace (do rv \<leftarrow> f; g rv od)"
-  apply (subst no_trace_def)
-  apply (clarsimp simp add: bind_def split: tmres.split_asm;
-    auto dest: no_traceD[rotated])
-  done
-
-lemma no_trace_extra:
-  "no_trace (gets f)"
-  "no_trace (assert P)"
-  "no_trace (assert_opt Q)"
-  by (simp_all add: gets_def assert_def assert_opt_def no_trace_bind no_trace_prim
-             split: option.split)
-
-lemmas no_trace_all[wp, iff] = no_trace_prim no_trace_select no_trace_extra
-
-lemma env_steps_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s0 s' \<longrightarrow> Q () s' s') \<and> Q () s0 s\<rbrace>,\<lbrace>R\<rbrace> env_steps \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: interference_def env_steps_def)
-  apply wp
-  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
-  apply (drule rely_cond_rtranclp)
-  apply (clarsimp simp add: last_st_tr_def hd_append)
-  done
-
-lemma interference_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s s' \<longrightarrow> Q () s' s') \<and> G s0 s\<rbrace>,\<lbrace>R\<rbrace>  interference \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: interference_def commit_step_def del: put_trace.simps)
-  apply wp
-  apply clarsimp
-  apply (simp add: drop_Cons nat.split rely_cond_def guar_cond_def)
-  done
-
-(* what Await does if we haven't committed our step is a little
-   strange. this assumes we have, which means s0 = s. we should
-   revisit this if we find a use for Await when this isn't the
-   case *)
-lemma Await_sync_twp:
-  "\<lbrace>\<lambda>s0 s. s = s0 \<and> (\<forall>x. R\<^sup>*\<^sup>* s0 x \<and> c x \<longrightarrow> Q () x x)\<rbrace>,\<lbrace>R\<rbrace> Await c \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: Await_def split_def)
-  apply wp
-  apply clarsimp
-  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
-  apply (drule rely_cond_rtranclp)
-  apply (simp add: o_def)
-  done
+theory Trace_VCG
+  imports
+    Trace_Lemmas
+    WPSimp
+begin
 
-(* Wrap up the standard usage pattern of wp/wpc/simp into its own command: *)
-method wpsimp uses wp simp split split_del cong =
-  ((determ \<open>wp add: wp|wpc|clarsimp simp: simp split: split split del: split_del cong: cong\<close>)+)[1]
+section \<open>Hoare Logic\<close>
 
-section "Satisfiability"
+subsection \<open>Validity\<close>
 
 text \<open>
-  The dual to validity: an existential instead of a universal
-  quantifier for the post condition. In refinement, it is
-  often sufficient to know that there is one state that
-  satisfies a condition.
-\<close>
-definition
-  exs_valid :: "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'b) tmonad \<Rightarrow>
-                ('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool"
-  ("\<lbrace>_\<rbrace> _ \<exists>\<lbrace>_\<rbrace>")
-where
-  "exs_valid P f Q \<equiv> (\<forall>s. P s \<longrightarrow> (\<exists>(rv, s') \<in> mres (f s). Q rv s'))"
-
-
-text \<open>The above for the exception monad\<close>
-definition
-  ex_exs_validE :: "('a \<Rightarrow> bool) \<Rightarrow> ('a, 'e + 'b) tmonad \<Rightarrow>
-                    ('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('e \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool"
-   ("\<lbrace>_\<rbrace> _ \<exists>\<lbrace>_\<rbrace>, \<lbrace>_\<rbrace>")
-where
-  "ex_exs_validE P f Q E \<equiv>
-     exs_valid P f (\<lambda>rv. case rv of Inl e \<Rightarrow> E e | Inr v \<Rightarrow> Q v)"
-
-
-section "Lemmas"
+  This section defines a Hoare logic for partial correctness for
+  the interference trace monad as well as the exception monad.
+  The logic talks only about the behaviour part of the monad and ignores
+  the failure flag.
+
+  The logic is defined semantically. Rules work directly on the
+  validity predicate.
+
+  In the interference trace monad, validity is a triple of precondition,
+  monad, and postcondition. The precondition is a function from state to
+  bool (a state predicate), the postcondition is a function from return value
+  to state to bool. A triple is valid if for all states that satisfy the
+  precondition, all result values and result states that are returned by
+  the monad satisfy the postcondition. Note that if the computation returns
+  the empty set, the triple is trivially valid. This means @{term "assert P"}
+  does not require us to prove that @{term P} holds, but rather allows us
+  to assume @{term P}! Proving non-failure is done via separate predicate and
+  calculus (see below).\<close>
+
+definition valid :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>") where
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). Q r s')"
 
-subsection \<open>Determinism\<close>
+text \<open>
+  We often reason about invariant predicates. The following provides shorthand syntax
+  that avoids repeating potentially long predicates.\<close>
+abbreviation (input) invariant ::
+  "('s,'a) tmonad \<Rightarrow> ('s \<Rightarrow> bool) \<Rightarrow> bool" ("_ \<lbrace>_\<rbrace>" [59,0] 60) where
+  "invariant f P \<equiv> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. P\<rbrace>"
 
-lemma det_set_iff:
-  "det f \<Longrightarrow> (r \<in> mres (f s)) = (mres (f s) = {r})"
-  apply (simp add: det_def mres_def)
-  apply (fastforce elim: allE[where x=s])
-  done
+text \<open>
+  Validity for the exception monad is similar and build on the standard
+  validity above. Instead of one postcondition, we have two: one for
+  normal and one for exceptional results.\<close>
+definition validE ::
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'a + 'b) tmonad \<Rightarrow> ('b \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("\<lbrace>_\<rbrace>/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)" ) where
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<lbrace>P\<rbrace> f \<lbrace> \<lambda>v s. case v of Inr r \<Rightarrow> Q r s | Inl e \<Rightarrow> E e s \<rbrace>"
 
-lemma return_det [iff]:
-  "det (return x)"
-  by (simp add: det_def return_def)
+lemma validE_def2:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). case r of Inr b \<Rightarrow> Q b s' | Inl a \<Rightarrow> E a s')"
+  by (unfold valid_def validE_def)
+(*
+text \<open>Validity for exception monad with interferences. Not as easy to phrase
+ as we need to \<close>
+definition validIE :: "('s, 'a + 'b) tmonad \<Rightarrow>
+             's rg_pred \<Rightarrow>
+             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
+             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
+             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
+ ("_ //PRE _//RELY _//GUAR _//POST _//EXC _" [59,0,0,0,0,0] 60) where
+  "validIE f P R G Q E \<equiv> f SAT [P,R,G,\<lambda>v. case v of Inr r \<Rightarrow> Q r | Inl e \<Rightarrow> E e]"
+
+abbreviation (input)
+  validIEsat :: "('s, 'a + 'b) tmonad \<Rightarrow>
+             's rg_pred \<Rightarrow>
+             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
+             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
+             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
+  ("_ //SAT [_, _, _, _, _]" [59,0,0,0,0,0] 60)
+  where
+  "validIEsat f P R G Q E \<equiv> validIE f P R G Q E"
+ *)
+text \<open>
+  The following two instantiations are convenient to separate reasoning for exceptional and
+  normal case.\<close>
+(* Narrator: they are in fact not convenient, and are now considered a mistake that should have
+             been an abbreviation instead. *)
+definition validE_R :: (* FIXME lib: this should be an abbreviation *)
+  "('s \<Rightarrow> bool) \<Rightarrow> ('s, 'e + 'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>, -") where
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<equiv> validE P f Q (\<lambda>x y. True)"
 
-lemma put_det [iff]:
-  "det (put s)"
-  by (simp add: det_def put_def)
+definition validE_E :: (* FIXME lib: this should be an abbreviation *)
+  "('s \<Rightarrow> bool) \<Rightarrow>  ('s, 'e + 'a) tmonad \<Rightarrow> ('e \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _ /-, \<lbrace>_\<rbrace>") where
+  "\<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace> \<equiv> validE P f (\<lambda>x y. True) Q"
 
-lemma get_det [iff]:
-  "det get"
-  by (simp add: det_def get_def)
 
-lemma det_gets [iff]:
-  "det (gets f)"
-  by (auto simp add: gets_def det_def get_def return_def bind_def)
+section \<open>Lemmas\<close>
 
-lemma det_UN:
-  "det f \<Longrightarrow> (\<Union>x \<in> mres (f s). g x) = (g (THE x. x \<in> mres (f s)))"
-  unfolding det_def mres_def
-  apply simp
-  apply (drule spec [of _ s])
-  apply (clarsimp simp: vimage_def)
-  done
+lemma hoare_pre_imp:
+  "\<lbrakk> \<And>s. P s \<Longrightarrow> Q s; \<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
+  by (fastforce simp: valid_def)
 
-lemma bind_detI [simp, intro!]:
-  "\<lbrakk> det f; \<forall>x. det (g x) \<rbrakk> \<Longrightarrow> det (f >>= g)"
-  apply (simp add: bind_def det_def split_def)
-  apply clarsimp
-  apply (erule_tac x=s in allE)
-  apply clarsimp
-  done
+lemmas hoare_weaken_pre = hoare_pre_imp[rotated]
 
-lemma det_modify[iff]:
-  "det (modify f)"
-  by (simp add: modify_def)
+lemma hoare_vcg_precond_impE: (* FIXME lib: eliminate in favour of hoare_weaken_preE *)
+  "\<lbrakk> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>; \<And>s. P s \<Longrightarrow> Q s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>"
+  by (fastforce simp add:validE_def2)
 
-lemma the_run_stateI:
-  "mres (M s) = {s'} \<Longrightarrow> the_run_state M s = s'"
-  by (simp add: the_run_state_def)
+lemmas hoare_weaken_preE = hoare_vcg_precond_impE
 
-lemma the_run_state_det:
-  "\<lbrakk> s' \<in> mres (M s); det M \<rbrakk> \<Longrightarrow> the_run_state M s = s'"
-  by (simp only: the_run_stateI det_set_iff[where f=M and s=s])
+lemma hoare_vcg_precond_impE_R: (* FIXME lib: rename to hoare_weaken_preE_R *)
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>,-; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
+  unfolding validE_R_def
+  by (rule hoare_vcg_precond_impE)
 
-subsection "Lifting and Alternative Basic Definitions"
+lemma hoare_weaken_preE_E:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f -,\<lbrace>Q\<rbrace>; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace>"
+  by (fastforce simp add: validE_E_def validE_def valid_def)
 
-lemma liftE_liftM: "liftE = liftM Inr"
-  apply (rule ext)
-  apply (simp add: liftE_def liftM_def)
-  done
+lemmas hoare_pre [wp_pre] =
+  hoare_weaken_pre
+  hoare_weaken_preE
+  hoare_vcg_precond_impE_R
+  hoare_weaken_preE_E
 
-lemma liftME_liftM: "liftME f = liftM (case_sum Inl (Inr \<circ> f))"
-  apply (rule ext)
-  apply (simp add: liftME_def liftM_def bindE_def returnOk_def lift_def)
-  apply (rule_tac f="bind x" in arg_cong)
-  apply (rule ext)
-  apply (case_tac xa)
-   apply (simp_all add: lift_def throwError_def)
-  done
 
-lemma liftE_bindE:
-  "(liftE a) >>=E b = a >>= b"
-  apply (simp add: liftE_def bindE_def lift_def bind_assoc)
-  done
+subsection \<open>Setting up the precondition case splitter.\<close>
 
-lemma liftM_id[simp]: "liftM id = id"
-  apply (rule ext)
-  apply (simp add: liftM_def)
-  done
+lemma wpc_helper_valid:
+  "\<lbrace>Q\<rbrace> g \<lbrace>S\<rbrace> \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> g \<lbrace>S\<rbrace>"
+  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
 
-lemma liftM_bind:
-  "(liftM t f >>= g) = (f >>= (\<lambda>x. g (t x)))"
-  by (simp add: liftM_def bind_assoc)
+lemma wpc_helper_validE:
+  "\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>"
+  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
 
-lemma gets_bind_ign: "gets f >>= (\<lambda>x. m) = m"
-  apply (rule ext)
-  apply (simp add: bind_def simpler_gets_def)
-  done
+lemma wpc_helper_validE_R:
+  "\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,- \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>,-"
+  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
 
-lemma get_bind_apply: "(get >>= f) x = f x x"
-  by (simp add: get_def bind_def)
+lemma wpc_helper_validR_R:
+  "\<lbrace>Q\<rbrace> f -,\<lbrace>E\<rbrace> \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>"
+  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
 
-lemma exec_gets:
-  "(gets f >>= m) s = m (f s) s"
-  by (simp add: simpler_gets_def bind_def)
 
-lemma exec_get:
-  "(get >>= m) s = m s s"
-  by (simp add: get_def bind_def)
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>" wpc_helper_valid
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>" wpc_helper_validE
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>,-" wpc_helper_validE_R
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m -,\<lbrace>E\<rbrace>" wpc_helper_validR_R
 
-lemma bind_eqI:
-  "\<lbrakk> f = f'; \<And>x. g x = g' x \<rbrakk> \<Longrightarrow> f >>= g = f' >>= g'"
-  apply (rule ext)
-  apply (simp add: bind_def)
-  done
 
 subsection "Simplification Rules for Lifted And/Or"
 
@@ -642,15 +161,12 @@ lemma bipred_le_true[simp]: "R \<le> \<top>\<top>"
 
 subsection "Hoare Logic Rules"
 
-lemma validE_def2:
-   "validE P f Q R \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). case r of Inr b \<Rightarrow> Q b s'
-                                                              | Inl a \<Rightarrow> R a s')"
-   by (unfold valid_def validE_def)
+lemma bind_wp[wp_split]:
+  "\<lbrakk> \<And>r. \<lbrace>Q' r\<rbrace> g r \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f >>= (\<lambda>rv. g rv) \<lbrace>Q\<rbrace>"
+  by (fastforce simp: valid_def bind_def2 mres_def intro: image_eqI[rotated])
 
 lemma seq':
-  "\<lbrakk> \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>;
-     \<forall>x. P x \<longrightarrow> \<lbrace>C\<rbrace> g x \<lbrace>D\<rbrace>;
-     \<forall>x s. B x s \<longrightarrow> P x \<and> C s \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>; \<forall>x. P x \<longrightarrow> \<lbrace>C\<rbrace> g x \<lbrace>D\<rbrace>; \<forall>x s. B x s \<longrightarrow> P x \<and> C s \<rbrakk> \<Longrightarrow>
    \<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>D\<rbrace>"
   apply (erule bind_wp[rotated])
   apply (clarsimp simp: valid_def)
@@ -662,21 +178,19 @@ lemma seq:
   assumes g_valid: "\<And>x. P x \<Longrightarrow> \<lbrace>C\<rbrace> g x \<lbrace>D\<rbrace>"
   assumes bind:  "\<And>x s. B x s \<Longrightarrow> P x \<and> C s"
   shows "\<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>D\<rbrace>"
-apply (insert f_valid g_valid bind)
-apply (blast intro: seq')
-done
+  apply (insert f_valid g_valid bind)
+  apply (blast intro: seq')
+  done
 
 lemma seq_ext':
-  "\<lbrakk> \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>;
-     \<forall>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace> \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>; \<forall>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace> \<rbrakk> \<Longrightarrow>
    \<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>C\<rbrace>"
   by (metis bind_wp)
 
 lemmas seq_ext = bind_wp[rotated]
 
 lemma seqE':
-  "\<lbrakk> \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>,\<lbrace>E\<rbrace> ;
-     \<forall>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>,\<lbrace>E\<rbrace>; \<forall>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
    \<lbrace>A\<rbrace> doE x \<leftarrow> f; g x odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>"
   apply (simp add: bindE_def validE_def)
   apply (erule seq_ext')
@@ -688,147 +202,105 @@ lemma seqE:
   assumes f_valid: "\<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>,\<lbrace>E\<rbrace>"
   assumes g_valid: "\<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>"
   shows "\<lbrace>A\<rbrace> doE x \<leftarrow> f; g x odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>"
-  apply(insert f_valid g_valid)
-  apply(blast intro: seqE')
+  apply (insert f_valid g_valid)
+  apply (blast intro: seqE')
   done
 
-lemma hoare_TrueI: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. \<top>\<rbrace>"
+lemma hoare_TrueI:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. \<top>\<rbrace>"
   by (simp add: valid_def)
 
-lemma hoareE_TrueI: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. \<top>\<rbrace>, \<lbrace>\<lambda>r. \<top>\<rbrace>"
+lemma hoareE_TrueI:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. \<top>\<rbrace>, \<lbrace>\<lambda>r. \<top>\<rbrace>"
   by (simp add: validE_def valid_def)
 
-lemma hoare_True_E_R [simp]:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. True\<rbrace>, -"
-  by (auto simp add: validE_R_def validE_def valid_def split: sum.splits)
+lemma hoare_True_E_R[simp]:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_ s. True\<rbrace>, -"
+  by (auto simp: validE_R_def validE_def valid_def split: sum.splits)
 
-lemma hoare_post_conj [intro!]:
-  "\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> Q \<rbrace>; \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> a \<lbrace> Q and R \<rbrace>"
-  by (fastforce simp: valid_def split_def pred_conj_def)
+lemma hoare_post_conj[intro]:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q and R\<rbrace>"
+  by (fastforce simp: valid_def)
 
-lemma hoare_pre_disj [intro!]:
-  "\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>; \<lbrace> Q \<rbrace> a \<lbrace> R \<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace> P or Q \<rbrace> a \<lbrace> R \<rbrace>"
+lemma hoare_pre_disj[intro]:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>; \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P or Q\<rbrace> f \<lbrace>R\<rbrace>"
   by (simp add:valid_def pred_disj_def)
 
 lemma hoare_conj:
   "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> f \<lbrace>Q and Q'\<rbrace>"
-  unfolding valid_def
-  by (auto)
-
-lemma hoare_post_taut: "\<lbrace> P \<rbrace> a \<lbrace> \<top>\<top> \<rbrace>"
-  by (simp add:valid_def)
+  unfolding valid_def by auto
 
-lemma wp_post_taut: "\<lbrace>\<lambda>r. True\<rbrace> f \<lbrace>\<lambda>r s. True\<rbrace>"
-  by (rule hoare_post_taut)
+lemmas hoare_post_taut = hoare_TrueI (* FIXME lib: eliminate *)
 
-lemma wp_post_tautE: "\<lbrace>\<lambda>r. True\<rbrace> f \<lbrace>\<lambda>r s. True\<rbrace>,\<lbrace>\<lambda>f s. True\<rbrace>"
-proof -
-  have P: "\<And>r. (case r of Inl a \<Rightarrow> True | _ \<Rightarrow> True) = True"
-    by (case_tac r, simp_all)
-  show ?thesis
-    by (simp add: validE_def P wp_post_taut)
-qed
+lemmas wp_post_taut = hoare_TrueI[where P=\<top>]
+lemmas wp_post_tautE = hoareE_TrueI[where P=\<top>]
 
-lemma hoare_pre_cont [simp]: "\<lbrace> \<bottom> \<rbrace> a \<lbrace> P \<rbrace>"
+lemma hoare_pre_cont[simp]:
+  "\<lbrace>\<bottom>\<rbrace> f \<lbrace>P\<rbrace>"
   by (simp add:valid_def)
 
+lemma hoare_return_drop_var[iff]:
+  "\<lbrace>Q\<rbrace> return x \<lbrace>\<lambda>r. Q\<rbrace>"
+  by (simp add: valid_def return_def mres_def)
 
-subsection \<open>Strongest Postcondition Rules\<close>
-
-lemma get_sp:
-  "\<lbrace>P\<rbrace> get \<lbrace>\<lambda>a s. s = a \<and> P s\<rbrace>"
-  by(simp add:get_def valid_def mres_def)
-
-lemma put_sp:
-  "\<lbrace>\<top>\<rbrace> put a \<lbrace>\<lambda>_ s. s = a\<rbrace>"
-  by(simp add:put_def valid_def mres_def)
-
-lemma return_sp:
-  "\<lbrace>P\<rbrace> return a \<lbrace>\<lambda>b s. b = a \<and> P s\<rbrace>"
-  by(simp add:return_def valid_def mres_def)
-
-lemma assert_sp:
-  "\<lbrace> P \<rbrace> assert Q \<lbrace> \<lambda>r s. P s \<and> Q \<rbrace>"
-  by (simp add: assert_def fail_def return_def valid_def mres_def)
-
-lemma hoare_gets_sp:
-  "\<lbrace>P\<rbrace> gets f \<lbrace>\<lambda>rv s. rv = f s \<and> P s\<rbrace>"
-  by (simp add: valid_def simpler_gets_def mres_def)
-
-lemma hoare_return_drop_var [iff]: "\<lbrace> Q \<rbrace> return x \<lbrace> \<lambda>r. Q \<rbrace>"
-  by (simp add:valid_def return_def mres_def)
-
-lemma hoare_gets [intro!]: "\<lbrakk> \<And>s. P s \<Longrightarrow> Q (f s) s \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> gets f \<lbrace> Q \<rbrace>"
+lemma hoare_gets[intro]:
+  "\<lbrakk> \<And>s. P s \<Longrightarrow> Q (f s) s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> gets f \<lbrace>Q\<rbrace>"
   by (simp add:valid_def gets_def get_def bind_def return_def mres_def)
 
-lemma hoare_modifyE_var [intro!]:
-  "\<lbrakk> \<And>s. P s \<Longrightarrow> Q (f s) \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> modify f \<lbrace> \<lambda>r s. Q s \<rbrace>"
+lemma hoare_modifyE_var:
+  "\<lbrakk> \<And>s. P s \<Longrightarrow> Q (f s) \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> modify f \<lbrace>\<lambda>_ s. Q s\<rbrace>"
   by(simp add: valid_def modify_def put_def get_def bind_def mres_def)
 
-lemma hoare_if [intro!]:
-  "\<lbrakk> P \<Longrightarrow> \<lbrace> Q \<rbrace> a \<lbrace> R \<rbrace>; \<not> P \<Longrightarrow> \<lbrace> Q \<rbrace> b \<lbrace> R \<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace> Q \<rbrace> if P then a else b \<lbrace> R \<rbrace>"
-  by (simp add:valid_def)
-
-lemma hoare_pre_subst: "\<lbrakk> A = B; \<lbrace>A\<rbrace> a \<lbrace>C\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>B\<rbrace> a \<lbrace>C\<rbrace>"
-  by(clarsimp simp:valid_def split_def)
-
-lemma hoare_post_subst: "\<lbrakk> B = C; \<lbrace>A\<rbrace> a \<lbrace>B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> a \<lbrace>C\<rbrace>"
-  by(clarsimp simp:valid_def split_def)
+lemma hoare_if:
+  "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>; \<not> P \<Longrightarrow> \<lbrace>Q\<rbrace> b \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>Q\<rbrace> if P then a else b \<lbrace>R\<rbrace>"
+  by (simp add: valid_def)
 
-lemma hoare_pre_tautI: "\<lbrakk> \<lbrace>A and P\<rbrace> a \<lbrace>B\<rbrace>; \<lbrace>A and not P\<rbrace> a \<lbrace>B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> a \<lbrace>B\<rbrace>"
-  by(fastforce simp:valid_def split_def pred_conj_def pred_neg_def)
+lemma hoare_pre_subst:
+  "\<lbrakk> A = B; \<lbrace>A\<rbrace> a \<lbrace>C\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>B\<rbrace> a \<lbrace>C\<rbrace>"
+  by (erule subst)
 
-lemma hoare_pre_imp: "\<lbrakk> \<And>s. P s \<Longrightarrow> Q s; \<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
-  by (fastforce simp add:valid_def)
+lemma hoare_post_subst:
+  "\<lbrakk> B = C; \<lbrace>A\<rbrace> a \<lbrace>B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> a \<lbrace>C\<rbrace>"
+  by (erule subst)
 
-lemma hoare_post_imp: "\<lbrakk> \<And>r s. Q r s \<Longrightarrow> R r s; \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
+lemma hoare_post_imp:
+  "\<lbrakk> \<And>rv s. Q rv s \<Longrightarrow> R rv s; \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
   by(fastforce simp:valid_def split_def)
 
-lemma hoare_post_impErr': "\<lbrakk> \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>;
-                           \<forall>r s. Q r s \<longrightarrow> R r s;
-                           \<forall>e s. E e s \<longrightarrow> F e s \<rbrakk> \<Longrightarrow>
-                         \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>"
- apply (simp add: validE_def)
- apply (rule_tac Q="\<lambda>r s. case r of Inl a \<Rightarrow> E a s | Inr b \<Rightarrow> Q b s" in hoare_post_imp)
-  apply (case_tac r)
-   apply simp_all
- done
-
-lemma hoare_post_impErr: "\<lbrakk> \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>;
-                          \<And>r s. Q r s \<Longrightarrow> R r s;
-                          \<And>e s. E e s \<Longrightarrow> F e s \<rbrakk> \<Longrightarrow>
-                         \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>"
- apply (blast intro: hoare_post_impErr')
- done
+lemma hoare_post_impErr': (* FIXME lib: eliminate *)
+  "\<lbrakk> \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<forall>rv s. Q rv s \<longrightarrow> R rv s; \<forall>e s. E e s \<longrightarrow> F e s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>"
+  unfolding validE_def valid_def
+  by (fastforce split: sum.splits)
+
+lemma hoare_post_impErr:
+  "\<lbrakk> \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<And>rv s. Q rv s \<Longrightarrow> R rv s; \<And>e s. E e s \<Longrightarrow> F e s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>"
+  by (blast intro: hoare_post_impErr')
 
 lemma hoare_validE_cases:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>, \<lbrace> \<lambda>_ _. True \<rbrace>; \<lbrace> P \<rbrace> f \<lbrace> \<lambda>_ _. True \<rbrace>, \<lbrace> R \<rbrace> \<rbrakk>
-  \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>, \<lbrace> R \<rbrace>"
-  by (simp add: validE_def valid_def split: sum.splits) blast
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>\<lambda>_ _. True\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_ _. True\<rbrace>, \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>R\<rbrace>"
+  by (fastforce simp: validE_def valid_def split: sum.splits)
 
 lemma hoare_post_imp_dc:
-  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. Q\<rbrace>; \<And>s. Q s \<Longrightarrow> R s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. R\<rbrace>,\<lbrace>\<lambda>r. R\<rbrace>"
-  by (simp add: validE_def valid_def split: sum.splits) blast
+  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. Q\<rbrace>; \<And>s. Q s \<Longrightarrow> R s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. R\<rbrace>, \<lbrace>\<lambda>_. R\<rbrace>"
+  by (fastforce simp: validE_def valid_def split: sum.splits)
 
 lemma hoare_post_imp_dc2:
-  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. Q\<rbrace>; \<And>s. Q s \<Longrightarrow> R s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. R\<rbrace>,\<lbrace>\<lambda>r s. True\<rbrace>"
-  by (simp add: validE_def valid_def split: sum.splits) blast
+  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. Q\<rbrace>; \<And>s. Q s \<Longrightarrow> R s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. R\<rbrace>, \<lbrace>\<lambda>_. \<top>\<rbrace>"
+  by (fastforce simp: validE_def valid_def split: sum.splits)
 
 lemma hoare_post_imp_dc2E:
-  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. Q\<rbrace>; \<And>s. Q s \<Longrightarrow> R s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>r s. True\<rbrace>, \<lbrace>\<lambda>r. R\<rbrace>"
-  by (simp add: validE_def valid_def split: sum.splits) fast
-
-lemma hoare_post_imp_dc2E_actual:
-  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. R\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>r s. True\<rbrace>, \<lbrace>\<lambda>r. R\<rbrace>"
-  by (simp add: validE_def valid_def split: sum.splits) fast
+  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. Q\<rbrace>; \<And>s. Q s \<Longrightarrow> R s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. \<top>\<rbrace>, \<lbrace>\<lambda>_. R\<rbrace>"
+  by (fastforce simp: validE_def valid_def split: sum.splits)
 
 lemma hoare_post_imp_dc2_actual:
-  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. R\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>r. R\<rbrace>, \<lbrace>\<lambda>r s. True\<rbrace>"
-  by (simp add: validE_def valid_def split: sum.splits) fast
+  "\<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. R\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. R\<rbrace>, \<lbrace>\<lambda>_. \<top>\<rbrace>"
+  by (rule hoare_post_imp_dc2)
+
+lemma hoare_post_imp_dc2E_actual:
+  "\<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. R\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>\<lambda>_. \<top>\<rbrace>, \<lbrace>\<lambda>_. R\<rbrace>"
+  by (rule hoare_post_imp_dc2E)
 
-lemma hoare_post_impE: "\<lbrakk> \<And>r s. Q r s \<Longrightarrow> R r s; \<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
-  by (fastforce simp:valid_def split_def)
+lemmas hoare_post_impE = hoare_post_imp (* FIXME lib: eliminate; probably should be on validE *)
 
 lemma hoare_conjD1:
   "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q rv and R rv\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q rv\<rbrace>"
@@ -846,129 +318,28 @@ lemma hoare_post_disjI2:
   "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. R rv\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q rv or R rv\<rbrace>"
   unfolding valid_def by auto
 
-lemma hoare_weaken_pre:
-  "\<lbrakk>\<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>; \<And>s. P s \<Longrightarrow> Q s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
-  apply (rule hoare_pre_imp)
-   prefer 2
-   apply assumption
-  apply blast
-  done
+lemmas hoare_strengthen_post = hoare_post_imp[rotated]
 
-lemma hoare_strengthen_post:
-  "\<lbrakk>\<lbrace>P\<rbrace> a \<lbrace>Q\<rbrace>; \<And>r s. Q r s \<Longrightarrow> R r s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>"
-  apply (rule hoare_post_imp)
-   prefer 2
-   apply assumption
-  apply blast
-  done
+lemma use_valid:
+  "\<lbrakk>(r, s') \<in> mres (f s); \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; P s \<rbrakk> \<Longrightarrow> Q r s'"
+  unfolding valid_def by blast
 
-lemma use_valid: "\<lbrakk>(r, s') \<in> mres (f s); \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; P s \<rbrakk> \<Longrightarrow> Q r s'"
-  apply (simp add: valid_def)
-  apply blast
-  done
+lemmas post_by_hoare = use_valid[rotated]
 
-lemma use_validE_norm: "\<lbrakk> (Inr r', s') \<in> mres (B s); \<lbrace> P \<rbrace> B \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>; P s \<rbrakk> \<Longrightarrow> Q r' s'"
-  apply (clarsimp simp: validE_def valid_def)
-  apply force
-  done
+lemma use_validE_norm:
+  "\<lbrakk> (Inr r', s') \<in> mres (B s); \<lbrace>P\<rbrace> B \<lbrace>Q\<rbrace>,\<lbrace> E \<rbrace>; P s \<rbrakk> \<Longrightarrow> Q r' s'"
+  unfolding validE_def valid_def by force
 
-lemma use_validE_except: "\<lbrakk> (Inl r', s') \<in> mres (B s); \<lbrace> P \<rbrace> B \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>; P s \<rbrakk> \<Longrightarrow> E r' s'"
-  apply (clarsimp simp: validE_def valid_def)
-  apply force
-  done
+lemma use_validE_except:
+  "\<lbrakk> (Inl r', s') \<in> mres (B s); \<lbrace>P\<rbrace> B \<lbrace>Q\<rbrace>,\<lbrace> E \<rbrace>; P s \<rbrakk> \<Longrightarrow> E r' s'"
+  unfolding validE_def valid_def by force
 
 lemma in_inv_by_hoareD:
-  "\<lbrakk> \<And>P. \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. P\<rbrace>; (x,s') \<in> mres (f s) \<rbrakk> \<Longrightarrow> s' = s"
-  apply (drule_tac x="(=) s" in meta_spec)
-  apply (auto simp add: valid_def mres_def)
-  done
-
-subsection "Satisfiability"
-
-lemma exs_hoare_post_imp: "\<lbrakk>\<And>r s. Q r s \<Longrightarrow> R r s; \<lbrace>P\<rbrace> a \<exists>\<lbrace>Q\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<exists>\<lbrace>R\<rbrace>"
-  apply (simp add: exs_valid_def)
-  apply safe
-  apply (erule_tac x=s in allE, simp)
-  apply blast
-  done
-
-lemma use_exs_valid: "\<lbrakk>\<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>; P s \<rbrakk> \<Longrightarrow> \<exists>(r, s') \<in> mres (f s). Q r s'"
-  by (simp add: exs_valid_def)
-
-definition "exs_postcondition P f \<equiv> (\<lambda>a b. \<exists>(rv, s)\<in> f a b. P rv s)"
-
-lemma exs_valid_is_triple:
-  "exs_valid P f Q = triple_judgement P f (exs_postcondition Q (\<lambda>s f. mres (f s)))"
-  by (simp add: triple_judgement_def exs_postcondition_def exs_valid_def)
-
-lemmas [wp_trip] = exs_valid_is_triple
-
-lemma exs_valid_weaken_pre [wp_comb]:
-  "\<lbrakk> \<lbrace> P' \<rbrace> f \<exists>\<lbrace> Q \<rbrace>; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<exists>\<lbrace> Q \<rbrace>"
-  apply atomize
-  apply (clarsimp simp: exs_valid_def)
-  done
-
-lemma exs_valid_chain:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<exists>\<lbrace> Q \<rbrace>; \<And>s. R s \<Longrightarrow> P s; \<And>r s. Q r s \<Longrightarrow> S r s \<rbrakk> \<Longrightarrow> \<lbrace> R \<rbrace> f \<exists>\<lbrace> S \<rbrace>"
-  by (fastforce simp only: exs_valid_def Bex_def )
-
-lemma exs_valid_assume_pre:
-  "\<lbrakk> \<And>s. P s \<Longrightarrow> \<lbrace> P \<rbrace> f \<exists>\<lbrace> Q \<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<exists>\<lbrace> Q \<rbrace>"
-  apply (fastforce simp: exs_valid_def)
-  done
-
-lemma exs_valid_bind [wp_split]:
-    "\<lbrakk> \<And>x. \<lbrace>B x\<rbrace> g x \<exists>\<lbrace>C\<rbrace>; \<lbrace>A\<rbrace> f \<exists>\<lbrace>B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace> A \<rbrace> f >>= (\<lambda>x. g x) \<exists>\<lbrace> C \<rbrace>"
-  apply atomize
-  apply (clarsimp simp: exs_valid_def bind_def2 mres_def)
-  apply (drule spec, drule(1) mp, clarsimp)
-  apply (drule spec2, drule(1) mp, clarsimp)
-  apply (simp add: image_def bex_Un)
-  apply (strengthen subst[where P="\<lambda>x. x \<in> f s" for s, mk_strg I _ E], simp)
-  apply (fastforce elim: rev_bexI)
-  done
+  "\<lbrakk> \<And>P. f \<lbrace>P\<rbrace>; (x,s') \<in> mres (f s) \<rbrakk> \<Longrightarrow> s' = s"
+  by (auto simp add: valid_def) blast
 
-lemma exs_valid_return [wp]:
-    "\<lbrace> Q v \<rbrace> return v \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: exs_valid_def return_def mres_def)
 
-lemma exs_valid_select [wp]:
-    "\<lbrace> \<lambda>s. \<exists>r \<in> S. Q r s \<rbrace> select S \<exists>\<lbrace> Q \<rbrace>"
-  apply (clarsimp simp: exs_valid_def select_def mres_def)
-  apply (auto simp add: image_def)
-  done
-
-lemma exs_valid_get [wp]:
-    "\<lbrace> \<lambda>s. Q s s \<rbrace> get \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: exs_valid_def get_def mres_def)
-
-lemma exs_valid_gets [wp]:
-    "\<lbrace> \<lambda>s. Q (f s) s \<rbrace> gets f \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: gets_def) wp
-
-lemma exs_valid_put [wp]:
-    "\<lbrace> Q v \<rbrace> put v \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: put_def exs_valid_def mres_def)
-
-lemma exs_valid_state_assert [wp]:
-    "\<lbrace> \<lambda>s. Q () s \<and> G s \<rbrace> state_assert G \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: state_assert_def exs_valid_def get_def
-           assert_def bind_def2 return_def mres_def)
-
-lemmas exs_valid_guard = exs_valid_state_assert
-
-lemma exs_valid_fail [wp]:
-    "\<lbrace> \<lambda>_. False \<rbrace> fail \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: fail_def exs_valid_def)
-
-lemma exs_valid_condition [wp]:
-    "\<lbrakk> \<lbrace> P \<rbrace> L \<exists>\<lbrace> Q \<rbrace>; \<lbrace> P' \<rbrace> R \<exists>\<lbrace> Q \<rbrace> \<rbrakk> \<Longrightarrow>
-          \<lbrace> \<lambda>s. (C s \<and> P s) \<or> (\<not> C s \<and> P' s) \<rbrace> condition C L R \<exists>\<lbrace> Q \<rbrace>"
-  by (clarsimp simp: condition_def exs_valid_def split: sum.splits)
-
-
-subsection MISC
+subsection \<open>Misc\<close>
 
 lemma hoare_return_simp:
   "\<lbrace>P\<rbrace> return x \<lbrace>Q\<rbrace> = (\<forall>s. P s \<longrightarrow> Q x s)"
@@ -978,658 +349,204 @@ lemma hoare_gen_asm:
   "(P \<Longrightarrow> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>P' and K P\<rbrace> f \<lbrace>Q\<rbrace>"
   by (fastforce simp add: valid_def)
 
-lemma when_wp [wp]:
- "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> when P f \<lbrace>R\<rbrace>"
-  by (clarsimp simp: when_def valid_def return_def mres_def)
-
 lemma hoare_conjI:
   "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> R r s\<rbrace>"
   unfolding valid_def by blast
 
 lemma hoare_disjI1:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<or>  R r s \<rbrace>"
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<or>  R rv s \<rbrace>"
   unfolding valid_def by blast
 
 lemma hoare_disjI2:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<or>  R r s \<rbrace>"
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<or>  R rv s \<rbrace>"
   unfolding valid_def by blast
 
 lemma hoare_assume_pre:
   "(\<And>s. P s \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
   by (auto simp: valid_def)
 
-lemma hoare_returnOk_sp:
-  "\<lbrace>P\<rbrace> returnOk x \<lbrace>\<lambda>r s. r = x \<and> P s\<rbrace>, \<lbrace>Q\<rbrace>"
-  by (simp add: valid_def validE_def returnOk_def return_def mres_def)
-
 lemma hoare_assume_preE:
   "(\<And>s. P s \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>"
   by (auto simp: valid_def validE_def)
 
 lemma hoare_allI:
-  "(\<And>x. \<lbrace>P\<rbrace>f\<lbrace>Q x\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace>f\<lbrace>\<lambda>r s. \<forall>x. Q x r s\<rbrace>"
+  "(\<And>x. \<lbrace>P\<rbrace>f\<lbrace>Q x\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace>f\<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>"
   by (simp add: valid_def) blast
 
 lemma validE_allI:
-  "(\<And>x. \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q x r s\<rbrace>,\<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. \<forall>x. Q x r s\<rbrace>,\<lbrace>E\<rbrace>"
+  "(\<And>x. \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q x r s\<rbrace>,\<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>,\<lbrace>E\<rbrace>"
   by (fastforce simp: valid_def validE_def split: sum.splits)
 
 lemma hoare_exI:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q x\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. \<exists>x. Q x r s\<rbrace>"
+  "\<lbrace>P\<rbrace> f \<lbrace>Q x\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. \<exists>x. Q x rv s\<rbrace>"
   by (simp add: valid_def) blast
 
 lemma hoare_impI:
-  "(R \<Longrightarrow> \<lbrace>P\<rbrace>f\<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace>f\<lbrace>\<lambda>r s. R \<longrightarrow> Q r s\<rbrace>"
+  "(R \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. R \<longrightarrow> Q rv s\<rbrace>"
   by (simp add: valid_def) blast
 
 lemma validE_impI:
-  " \<lbrakk>\<And>E. \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_ _. True\<rbrace>,\<lbrace>E\<rbrace>; (P' \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>)\<rbrakk> \<Longrightarrow>
-         \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. P' \<longrightarrow> Q r s\<rbrace>, \<lbrace>E\<rbrace>"
+  "\<lbrakk>\<And>E. \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_ _. True\<rbrace>,\<lbrace>E\<rbrace>; (P' \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>)\<rbrakk> \<Longrightarrow>
+   \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. P' \<longrightarrow> Q rv s\<rbrace>, \<lbrace>E\<rbrace>"
   by (fastforce simp: validE_def valid_def split: sum.splits)
 
 lemma hoare_case_option_wp:
-  "\<lbrakk> \<lbrace>P\<rbrace> f None \<lbrace>Q\<rbrace>;
-     \<And>x.  \<lbrace>P' x\<rbrace> f (Some x) \<lbrace>Q' x\<rbrace> \<rbrakk>
+  "\<lbrakk> \<lbrace>P\<rbrace> f None \<lbrace>Q\<rbrace>; \<And>x.  \<lbrace>P' x\<rbrace> f (Some x) \<lbrace>Q' x\<rbrace> \<rbrakk>
   \<Longrightarrow> \<lbrace>case_option P P' v\<rbrace> f v \<lbrace>\<lambda>rv. case v of None \<Rightarrow> Q rv | Some x \<Rightarrow> Q' x rv\<rbrace>"
   by (cases v) auto
 
-subsection "Reasoning directly about states"
-
-lemma in_throwError:
-  "((v, s') \<in> mres (throwError e s)) = (v = Inl e \<and> s' = s)"
-  by (simp add: throwError_def return_def mres_def)
-
-lemma in_returnOk:
-  "((v', s') \<in> mres (returnOk v s)) = (v' = Inr v \<and> s' = s)"
-  by (simp add: returnOk_def return_def mres_def)
-
-lemma in_bind:
-  "((r,s') \<in> mres ((do x \<leftarrow> f; g x od) s)) =
-   (\<exists>s'' x. (x, s'') \<in> mres (f s) \<and> (r, s') \<in> mres (g x s''))"
-  apply (simp add: bind_def split_def mres_def)
-  apply (auto split: tmres.splits; force elim: rev_bexI image_eqI[rotated])
-  done
-
-lemma in_bindE_R:
-  "((Inr r,s') \<in> mres ((doE x \<leftarrow> f; g x odE) s)) =
-  (\<exists>s'' x. (Inr x, s'') \<in> mres (f s) \<and> (Inr r, s') \<in> mres (g x s''))"
-  apply (simp add: bindE_def in_bind)
-  apply (simp add: lift_def split_def)
-  apply (clarsimp simp: throwError_def return_def lift_def mres_def split: sum.splits)
-  apply force
-  done
-
-lemma in_bindE_L:
-  "((Inl r, s') \<in> mres ((doE x \<leftarrow> f; g x odE) s)) \<Longrightarrow>
-  (\<exists>s'' x. (Inr x, s'') \<in> mres (f s) \<and> (Inl r, s') \<in> mres (g x s'')) \<or> ((Inl r, s') \<in> mres (f s))"
-  apply (simp add: bindE_def in_bind lift_def)
-  apply safe
-  apply (simp add: return_def throwError_def lift_def split_def mres_def split: sum.splits if_split_asm)
-  apply force+
-  done
-
-lemma in_return:
-  "(r, s') \<in> mres (return v s) = (r = v \<and> s' = s)"
-  by (simp add: return_def mres_def)
-
-lemma in_liftE:
-  "((v, s') \<in> mres (liftE f s)) = (\<exists>v'. v = Inr v' \<and> (v', s') \<in> mres (f s))"
-  by (auto simp add: liftE_def in_bind in_return)
-
-lemma in_whenE:  "((v, s') \<in> mres (whenE P f s)) = ((P \<longrightarrow> (v, s') \<in> mres (f s)) \<and>
-                                                   (\<not>P \<longrightarrow> v = Inr () \<and> s' = s))"
-  by (simp add: whenE_def in_returnOk)
-
-lemma inl_whenE:
-  "((Inl x, s') \<in> mres (whenE P f s)) = (P \<and> (Inl x, s') \<in> mres (f s))"
-  by (auto simp add: in_whenE)
-
-lemma in_fail:
-  "r \<in> mres (fail s) = False"
-  by (simp add: fail_def mres_def)
-
-lemma in_assert:
-  "(r, s') \<in> mres (assert P s) = (P \<and> s' = s)"
-  by (auto simp add: assert_def return_def fail_def mres_def)
-
-lemma in_assertE:
-  "(r, s') \<in> mres (assertE P s) = (P \<and> r = Inr () \<and> s' = s)"
-  by (auto simp add: assertE_def returnOk_def return_def fail_def mres_def)
-
-lemma in_assert_opt:
-  "(r, s') \<in> mres (assert_opt v s) = (v = Some r \<and> s' = s)"
-  by (auto simp: assert_opt_def in_fail in_return split: option.splits)
-
-lemma in_get:
-  "(r, s') \<in> mres (get s) = (r = s \<and> s' = s)"
-  by (simp add: get_def mres_def)
-
-lemma in_gets:
-  "(r, s') \<in> mres (gets f s) = (r = f s \<and> s' = s)"
-  by (simp add: simpler_gets_def mres_def)
-
-lemma in_put:
-  "(r, s') \<in> mres (put x s) = (s' = x \<and> r = ())"
-  by (simp add: put_def mres_def)
-
-lemma in_when:
-  "(v, s') \<in> mres (when P f s) = ((P \<longrightarrow> (v, s') \<in> mres (f s)) \<and> (\<not>P \<longrightarrow> v = () \<and> s' = s))"
-  by (simp add: when_def in_return)
-
-lemma in_modify:
-  "(v, s') \<in> mres (modify f s) = (s'=f s \<and> v = ())"
-  by (auto simp add: modify_def bind_def get_def put_def mres_def)
-
-lemma gets_the_in_monad:
-  "((v, s') \<in> mres (gets_the f s)) = (s' = s \<and> f s = Some v)"
-  by (auto simp: gets_the_def in_bind in_gets in_assert_opt split: option.split)
-
-lemma in_alternative:
-  "(r,s') \<in> mres ((f \<sqinter> g) s) = ((r,s') \<in> mres (f s) \<or> (r,s') \<in> mres (g s))"
-  by (auto simp add: alternative_def mres_def)
-
-lemmas in_monad = inl_whenE in_whenE in_liftE in_bind in_bindE_L
-                  in_bindE_R in_returnOk in_throwError in_fail
-                  in_assertE in_assert in_return in_assert_opt
-                  in_get in_gets in_put in_when (* unlessE_whenE *)
-                  (* unless_when *) in_modify gets_the_in_monad
-                  in_alternative
-
-subsection "Non-Failure"
-
-lemma no_failD:
-  "\<lbrakk> no_fail P m; P s \<rbrakk> \<Longrightarrow> Failed \<notin> snd ` m s"
-  by (simp add: no_fail_def)
-
-lemma no_fail_modify [wp,simp]:
-  "no_fail \<top> (modify f)"
-  by (simp add: no_fail_def modify_def get_def put_def bind_def)
-
-lemma no_fail_gets_simp[simp]:
-  "no_fail P (gets f)"
-  unfolding no_fail_def gets_def get_def return_def bind_def
-  by simp
-
-lemma no_fail_gets:
-  "no_fail \<top> (gets f)"
-  by simp
-
-lemma snd_pair_image:
- "snd ` Pair x ` S = S"
-  by (simp add: image_def)
-
-lemma no_fail_select [simp]:
-  "no_fail \<top> (select S)"
-  by (simp add: no_fail_def select_def image_def)
-
-lemma no_fail_pre:
-  "\<lbrakk> no_fail P f; \<And>s. Q s \<Longrightarrow> P s\<rbrakk> \<Longrightarrow> no_fail Q f"
-  by (simp add: no_fail_def)
-
-lemma no_fail_alt [wp]:
-  "\<lbrakk> no_fail P f; no_fail Q g \<rbrakk> \<Longrightarrow> no_fail (P and Q) (f \<sqinter> g)"
-  by (auto simp add: no_fail_def alternative_def)
-
-lemma no_fail_return [simp, wp]:
-  "no_fail \<top> (return x)"
-  by (simp add: return_def no_fail_def)
-
-lemma no_fail_get [simp, wp]:
-  "no_fail \<top> get"
-  by (simp add: get_def no_fail_def)
-
-lemma no_fail_put [simp, wp]:
-  "no_fail \<top> (put s)"
-  by (simp add: put_def no_fail_def)
-
-lemma no_fail_when [wp]:
-  "(P \<Longrightarrow> no_fail Q f) \<Longrightarrow> no_fail (if P then Q else \<top>) (when P f)"
-  by (simp add: when_def)
-
-lemma no_fail_unless [wp]:
-  "(\<not>P \<Longrightarrow> no_fail Q f) \<Longrightarrow> no_fail (if P then \<top> else Q) (unless P f)"
-  by (simp add: unless_def when_def)
-
-lemma no_fail_fail [simp, wp]:
-  "no_fail \<bottom> fail"
-  by (simp add: fail_def no_fail_def)
-
-lemmas [wp] = no_fail_gets
-
-lemma no_fail_assert [simp, wp]:
-  "no_fail (\<lambda>_. P) (assert P)"
-  by (simp add: assert_def)
-
-lemma no_fail_assert_opt [simp, wp]:
-  "no_fail (\<lambda>_. P \<noteq> None) (assert_opt P)"
-  by (simp add: assert_opt_def split: option.splits)
-
-lemma no_fail_case_option [wp]:
-  assumes f: "no_fail P f"
-  assumes g: "\<And>x. no_fail (Q x) (g x)"
-  shows "no_fail (if x = None then P else Q (the x)) (case_option f g x)"
-  by (clarsimp simp add: f g)
-
-lemma no_fail_if [wp]:
-  "\<lbrakk> P \<Longrightarrow> no_fail Q f; \<not>P \<Longrightarrow> no_fail R g \<rbrakk> \<Longrightarrow>
-  no_fail (if P then Q else R) (if P then f else g)"
-  by simp
-
-lemma no_fail_apply [wp]:
-  "no_fail P (f (g x)) \<Longrightarrow> no_fail P (f $ g x)"
-  by simp
-
-lemma no_fail_undefined [simp, wp]:
-  "no_fail \<bottom> undefined"
-  by (simp add: no_fail_def)
-
-lemma no_fail_returnOK [simp, wp]:
-  "no_fail \<top> (returnOk x)"
-  by (simp add: returnOk_def)
-
-(* text {* Empty results implies non-failure *}
-
-lemma empty_fail_modify [simp]:
-  "empty_fail (modify f)"
-  by (simp add: empty_fail_def simpler_modify_def)
-
-lemma empty_fail_gets [simp]:
-  "empty_fail (gets f)"
-  by (simp add: empty_fail_def simpler_gets_def)
-
-lemma empty_failD:
-  "\<lbrakk> empty_fail m; fst (m s) = {} \<rbrakk> \<Longrightarrow> snd (m s)"
-  by (simp add: empty_fail_def)
-
-lemma empty_fail_select_f [simp]:
-  assumes ef: "fst S = {} \<Longrightarrow> snd S"
-  shows "empty_fail (select_f S)"
-  by (fastforce simp add: empty_fail_def select_f_def intro: ef)
-
-lemma empty_fail_bind [simp]:
-  "\<lbrakk> empty_fail a; \<And>x. empty_fail (b x) \<rbrakk> \<Longrightarrow> empty_fail (a >>= b)"
-  apply (simp add: bind_def empty_fail_def split_def)
-  apply clarsimp
-  apply (case_tac "fst (a s) = {}")
-   apply blast
-  apply (clarsimp simp: ex_in_conv [symmetric])
-  done
-
-lemma empty_fail_return [simp]:
-  "empty_fail (return x)"
-  by (simp add: empty_fail_def return_def)
-
-lemma empty_fail_mapM [simp]:
-  assumes m: "\<And>x. empty_fail (m x)"
-  shows "empty_fail (mapM m xs)"
-proof (induct xs)
-  case Nil
-  thus ?case by (simp add: mapM_def sequence_def)
-next
-  case Cons
-  have P: "\<And>m x xs. mapM m (x # xs) = (do y \<leftarrow> m x; ys \<leftarrow> (mapM m xs); return (y # ys) od)"
-    by (simp add: mapM_def sequence_def Let_def)
-  from Cons
-  show ?case by (simp add: P m)
-qed
-
-lemma empty_fail [simp]:
-  "empty_fail fail"
-  by (simp add: fail_def empty_fail_def)
-
-lemma empty_fail_assert_opt [simp]:
-  "empty_fail (assert_opt x)"
-  by (simp add: assert_opt_def split: option.splits)
-
-lemma empty_fail_mk_ef:
-  "empty_fail (mk_ef o m)"
-  by (simp add: empty_fail_def mk_ef_def)
- *)
-subsection "Failure"
-
-lemma fail_wp: "\<lbrace>\<lambda>x. True\<rbrace> fail \<lbrace>Q\<rbrace>"
-  by (simp add: valid_def fail_def mres_def vimage_def)
-
-lemma failE_wp: "\<lbrace>\<lambda>x. True\<rbrace> fail \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by (simp add: validE_def fail_wp)
-
-lemma fail_update [iff]:
-  "fail (f s) = fail s"
-  by (simp add: fail_def)
-
-
-text \<open>We can prove postconditions using hoare triples\<close>
-
-lemma post_by_hoare: "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; P s; (r, s') \<in> mres (f s) \<rbrakk> \<Longrightarrow> Q r s'"
-  apply (simp add: valid_def)
-  apply blast
-  done
-
-text \<open>Weakest Precondition Rules\<close>
-
 lemma hoare_vcg_prop:
   "\<lbrace>\<lambda>s. P\<rbrace> f \<lbrace>\<lambda>rv s. P\<rbrace>"
   by (simp add: valid_def)
 
-lemma return_wp:
-  "\<lbrace>P x\<rbrace> return x \<lbrace>P\<rbrace>"
-  by(simp add:valid_def return_def mres_def)
 
-(* lemma get_wp:
-  "\<lbrace>\<lambda>s. P s s\<rbrace> get \<lbrace>P\<rbrace>"
-  by(auto simp add:valid_def split_def get_def mres_def)
- *)
-lemma gets_wp:
-  "\<lbrace>\<lambda>s. P (f s) s\<rbrace> gets f \<lbrace>P\<rbrace>"
-  by(simp add:valid_def split_def gets_def return_def get_def bind_def mres_def)
+subsection \<open>@{const valid} and @{const validE}, @{const validE_R}, @{const validE_E}\<close>
 
-(* lemma modify_wp:
-  "\<lbrace>\<lambda>s. P () (f s)\<rbrace> modify f \<lbrace>P\<rbrace>"
-  by(simp add:valid_def split_def modify_def get_def put_def bind_def )
- *)
-(* lemma put_wp:
- "\<lbrace>\<lambda>s. P () x\<rbrace> put x \<lbrace>P\<rbrace>"
- by(simp add:valid_def put_def)
- *)
-lemma returnOk_wp:
-  "\<lbrace>P x\<rbrace> returnOk x \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
- by(simp add:validE_def2 returnOk_def return_def mres_def)
+lemma valid_validE:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace>, \<lbrace>\<lambda>_. Q\<rbrace>"
+  by (rule hoare_post_imp_dc)
 
-lemma throwError_wp:
-  "\<lbrace>E e\<rbrace> throwError e \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
-  by(simp add:validE_def2 throwError_def return_def mres_def)
+lemma valid_validE2:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q'\<rbrace>; \<And>s. Q' s \<Longrightarrow> Q s; \<And>s. Q' s \<Longrightarrow> E s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace>, \<lbrace>\<lambda>_. E\<rbrace>"
+  unfolding valid_def validE_def
+  by (clarsimp split: sum.splits) blast
 
-lemma returnOKE_R_wp : "\<lbrace>P x\<rbrace> returnOk x \<lbrace>P\<rbrace>, -"
-  by (simp add: validE_R_def validE_def valid_def returnOk_def return_def mres_def)
+lemma validE_valid:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace>, \<lbrace>\<lambda>_. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace>"
+  unfolding validE_def valid_def
+  by fastforce
 
-lemma catch_wp:
-  "\<lbrakk> \<And>x. \<lbrace>E x\<rbrace> handler x \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace>P\<rbrace> catch f handler \<lbrace>Q\<rbrace>"
-  apply (unfold catch_def validE_def)
-  apply (erule seq_ext)
-  apply (simp add: return_wp split: sum.splits)
-  done
+lemma valid_validE_R:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace>,-"
+  by (simp add: validE_R_def hoare_post_impErr [OF valid_validE])
 
-lemma handleE'_wp:
-  "\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace>P\<rbrace> f <handle2> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  apply (unfold handleE'_def validE_def)
-  apply (erule seq_ext)
-  apply (clarsimp split: sum.splits)
-  apply (simp add: valid_def return_def mres_def)
-  done
+lemma valid_validE_E:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -,\<lbrace>\<lambda>_. Q\<rbrace>"
+  by (simp add: validE_E_def hoare_post_impErr [OF valid_validE])
 
-lemma handleE_wp:
-  assumes x: "\<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  assumes y: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>"
-  shows      "\<lbrace>P\<rbrace> f <handle> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by (simp add: handleE_def handleE'_wp [OF x y])
+lemma validE_validE_R:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>\<top>\<top>\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
+  by (simp add: validE_R_def)
 
-lemma hoare_vcg_split_if:
- "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>S\<rbrace>; \<not>P \<Longrightarrow> \<lbrace>R\<rbrace> g \<lbrace>S\<rbrace> \<rbrakk> \<Longrightarrow>
-  \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not>P \<longrightarrow> R s)\<rbrace> if P then f else g \<lbrace>S\<rbrace>"
-  by simp
+lemma validE_R_validE:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>"
+  by (simp add: validE_R_def)
+
+lemma validE_validE_E:
+  "\<lbrace>P\<rbrace> f \<lbrace>\<top>\<top>\<rbrace>, \<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -, \<lbrace>E\<rbrace>"
+  by (simp add: validE_E_def)
+
+lemma validE_E_validE:
+  "\<lbrace>P\<rbrace> f -, \<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<top>\<top>\<rbrace>, \<lbrace>E\<rbrace>"
+  by (simp add: validE_E_def)
 
-lemma hoare_vcg_split_ifE:
- "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>S\<rbrace>,\<lbrace>E\<rbrace>; \<not>P \<Longrightarrow> \<lbrace>R\<rbrace> g \<lbrace>S\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
-  \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not>P \<longrightarrow> R s)\<rbrace> if P then f else g \<lbrace>S\<rbrace>,\<lbrace>E\<rbrace>"
-  by simp
+
+subsection \<open>@{const liftM}\<close>
 
 lemma in_image_constant:
   "(x \<in> (\<lambda>_. v) ` S) = (x = v \<and> S \<noteq> {})"
   by (simp add: image_constant_conv)
 
-lemma hoare_liftM_subst: "\<lbrace>P\<rbrace> liftM f m \<lbrace>Q\<rbrace> = \<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace>"
-  apply (simp add: liftM_def bind_def2 return_def split_def mres_def)
+lemma hoare_liftM_subst:
+  "\<lbrace>P\<rbrace> liftM f m \<lbrace>Q\<rbrace> = \<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace>"
+  apply (simp add: liftM_def bind_def2 return_def split_def)
   apply (simp add: valid_def Ball_def mres_def image_Un)
   apply (simp add: image_image in_image_constant)
-  apply (rule_tac f=All in arg_cong)
-  apply (rule ext)
   apply force
   done
 
-lemma liftE_validE[simp]: "\<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> = \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
-  apply (simp add: liftE_liftM validE_def hoare_liftM_subst o_def)
-  done
+lemma hoare_liftME_subst:
+  "\<lbrace>P\<rbrace> liftME f m \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace> = \<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace>, \<lbrace>E\<rbrace>"
+  unfolding validE_def liftME_liftM hoare_liftM_subst o_def
+  by (fastforce intro!: arg_cong[where f="valid P m"] split: sum.splits)
 
-lemma liftE_wp:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by simp
+lemma liftE_validE[simp]:
+  "\<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace> = \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
+  by (simp add: liftE_liftM validE_def hoare_liftM_subst o_def)
 
-lemma liftM_wp: "\<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftM f m \<lbrace>Q\<rbrace>"
-  by (simp add: hoare_liftM_subst)
 
-lemma hoare_liftME_subst: "\<lbrace>P\<rbrace> liftME f m \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> = \<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace>,\<lbrace>E\<rbrace>"
-  apply (simp add: validE_def liftME_liftM hoare_liftM_subst o_def)
-  apply (rule_tac f="valid P m" in arg_cong)
-  apply (rule ext)+
-  apply (case_tac x, simp_all)
-  done
+subsection \<open>Operator lifting/splitting\<close>
 
-lemma liftME_wp: "\<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftME f m \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by (simp add: hoare_liftME_subst)
+lemma hoare_vcg_if_split:
+  "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>S\<rbrace>; \<not>P \<Longrightarrow> \<lbrace>R\<rbrace> g \<lbrace>S\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not>P \<longrightarrow> R s)\<rbrace> if P then f else g \<lbrace>S\<rbrace>"
+  by simp
 
-(* FIXME: Move *)
-lemma o_const_simp[simp]: "(\<lambda>x. C) \<circ> f = (\<lambda>x. C)"
-  by (simp add: o_def)
+lemma hoare_vcg_if_splitE:
+  "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>S\<rbrace>,\<lbrace>E\<rbrace>; \<not>P \<Longrightarrow> \<lbrace>R\<rbrace> g \<lbrace>S\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not>P \<longrightarrow> R s)\<rbrace> if P then f else g \<lbrace>S\<rbrace>,\<lbrace>E\<rbrace>"
+  by simp
 
 lemma hoare_vcg_split_case_option:
- "\<lbrakk> \<And>x. x = None \<Longrightarrow> \<lbrace>P x\<rbrace> f x \<lbrace>R x\<rbrace>;
-    \<And>x y. x = Some y \<Longrightarrow> \<lbrace>Q x y\<rbrace> g x y \<lbrace>R x\<rbrace> \<rbrakk> \<Longrightarrow>
-  \<lbrace>\<lambda>s. (x = None \<longrightarrow> P x s) \<and>
-       (\<forall>y. x = Some y \<longrightarrow> Q x y s)\<rbrace>
-  case x of None \<Rightarrow> f x
-          | Some y \<Rightarrow> g x y
+ "\<lbrakk> \<And>x. x = None \<Longrightarrow> \<lbrace>P x\<rbrace> f x \<lbrace>R x\<rbrace>; \<And>x y. x = Some y \<Longrightarrow> \<lbrace>Q x y\<rbrace> g x y \<lbrace>R x\<rbrace> \<rbrakk> \<Longrightarrow>
+  \<lbrace>\<lambda>s. (x = None \<longrightarrow> P x s) \<and> (\<forall>y. x = Some y \<longrightarrow> Q x y s)\<rbrace>
+  case x of None \<Rightarrow> f x | Some y \<Rightarrow> g x y
   \<lbrace>R x\<rbrace>"
- apply(simp add:valid_def split_def)
- apply(case_tac x, simp_all)
-done
+  by (cases x; simp)
 
 lemma hoare_vcg_split_case_optionE:
- assumes none_case: "\<And>x. x = None \<Longrightarrow> \<lbrace>P x\<rbrace> f x \<lbrace>R x\<rbrace>,\<lbrace>E x\<rbrace>"
- assumes some_case: "\<And>x y. x = Some y \<Longrightarrow> \<lbrace>Q x y\<rbrace> g x y \<lbrace>R x\<rbrace>,\<lbrace>E x\<rbrace>"
- shows "\<lbrace>\<lambda>s. (x = None \<longrightarrow> P x s) \<and>
-             (\<forall>y. x = Some y \<longrightarrow> Q x y s)\<rbrace>
-        case x of None \<Rightarrow> f x
-                | Some y \<Rightarrow> g x y
-        \<lbrace>R x\<rbrace>,\<lbrace>E x\<rbrace>"
- apply(case_tac x, simp_all)
-  apply(rule none_case, simp)
- apply(rule some_case, simp)
-done
+  "\<lbrakk> \<And>x. x = None \<Longrightarrow> \<lbrace>P x\<rbrace> f x \<lbrace>R x\<rbrace>,\<lbrace>E x\<rbrace>; \<And>x y. x = Some y \<Longrightarrow> \<lbrace>Q x y\<rbrace> g x y \<lbrace>R x\<rbrace>,\<lbrace>E x\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. (x = None \<longrightarrow> P x s) \<and> (\<forall>y. x = Some y \<longrightarrow> Q x y s)\<rbrace>
+   case x of None \<Rightarrow> f x | Some y \<Rightarrow> g x y
+   \<lbrace>R x\<rbrace>, \<lbrace>E x\<rbrace>"
+  by (cases x; simp)
 
 lemma hoare_vcg_split_case_sum:
- "\<lbrakk> \<And>x a. x = Inl a \<Longrightarrow> \<lbrace>P x a\<rbrace> f x a \<lbrace>R x\<rbrace>;
-    \<And>x b. x = Inr b \<Longrightarrow> \<lbrace>Q x b\<rbrace> g x b \<lbrace>R x\<rbrace> \<rbrakk> \<Longrightarrow>
-  \<lbrace>\<lambda>s. (\<forall>a. x = Inl a \<longrightarrow> P x a s) \<and>
-       (\<forall>b. x = Inr b \<longrightarrow> Q x b s) \<rbrace>
-  case x of Inl a \<Rightarrow> f x a
-          | Inr b \<Rightarrow> g x b
+ "\<lbrakk> \<And>x a. x = Inl a \<Longrightarrow> \<lbrace>P x a\<rbrace> f x a \<lbrace>R x\<rbrace>; \<And>x b. x = Inr b \<Longrightarrow> \<lbrace>Q x b\<rbrace> g x b \<lbrace>R x\<rbrace> \<rbrakk> \<Longrightarrow>
+  \<lbrace>\<lambda>s. (\<forall>a. x = Inl a \<longrightarrow> P x a s) \<and> (\<forall>b. x = Inr b \<longrightarrow> Q x b s) \<rbrace>
+  case x of Inl a \<Rightarrow> f x a | Inr b \<Rightarrow> g x b
   \<lbrace>R x\<rbrace>"
- apply(simp add:valid_def split_def)
- apply(case_tac x, simp_all)
-done
-
-lemma hoare_vcg_split_case_sumE:
-  assumes left_case: "\<And>x a. x = Inl a \<Longrightarrow> \<lbrace>P x a\<rbrace> f x a \<lbrace>R x\<rbrace>"
-  assumes right_case: "\<And>x b. x = Inr b \<Longrightarrow> \<lbrace>Q x b\<rbrace> g x b \<lbrace>R x\<rbrace>"
-  shows "\<lbrace>\<lambda>s. (\<forall>a. x = Inl a \<longrightarrow> P x a s) \<and>
-              (\<forall>b. x = Inr b \<longrightarrow> Q x b s) \<rbrace>
-         case x of Inl a \<Rightarrow> f x a
-                 | Inr b \<Rightarrow> g x b
-         \<lbrace>R x\<rbrace>"
- apply(case_tac x, simp_all)
-  apply(rule left_case, simp)
- apply(rule right_case, simp)
-done
-
-lemma hoare_vcg_precond_imp:
- "\<lbrakk> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>; \<And>s. P s \<Longrightarrow> Q s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>"
-  by (fastforce simp add:valid_def)
-
-lemma hoare_vcg_precond_impE:
- "\<lbrakk> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>; \<And>s. P s \<Longrightarrow> Q s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>"
-  by (fastforce simp add:validE_def2)
-
-lemma hoare_seq_ext:
-  assumes g_valid: "\<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>"
-  assumes f_valid: "\<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>"
-  shows "\<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>C\<rbrace>"
- apply(insert f_valid g_valid)
- apply(blast intro: seq_ext')
-done
-
-lemma hoare_vcg_seqE:
-  assumes g_valid: "\<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>"
-  assumes f_valid: "\<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>,\<lbrace>E\<rbrace>"
-  shows "\<lbrace>A\<rbrace> doE x \<leftarrow> f; g x odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>"
- apply(insert f_valid g_valid)
- apply(blast intro: seqE')
-done
-
-lemma hoare_seq_ext_nobind:
-  "\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>;
-     \<lbrace>A\<rbrace> f \<lbrace>\<lambda>r s. B s\<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace>A\<rbrace> do f; g od \<lbrace>C\<rbrace>"
-  apply (erule seq_ext)
-  apply (clarsimp simp: valid_def)
-  done
-
-lemma hoare_seq_ext_nobindE:
-  "\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>;
-     \<lbrace>A\<rbrace> f \<lbrace>\<lambda>r s. B s\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace>A\<rbrace> doE f; g odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>"
-  apply (erule seqE)
-  apply (clarsimp simp:validE_def)
-  done
-
-lemma hoare_chain:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>;
-    \<And>s. R s \<Longrightarrow> P s;
-    \<And>r s. Q r s \<Longrightarrow> S r s \<rbrakk> \<Longrightarrow>
-   \<lbrace>R\<rbrace> f \<lbrace>S\<rbrace>"
-  by(fastforce simp add:valid_def split_def)
-
-lemma validE_weaken:
-  "\<lbrakk> \<lbrace>P'\<rbrace> A \<lbrace>Q'\<rbrace>,\<lbrace>E'\<rbrace>; \<And>s. P s \<Longrightarrow> P' s; \<And>r s. Q' r s \<Longrightarrow> Q r s; \<And>r s. E' r s \<Longrightarrow> E r s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> A \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by (fastforce simp: validE_def2 split: sum.splits)
-
-lemmas hoare_chainE = validE_weaken
-
-lemma hoare_vcg_handle_elseE:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>;
-     \<And>e. \<lbrace>E e\<rbrace> g e \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>;
-     \<And>x. \<lbrace>Q x\<rbrace> h x \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace>P\<rbrace> f <handle> g <else> h \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>"
-  apply (simp add: handle_elseE_def validE_def)
-  apply (rule seq_ext)
-   apply assumption
-  apply (simp split: sum.split)
-  done
+  by (cases x; simp)
 
-lemma in_mres:
-  "(tr, Result (rv, s)) \<in> S \<Longrightarrow> (rv, s) \<in> mres S"
-  by (fastforce simp: mres_def intro: image_eqI[rotated])
+lemmas hoare_vcg_precond_imp = hoare_weaken_pre (* FIXME lib: eliminate *)
 
-lemma alternative_wp:
-  assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
-  assumes y: "\<lbrace>P'\<rbrace> f' \<lbrace>Q\<rbrace>"
-  shows      "\<lbrace>P and P'\<rbrace> f \<sqinter> f' \<lbrace>Q\<rbrace>"
-  unfolding valid_def alternative_def mres_def
-  using post_by_hoare[OF x _ in_mres] post_by_hoare[OF y _ in_mres]
-  by fastforce
-
-lemma alternativeE_wp:
-  assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>" and y: "\<lbrace>P'\<rbrace> f' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  shows      "\<lbrace>P and P'\<rbrace> f \<sqinter> f' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  apply (unfold validE_def)
-  apply (wp add: x y alternative_wp | simp | fold validE_def)+
-  done
-
-lemma alternativeE_R_wp:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>P'\<rbrace> f' \<lbrace>Q\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> f \<sqinter> f' \<lbrace>Q\<rbrace>,-"
-  apply (simp add: validE_R_def)
-  apply (rule alternativeE_wp)
-   apply assumption+
-  done
+lemmas hoare_seq_ext = seq_ext[rotated]
+lemmas hoare_vcg_seqE = seqE[rotated]
 
-lemma alternative_R_wp:
-  "\<lbrakk> \<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> g -,\<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> f \<sqinter> g -, \<lbrace>Q\<rbrace>"
-  apply (simp add: validE_E_def)
-  apply (rule alternativeE_wp)
-   apply assumption+
-  done
+lemma hoare_seq_ext_nobind:
+  "\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>; \<lbrace>A\<rbrace> f \<lbrace>\<lambda>_. B\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> do f; g od \<lbrace>C\<rbrace>"
+  by (erule seq_ext) (clarsimp simp: valid_def)
 
-lemma state_select_wp [wp]: "\<lbrace> \<lambda>s. \<forall>t. (s, t) \<in> f \<longrightarrow> P () t \<rbrace> state_select f \<lbrace> P \<rbrace>"
-  apply (clarsimp simp: state_select_def assert_def)
-  apply (rule hoare_weaken_pre)
-   apply (wp select_wp hoare_vcg_split_if return_wp fail_wp)
-  apply simp
-  done
+lemma hoare_seq_ext_nobindE:
+  "\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>; \<lbrace>A\<rbrace> f \<lbrace>\<lambda>_. B\<rbrace>, \<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> doE f; g odE \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>"
+  by (erule seqE) (clarsimp simp: validE_def)
 
-lemma condition_wp [wp]:
-  "\<lbrakk> \<lbrace> Q \<rbrace> A \<lbrace> P \<rbrace>;  \<lbrace> R \<rbrace> B \<lbrace> P \<rbrace>  \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s. if C s then Q s else R s \<rbrace> condition C A B \<lbrace> P \<rbrace>"
-  apply (clarsimp simp: condition_def)
-  apply (clarsimp simp: valid_def pred_conj_def pred_neg_def split_def)
-  done
+lemmas hoare_seq_ext_skip' = hoare_seq_ext[where Q'=Q and Q=Q for Q]
 
-lemma conditionE_wp [wp]:
-  "\<lbrakk> \<lbrace> P \<rbrace> A \<lbrace> Q \<rbrace>,\<lbrace> R \<rbrace>; \<lbrace> P' \<rbrace> B \<lbrace> Q \<rbrace>,\<lbrace> R \<rbrace> \<rbrakk> \<Longrightarrow>  \<lbrace> \<lambda>s. if C s then P s else P' s \<rbrace> condition C A B \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>"
-  apply (clarsimp simp: condition_def)
-  apply (clarsimp simp: validE_def valid_def)
-  done
+lemma hoare_chain:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<And>s. R s \<Longrightarrow> P s; \<And>rv s. Q rv s \<Longrightarrow> S rv s \<rbrakk> \<Longrightarrow> \<lbrace>R\<rbrace> f \<lbrace>S\<rbrace>"
+  by (wp_pre, rule hoare_post_imp)
 
-lemma state_assert_wp [wp]: "\<lbrace> \<lambda>s. f s \<longrightarrow> P () s \<rbrace> state_assert f \<lbrace> P \<rbrace>"
-  apply (clarsimp simp: state_assert_def get_def
-    assert_def bind_def valid_def return_def fail_def mres_def)
-  done
+lemma validE_weaken: (* FIXME lib: eliminate in favour of hoare_chainE *)
+  "\<lbrakk> \<lbrace>P'\<rbrace> A \<lbrace>Q'\<rbrace>,\<lbrace>E'\<rbrace>; \<And>s. P s \<Longrightarrow> P' s; \<And>rv s. Q' rv s \<Longrightarrow> Q rv s; \<And>rv s. E' rv s \<Longrightarrow> E rv s \<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace> A \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by wp_pre (rule hoare_post_impErr)
 
-text \<open>The weakest precondition handler which works on conjunction\<close>
+lemmas hoare_chainE = validE_weaken
 
 lemma hoare_vcg_conj_lift:
-  assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
-  assumes y: "\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>"
-  shows      "\<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>"
-  apply (subst pred_conj_def[symmetric], subst pred_conj_def[symmetric], rule hoare_post_conj)
-   apply (rule hoare_pre_imp [OF _ x], simp)
-  apply (rule hoare_pre_imp [OF _ y], simp)
-  done
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>"
+  unfolding valid_def
+  by fastforce
 
 lemma hoare_vcg_conj_liftE1:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
-  \<lbrace>P and P'\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> Q' r s\<rbrace>,\<lbrace>E\<rbrace>"
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>,\<lbrace>E\<rbrace>"
   unfolding valid_def validE_R_def validE_def
-  apply (clarsimp simp: split_def split: sum.splits)
-  apply (erule allE, erule (1) impE)
-  apply (erule allE, erule (1) impE)
-  apply (drule (1) bspec)
-  apply (drule (1) bspec)
-  apply clarsimp
-  done
+  by (fastforce simp: split_def split: sum.splits)
 
 lemma hoare_vcg_disj_lift:
-  assumes x: "\<lbrace>P\<rbrace>  f \<lbrace>Q\<rbrace>"
-  assumes y: "\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>"
-  shows      "\<lbrace>\<lambda>s. P s \<or> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<or> Q' rv s\<rbrace>"
-  apply (simp add: valid_def)
-  apply safe
-   apply (erule(1) post_by_hoare [OF x])
-  apply (erule notE)
-  apply (erule(1) post_by_hoare [OF y])
-  done
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<or> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<or> Q' rv s\<rbrace>"
+  unfolding valid_def
+  by fastforce
 
 lemma hoare_vcg_const_Ball_lift:
   "\<lbrakk> \<And>x. x \<in> S \<Longrightarrow> \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x\<in>S. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x\<in>S. Q x rv s\<rbrace>"
   by (fastforce simp: valid_def)
 
 lemma hoare_vcg_const_Ball_lift_R:
- "\<lbrakk> \<And>x. x \<in> S \<Longrightarrow> \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>,- \<rbrakk> \<Longrightarrow>
-   \<lbrace>\<lambda>s. \<forall>x \<in> S. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x \<in> S. Q x rv s\<rbrace>,-"
-  apply (simp add: validE_R_def validE_def)
-  apply (rule hoare_strengthen_post)
-   apply (erule hoare_vcg_const_Ball_lift)
-  apply (simp split: sum.splits)
-  done
+ "\<lbrakk> \<And>x. x \<in> S \<Longrightarrow> \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x \<in> S. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x \<in> S. Q x rv s\<rbrace>,-"
+  unfolding validE_R_def validE_def
+  by (rule hoare_strengthen_post)
+     (fastforce intro!: hoare_vcg_const_Ball_lift split: sum.splits)+
 
 lemma hoare_vcg_all_lift:
   "\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>"
@@ -1640,8 +557,7 @@ lemma hoare_vcg_all_lift_R:
   by (rule hoare_vcg_const_Ball_lift_R[where S=UNIV, simplified])
 
 lemma hoare_vcg_const_imp_lift:
-  "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> m \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow>
-   \<lbrace>\<lambda>s. P \<longrightarrow> Q s\<rbrace> m \<lbrace>\<lambda>rv s. P \<longrightarrow> R rv s\<rbrace>"
+  "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> m \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P \<longrightarrow> Q s\<rbrace> m \<lbrace>\<lambda>rv s. P \<longrightarrow> R rv s\<rbrace>"
   by (cases P, simp_all add: hoare_vcg_prop)
 
 lemma hoare_vcg_const_imp_lift_R:
@@ -1666,868 +582,1009 @@ lemma hoare_trivE:   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbra
 lemma hoare_trivE_R: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-" .
 lemma hoare_trivR_R: "\<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>" .
 
-lemma hoare_weaken_preE_E:
-  "\<lbrakk> \<lbrace>P'\<rbrace> f -,\<lbrace>Q\<rbrace>; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace>"
-  by (fastforce simp add: validE_E_def validE_def valid_def)
-
 lemma hoare_vcg_E_conj:
-  "\<lbrakk> \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,\<lbrace>E'\<rbrace> \<rbrakk>
-    \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace>\<lambda>rv s. E rv s \<and> E' rv s\<rbrace>"
-  apply (unfold validE_def validE_E_def)
-  apply (rule hoare_post_imp [OF _ hoare_vcg_conj_lift], simp_all)
-  apply (case_tac r, simp_all)
-  done
+  "\<lbrakk> \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,\<lbrace>E'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace>\<lambda>rv s. E rv s \<and> E' rv s\<rbrace>"
+  unfolding validE_def validE_E_def
+  by (rule hoare_post_imp[OF _ hoare_vcg_conj_lift]; simp split: sum.splits)
 
 lemma hoare_vcg_E_elim:
-  "\<lbrakk> \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>,- \<rbrakk>
-    \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by (rule hoare_post_impErr [OF hoare_vcg_E_conj],
-      (simp add: validE_R_def)+)
+  "\<lbrakk> \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by (rule hoare_post_impErr[OF hoare_vcg_E_conj]) (simp add: validE_R_def)+
 
 lemma hoare_vcg_R_conj:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,- \<rbrakk>
-    \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>,-"
-  apply (unfold validE_R_def validE_def)
-  apply (rule hoare_post_imp [OF _ hoare_vcg_conj_lift], simp_all)
-  apply (case_tac r, simp_all)
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>,-"
+  unfolding validE_R_def validE_def
+  by (rule hoare_post_imp[OF _ hoare_vcg_conj_lift]; simp split: sum.splits)
+
+lemma hoare_post_imp_R:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>,-; \<And>rv s. Q' rv s \<Longrightarrow> Q rv s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
+  unfolding validE_R_def
+  by (erule hoare_post_impErr)
+
+lemma hoare_post_comb_imp_conj:
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>"
+  by (wpsimp wp: hoare_vcg_conj_lift)
+
+
+subsection \<open>Weakest Precondition Rules\<close>
+
+lemma fail_wp:
+  "\<lbrace>\<top>\<rbrace> fail \<lbrace>Q\<rbrace>"
+  by (simp add: valid_def fail_def mres_def vimage_def)
+
+lemma return_wp:
+  "\<lbrace>P x\<rbrace> return x \<lbrace>P\<rbrace>"
+  by(simp add: valid_def return_def mres_def)
+
+lemma get_wp:
+  "\<lbrace>\<lambda>s. Q s s\<rbrace> get \<lbrace>Q\<rbrace>"
+  by (simp add: get_def valid_def mres_def)
+
+lemma gets_wp:
+  "\<lbrace>\<lambda>s. P (f s) s\<rbrace> gets f \<lbrace>P\<rbrace>"
+  by(simp add: valid_def split_def gets_def return_def get_def bind_def mres_def)
+
+lemma put_wp:
+  "\<lbrace>\<lambda>_. Q () s\<rbrace> put s \<lbrace>Q\<rbrace>"
+  by (simp add: put_def valid_def mres_def)
+
+lemma modify_wp:
+  "\<lbrace>\<lambda>s. Q () (f s)\<rbrace> modify f \<lbrace>Q\<rbrace>"
+  unfolding modify_def
+  by (wp put_wp get_wp)
+
+lemma failE_wp:
+  "\<lbrace>\<top>\<rbrace> fail \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>"
+  by (simp add: validE_def fail_wp)
+
+lemma returnOk_wp:
+  "\<lbrace>P x\<rbrace> returnOk x \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
+  by (simp add: validE_def2 returnOk_def return_def mres_def)
+
+lemma throwError_wp:
+  "\<lbrace>E e\<rbrace> throwError e \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
+  by(simp add: validE_def2 throwError_def return_def mres_def)
+
+lemma returnOKE_R_wp:
+  "\<lbrace>P x\<rbrace> returnOk x \<lbrace>P\<rbrace>, -"
+  by (simp add: validE_R_def validE_def valid_def returnOk_def return_def mres_def)
+
+lemma liftE_wp:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by simp
+
+lemma catch_wp:
+  "\<lbrakk> \<And>x. \<lbrace>E x\<rbrace> handler x \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> catch f handler \<lbrace>Q\<rbrace>"
+  apply (unfold catch_def validE_def)
+  apply (erule seq_ext)
+  apply (simp add: return_wp split: sum.splits)
   done
 
-lemma valid_validE:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace>,\<lbrace>\<lambda>rv. Q\<rbrace>"
-  apply (simp add: validE_def)
+lemma handleE'_wp:
+  "\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f <handle2> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  apply (unfold handleE'_def validE_def)
+  apply (erule seq_ext)
+  apply (clarsimp split: sum.splits)
+  apply (simp add: valid_def return_def mres_def)
   done
 
-lemma valid_validE2:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q'\<rbrace>; \<And>s. Q' s \<Longrightarrow> Q s; \<And>s. Q' s \<Longrightarrow> E s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. Q\<rbrace>,\<lbrace>\<lambda>_. E\<rbrace>"
-  unfolding valid_def validE_def
-  by (clarsimp split: sum.splits) blast
+lemma handleE_wp:
+  assumes x: "\<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  assumes y: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>"
+  shows      "\<lbrace>P\<rbrace> f <handle> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by (simp add: handleE_def handleE'_wp [OF x y])
 
-lemma validE_valid: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace>,\<lbrace>\<lambda>rv. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace>"
-  apply (unfold validE_def)
-  apply (rule hoare_post_imp)
-   defer
-   apply assumption
-  apply (case_tac r, simp_all)
-  done
+lemma liftM_wp:
+  "\<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftM f m \<lbrace>Q\<rbrace>"
+  by (simp add: hoare_liftM_subst)
 
-lemma valid_validE_R:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace>,-"
-  by (simp add: validE_R_def hoare_post_impErr [OF valid_validE])
+lemma liftME_wp:
+  "\<lbrace>P\<rbrace> m \<lbrace>Q \<circ> f\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftME f m \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by (simp add: hoare_liftME_subst)
 
-lemma valid_validE_E:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -,\<lbrace>\<lambda>rv. Q\<rbrace>"
-  by (simp add: validE_E_def hoare_post_impErr [OF valid_validE])
+lemma assert_wp:
+  "\<lbrace>\<lambda>s. P \<longrightarrow> Q () s\<rbrace> assert P \<lbrace>Q\<rbrace>"
+  unfolding assert_def
+  by (wpsimp wp: return_wp fail_wp | rule conjI)+
 
-lemma validE_validE_R: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>\<top>\<top>\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
-  by (simp add: validE_R_def)
+lemma list_cases_wp:
+  assumes a: "\<lbrace>P_A\<rbrace> a \<lbrace>Q\<rbrace>"
+  assumes b: "\<And>x xs. ts = x#xs \<Longrightarrow> \<lbrace>P_B x xs\<rbrace> b x xs \<lbrace>Q\<rbrace>"
+  shows "\<lbrace>case_list P_A P_B ts\<rbrace> case ts of [] \<Rightarrow> a | x # xs \<Rightarrow> b x xs \<lbrace>Q\<rbrace>"
+  by (cases ts, auto simp: a b)
 
-lemma validE_R_validE: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>"
-  by (simp add: validE_R_def)
+lemma hoare_vcg_handle_elseE:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<And>e. \<lbrace>E e\<rbrace> g e \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>; \<And>x. \<lbrace>Q x\<rbrace> h x \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>P\<rbrace> f <handle> g <else> h \<lbrace>R\<rbrace>,\<lbrace>F\<rbrace>"
+  unfolding handle_elseE_def validE_def
+  by (wpsimp wp: seq_ext | assumption | rule conjI)+
 
-lemma hoare_post_imp_R: "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>,-; \<And>r s. Q' r s \<Longrightarrow> Q r s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
-  apply (unfold validE_R_def)
-  apply (rule hoare_post_impErr, simp+)
-  done
+lemma alternative_wp:
+  assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
+  assumes y: "\<lbrace>P'\<rbrace> f' \<lbrace>Q\<rbrace>"
+  shows      "\<lbrace>P and P'\<rbrace> f \<sqinter> f' \<lbrace>Q\<rbrace>"
+  unfolding valid_def alternative_def mres_def
+  using post_by_hoare[OF x _ in_mres] post_by_hoare[OF y _ in_mres]
+  by fastforce
 
-lemma hoare_post_comb_imp_conj:
-  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>"
-  apply (rule hoare_pre_imp)
-   defer
-   apply (rule hoare_vcg_conj_lift)
-    apply assumption+
+lemma alternativeE_wp:
+  assumes "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  assumes "\<lbrace>P'\<rbrace> f' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  shows   "\<lbrace>P and P'\<rbrace> f \<sqinter> f' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  unfolding validE_def
+  by (wpsimp wp: assms alternative_wp | fold validE_def)+
+
+lemma alternativeE_R_wp:
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>P'\<rbrace> f' \<lbrace>Q\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> f \<sqinter> f' \<lbrace>Q\<rbrace>,-"
+  unfolding validE_R_def
+  by (rule alternativeE_wp)
+
+lemma alternativeE_E_wp:
+  "\<lbrakk> \<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> g -,\<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> f \<sqinter> g -, \<lbrace>Q\<rbrace>"
+  unfolding validE_E_def
+  by (rule alternativeE_wp)
+
+lemma select_wp:
+  "\<lbrace>\<lambda>s. \<forall>x \<in> S. Q x s\<rbrace> select S \<lbrace>Q\<rbrace>"
+  by (simp add: select_def valid_def mres_def image_def)
+
+lemma state_select_wp:
+  "\<lbrace> \<lambda>s. \<forall>t. (s, t) \<in> f \<longrightarrow> P () t \<rbrace> state_select f \<lbrace>P\<rbrace>"
+  apply (clarsimp simp: state_select_def assert_def)
+  apply (rule hoare_weaken_pre)
+   apply (wp put_wp select_wp hoare_vcg_if_split return_wp fail_wp get_wp)
   apply simp
   done
 
-lemma hoare_vcg_precond_impE_R: "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>,-; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
-  by (unfold validE_R_def, rule hoare_vcg_precond_impE, simp+)
+lemma condition_wp:
+  "\<lbrakk> \<lbrace>Q\<rbrace> A \<lbrace>P\<rbrace>;  \<lbrace>R\<rbrace> B \<lbrace>P\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. if C s then Q s else R s\<rbrace> condition C A B \<lbrace>P\<rbrace>"
+  by (clarsimp simp: condition_def valid_def)
+
+lemma conditionE_wp:
+  "\<lbrakk> \<lbrace>P\<rbrace> A \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>; \<lbrace>P'\<rbrace> B \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. if C s then P s else P' s\<rbrace> condition C A B \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>"
+  by (clarsimp simp: condition_def validE_def valid_def)
+
+lemma state_assert_wp:
+  "\<lbrace>\<lambda>s. f s \<longrightarrow> P () s\<rbrace> state_assert f \<lbrace>P\<rbrace>"
+  unfolding state_assert_def
+  by (wp seq_ext get_wp assert_wp)
+
+lemma when_wp[wp_split]:
+  "\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> when P f \<lbrace>R\<rbrace>"
+  by (clarsimp simp: when_def valid_def return_def mres_def)
+
+lemma unless_wp[wp_split]:
+  "(\<not>P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>) \<Longrightarrow> \<lbrace>if P then R () else Q\<rbrace> unless P f \<lbrace>R\<rbrace>"
+  unfolding unless_def by wp auto
+
+lemma whenE_wp:
+  "(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>"
+  unfolding whenE_def by clarsimp (wp returnOk_wp)
+
+lemma hoare_K_bind[wp_split]:
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> K_bind f x \<lbrace>Q\<rbrace>"
+  by simp
+
+lemma hoare_fun_app_wp:
+  "\<lbrace>P\<rbrace> f' x \<lbrace>Q'\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f' $ x \<lbrace>Q'\<rbrace>"
+  "\<lbrace>P\<rbrace> f x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f $ x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  "\<lbrace>P\<rbrace> f x \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f $ x \<lbrace>Q\<rbrace>,-"
+  "\<lbrace>P\<rbrace> f x -,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f $ x -,\<lbrace>E\<rbrace>"
+  by simp+
+
+lemma liftE_validE_E:
+  "\<lbrace>\<top>\<rbrace> liftE f -, \<lbrace>Q\<rbrace>"
+  by (clarsimp simp: validE_E_def valid_def)
+
+lemma returnOk_E:
+  "\<lbrace>\<top>\<rbrace> returnOk r -, \<lbrace>Q\<rbrace>"
+  by (simp add: validE_E_def) (wp returnOk_wp)
+
+lemma case_option_wp:
+  "\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> m x \<lbrace>Q\<rbrace>; \<lbrace>P'\<rbrace> m' \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. (x = None \<longrightarrow> P' s) \<and> (x \<noteq> None \<longrightarrow> P (the x) s)\<rbrace> case_option m' m x \<lbrace>Q\<rbrace>"
+  by (cases x; simp)
+
+lemma case_option_wpE:
+  "\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> m x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<lbrace>P'\<rbrace> m' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>\<lambda>s. (x = None \<longrightarrow> P' s) \<and> (x \<noteq> None \<longrightarrow> P (the x) s)\<rbrace> case_option m' m x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by (cases x; simp)
+
+lemmas liftME_E_E_wp[wp_split] = validE_validE_E [OF liftME_wp, simplified, OF validE_E_validE]
+
+(* FIXME: make wp *)
+lemma whenE_throwError_wp:
+  "\<lbrace>\<lambda>s. \<not>Q \<longrightarrow> P s\<rbrace> whenE Q (throwError e) \<lbrace>\<lambda>rv. P\<rbrace>, -"
+  by (simp add: whenE_def returnOk_def throwError_def return_def validE_R_def validE_def valid_def
+                mres_def)
 
-(* lemma valid_is_triple:
-  "valid P f Q = triple_judgement P f (postcondition Q (\<lambda>s f. fst (f s)))"
+lemma select_throwError_wp:
+  "\<lbrace>\<lambda>s. \<forall>x\<in>S. Q x s\<rbrace> select S >>= throwError -, \<lbrace>Q\<rbrace>"
+  by (clarsimp simp: bind_def throwError_def return_def select_def validE_E_def
+                     validE_def valid_def mres_def)
+
+
+subsection \<open>Setting up the @{method wp} method\<close>
+
+lemma valid_is_triple:
+  "valid P f Q = triple_judgement P f (postcondition Q (\<lambda>s f. mres (f s)))"
   by (simp add: triple_judgement_def valid_def postcondition_def)
- *)
 
 lemma validE_is_triple:
-  "validE P f Q E = triple_judgement P f
-    (postconditions (\<lambda>s f. (\<forall>(r,s') \<in> {(rv, s'). (Inr rv, s') \<in> (mres (f s))}. Q r s'))
-          (\<lambda>s f. (\<forall>(r,s') \<in> {(rv, s'). (Inl rv, s') \<in> (mres (f s))}. E r s')))"
-  apply (simp add: validE_def triple_judgement_def valid_def postcondition_def
-                   postconditions_def split_def split: sum.split)
-  apply (fastforce elim: image_eqI[rotated])
-  done
+  "validE P f Q E =
+   triple_judgement P f
+     (postconditions (postcondition Q (\<lambda>s f. {(rv, s'). (Inr rv, s') \<in> mres (f s)}))
+                     (postcondition E (\<lambda>s f. {(rv, s'). (Inl rv, s') \<in> mres (f s)})))"
+  by (fastforce simp: validE_def triple_judgement_def valid_def postcondition_def postconditions_def
+                split: sum.split)
 
 lemma validE_R_is_triple:
-  "validE_R P f Q = triple_judgement P f
-     (\<lambda>s f. (\<forall>(r,s') \<in> {(rv, s'). (Inr rv, s') \<in> mres (f s)}. Q r s'))"
+  "validE_R P f Q =
+   triple_judgement P f (postcondition Q (\<lambda>s f. {(rv, s'). (Inr rv, s') \<in> mres (f s)}))"
   by (simp add: validE_R_def validE_is_triple postconditions_def postcondition_def)
 
 lemma validE_E_is_triple:
-  "validE_E P f E = triple_judgement P f
-     (\<lambda>s f. (\<forall>(r,s') \<in> {(rv, s'). (Inl rv, s') \<in> mres (f s)}. E r s'))"
+  "validE_E P f E =
+   triple_judgement P f (postcondition E (\<lambda>s f. {(rv, s'). (Inl rv, s') \<in> mres (f s)}))"
   by (simp add: validE_E_def validE_is_triple postconditions_def postcondition_def)
 
-lemmas hoare_wp_combs =
-  hoare_post_comb_imp_conj hoare_vcg_precond_imp hoare_vcg_conj_lift
+lemmas hoare_wp_combs = hoare_vcg_conj_lift
 
 lemmas hoare_wp_combsE =
-  hoare_vcg_precond_impE
-  hoare_vcg_precond_impE_R
   validE_validE_R
   hoare_vcg_R_conj
   hoare_vcg_E_elim
   hoare_vcg_E_conj
 
 lemmas hoare_wp_state_combsE =
-  hoare_vcg_precond_impE[OF valid_validE]
-  hoare_vcg_precond_impE_R[OF valid_validE_R]
   valid_validE_R
   hoare_vcg_R_conj[OF valid_validE_R]
   hoare_vcg_E_elim[OF valid_validE_E]
   hoare_vcg_E_conj[OF valid_validE_E]
 
-lemmas hoare_wp_splits [wp_split] =
+lemmas hoare_classic_wp_combs = hoare_post_comb_imp_conj hoare_vcg_precond_imp hoare_wp_combs
+lemmas hoare_classic_wp_combsE = hoare_vcg_precond_impE hoare_vcg_precond_impE_R hoare_wp_combsE
+
+lemmas hoare_classic_wp_state_combsE =
+  hoare_vcg_precond_impE[OF valid_validE]
+  hoare_vcg_precond_impE_R[OF valid_validE_R]
+  hoare_wp_state_combsE
+
+lemmas all_classic_wp_combs =
+  hoare_classic_wp_state_combsE
+  hoare_classic_wp_combsE
+  hoare_classic_wp_combs
+
+lemmas hoare_wp_splits[wp_split] =
   hoare_seq_ext hoare_vcg_seqE handleE'_wp handleE_wp
   validE_validE_R [OF hoare_vcg_seqE [OF validE_R_validE]]
   validE_validE_R [OF handleE'_wp [OF validE_R_validE]]
   validE_validE_R [OF handleE_wp [OF validE_R_validE]]
-  catch_wp hoare_vcg_split_if hoare_vcg_split_ifE
-  validE_validE_R [OF hoare_vcg_split_ifE [OF validE_R_validE validE_R_validE]]
+  catch_wp hoare_vcg_if_split hoare_vcg_if_splitE
+  validE_validE_R [OF hoare_vcg_if_splitE [OF validE_R_validE validE_R_validE]]
   liftM_wp liftME_wp
   validE_validE_R [OF liftME_wp [OF validE_R_validE]]
   validE_valid
 
 lemmas [wp_comb] = hoare_wp_state_combsE hoare_wp_combsE  hoare_wp_combs
 
+(* rules towards the bottom will be matched first *)
 lemmas [wp] = hoare_vcg_prop
               wp_post_taut
-              return_wp
+              hoare_fun_app_wp
+              returnOk_E
+              liftE_validE_E
               put_wp
               get_wp
               gets_wp
               modify_wp
+              return_wp
               returnOk_wp
               throwError_wp
               fail_wp
               failE_wp
+              assert_wp
+              state_assert_wp
               liftE_wp
+              alternative_wp
+              alternativeE_R_wp
+              alternativeE_E_wp
+              alternativeE_wp
+              select_wp
+              state_select_wp
+              condition_wp
+              conditionE_wp
 
 lemmas [wp_trip] = valid_is_triple validE_is_triple validE_E_is_triple validE_R_is_triple
 
+lemmas validE_E_combs[wp_comb] =
+    hoare_vcg_E_conj[where Q'="\<top>\<top>", folded validE_E_def]
+    valid_validE_E
+    hoare_vcg_E_conj[where Q'="\<top>\<top>", folded validE_E_def, OF valid_validE_E]
+
 
 text \<open>Simplifications on conjunction\<close>
 
-lemma hoare_post_eq: "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
+lemma hoare_post_eq:
+  "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
   by simp
-lemma hoare_post_eqE1: "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+
+lemma hoare_post_eqE1:
+  "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
   by simp
-lemma hoare_post_eqE2: "\<lbrakk> E = E'; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+
+lemma hoare_post_eqE2:
+  "\<lbrakk> E = E'; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
   by simp
-lemma hoare_post_eqE_R: "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
+
+lemma hoare_post_eqE_R:
+  "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
   by simp
 
-lemma pred_conj_apply_elim: "(\<lambda>r. Q r and Q' r) = (\<lambda>r s. Q r s \<and> Q' r s)"
+lemma pred_conj_apply_elim:
+  "(\<lambda>rv. Q rv and Q' rv) = (\<lambda>rv s. Q rv s \<and> Q' rv s)"
   by (simp add: pred_conj_def)
-lemma pred_conj_conj_elim: "(\<lambda>r s. (Q r and Q' r) s \<and> Q'' r s) = (\<lambda>r s. Q r s \<and> Q' r s \<and> Q'' r s)"
+
+lemma pred_conj_conj_elim:
+  "(\<lambda>rv s. (Q rv and Q' rv) s \<and> Q'' rv s) = (\<lambda>rv s. Q rv s \<and> Q' rv s \<and> Q'' rv s)"
   by simp
-lemma conj_assoc_apply: "(\<lambda>r s. (Q r s \<and> Q' r s) \<and> Q'' r s) = (\<lambda>r s. Q r s \<and> Q' r s \<and> Q'' r s)"
+
+lemma conj_assoc_apply:
+  "(\<lambda>rv s. (Q rv s \<and> Q' rv s) \<and> Q'' rv s) = (\<lambda>rv s. Q rv s \<and> Q' rv s \<and> Q'' rv s)"
   by simp
-lemma all_elim: "(\<lambda>rv s. \<forall>x. P rv s) = P"
+
+lemma all_elim:
+  "(\<lambda>rv s. \<forall>x. P rv s) = P"
   by simp
-lemma all_conj_elim: "(\<lambda>rv s. (\<forall>x. P rv s) \<and> Q rv s) = (\<lambda>rv s. P rv s \<and> Q rv s)"
+
+lemma all_conj_elim:
+  "(\<lambda>rv s. (\<forall>x. P rv s) \<and> Q rv s) = (\<lambda>rv s. P rv s \<and> Q rv s)"
   by simp
 
-lemmas vcg_rhs_simps = pred_conj_apply_elim pred_conj_conj_elim
-          conj_assoc_apply all_elim all_conj_elim
+lemmas vcg_rhs_simps =
+  pred_conj_apply_elim pred_conj_conj_elim conj_assoc_apply all_elim all_conj_elim
+
+lemma if_apply_reduct:
+  "\<lbrace>P\<rbrace> If P' (f x) (g x) \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> If P' f g x \<lbrace>Q\<rbrace>"
+  by (cases P'; simp)
+
+lemma if_apply_reductE:
+  "\<lbrace>P\<rbrace> If P' (f x) (g x) \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> If P' f g x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+  by (cases P'; simp)
 
-lemma if_apply_reduct: "\<lbrace>P\<rbrace> If P' (f x) (g x) \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> If P' f g x \<lbrace>Q\<rbrace>"
-  by (cases P', simp_all)
-lemma if_apply_reductE: "\<lbrace>P\<rbrace> If P' (f x) (g x) \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> If P' f g x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  by (cases P', simp_all)
-lemma if_apply_reductE_R: "\<lbrace>P\<rbrace> If P' (f x) (g x) \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> If P' f g x \<lbrace>Q\<rbrace>,-"
-  by (cases P', simp_all)
+lemma if_apply_reductE_R:
+  "\<lbrace>P\<rbrace> If P' (f x) (g x) \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> If P' f g x \<lbrace>Q\<rbrace>,-"
+  by (cases P'; simp)
 
 lemmas hoare_wp_simps [wp_split] =
   vcg_rhs_simps [THEN hoare_post_eq] vcg_rhs_simps [THEN hoare_post_eqE1]
   vcg_rhs_simps [THEN hoare_post_eqE2] vcg_rhs_simps [THEN hoare_post_eqE_R]
   if_apply_reduct if_apply_reductE if_apply_reductE_R TrueI
 
-schematic_goal if_apply_test: "\<lbrace>?Q\<rbrace> (if A then returnOk else K fail) x \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
+schematic_goal if_apply_test:
+  "\<lbrace>?Q\<rbrace> (if A then returnOk else K fail) x \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
   by wpsimp
 
 lemma hoare_elim_pred_conj:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> Q' r s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. Q r and Q' r\<rbrace>"
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q rv and Q' rv\<rbrace>"
   by (unfold pred_conj_def)
 
 lemma hoare_elim_pred_conjE1:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> Q' r s\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. Q r and Q' r\<rbrace>,\<lbrace>E\<rbrace>"
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q rv and Q' rv\<rbrace>,\<lbrace>E\<rbrace>"
   by (unfold pred_conj_def)
 
 lemma hoare_elim_pred_conjE2:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>\<lambda>x s. E x s \<and> E' x s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>x. E x and E' x\<rbrace>"
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>\<lambda>rv s. E rv s \<and> E' rv s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>rv. E rv and E' rv\<rbrace>"
   by (unfold pred_conj_def)
 
 lemma hoare_elim_pred_conjE_R:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> Q' r s\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. Q r and Q' r\<rbrace>,-"
+  "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q rv and Q' rv\<rbrace>,-"
   by (unfold pred_conj_def)
 
 lemmas hoare_wp_pred_conj_elims =
   hoare_elim_pred_conj hoare_elim_pred_conjE1
   hoare_elim_pred_conjE2 hoare_elim_pred_conjE_R
 
-lemmas hoare_weaken_preE = hoare_vcg_precond_impE
-
-lemmas hoare_pre [wp_pre] =
-  hoare_weaken_pre
-  hoare_weaken_preE
-  hoare_vcg_precond_impE_R
-  hoare_weaken_preE_E
-
-declare no_fail_pre [wp_pre]
-
-bundle no_pre = hoare_pre [wp_pre del] no_fail_pre [wp_pre del]
 
 text \<open>Miscellaneous lemmas on hoare triples\<close>
 
 lemma hoare_vcg_mp:
-  assumes a: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
-  assumes b: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<longrightarrow> Q' r s\<rbrace>"
-  shows "\<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>"
-  using assms
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<longrightarrow> Q' r s\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>"
   by (auto simp: valid_def split_def)
 
 (* note about this precond stuff: rules get a chance to bind directly
    before any of their combined forms. As a result, these precondition
    implication rules are only used when needed. *)
-
 lemma hoare_add_post:
-  assumes r: "\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>"
-  assumes impP: "\<And>s. P s \<Longrightarrow> P' s"
-  assumes impQ: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q' rv s \<longrightarrow> Q rv s\<rbrace>"
-  shows "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
-  apply (rule hoare_chain)
-    apply (rule hoare_vcg_conj_lift)
-     apply (rule r)
-    apply (rule impQ)
-   apply simp
-   apply (erule impP)
-  apply simp
-  done
-
-lemma whenE_wp:
-  "(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>"
-  unfolding whenE_def by clarsimp wp
+  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>; \<And>s. P s \<Longrightarrow> P' s; \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q' rv s \<longrightarrow> Q rv s\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
+  unfolding valid_def
+  by fastforce
 
 lemma hoare_gen_asmE:
   "(P \<Longrightarrow> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>,-) \<Longrightarrow> \<lbrace>P' and K P\<rbrace> f \<lbrace>Q\<rbrace>, -"
   by (simp add: validE_R_def validE_def valid_def) blast
 
 lemma hoare_list_case:
-  assumes P1: "\<lbrace>P1\<rbrace> f f1 \<lbrace>Q\<rbrace>"
-  assumes P2: "\<And>y ys. xs = y#ys \<Longrightarrow> \<lbrace>P2 y ys\<rbrace> f (f2 y ys) \<lbrace>Q\<rbrace>"
-  shows "\<lbrace>case xs of [] \<Rightarrow> P1 | y#ys \<Rightarrow> P2 y ys\<rbrace>
-         f (case xs of [] \<Rightarrow> f1 | y#ys \<Rightarrow> f2 y ys)
-         \<lbrace>Q\<rbrace>"
-  apply (cases xs; simp)
-   apply (rule P1)
-  apply (rule P2)
-  apply simp
-  done
-
-lemma unless_wp:
-  "(\<not>P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>) \<Longrightarrow> \<lbrace>if P then R () else Q\<rbrace> unless P f \<lbrace>R\<rbrace>"
-  unfolding unless_def by wp auto
+  "\<lbrakk> \<lbrace>P1\<rbrace> f f1 \<lbrace>Q\<rbrace>; \<And>y ys. xs = y#ys \<Longrightarrow> \<lbrace>P2 y ys\<rbrace> f (f2 y ys) \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow>
+   \<lbrace>case xs of [] \<Rightarrow> P1 | y#ys \<Rightarrow> P2 y ys\<rbrace> f (case xs of [] \<Rightarrow> f1 | y#ys \<Rightarrow> f2 y ys) \<lbrace>Q\<rbrace>"
+  by (cases xs; simp)
 
 lemma hoare_use_eq:
-  assumes x: "\<And>P. \<lbrace>\<lambda>s. P (f s)\<rbrace> m \<lbrace>\<lambda>rv s. P (f s)\<rbrace>"
-  assumes y: "\<And>f. \<lbrace>\<lambda>s. P f s\<rbrace> m \<lbrace>\<lambda>rv s. Q f s\<rbrace>"
-  shows "\<lbrace>\<lambda>s. P (f s) s\<rbrace> m \<lbrace>\<lambda>rv s. Q (f s :: 'c :: type) s \<rbrace>"
-  apply (rule_tac Q="\<lambda>rv s. \<exists>f'. f' = f s \<and> Q f' s" in hoare_post_imp)
-   apply simp
-  apply (wpsimp wp: hoare_vcg_ex_lift x y)
+  assumes "\<And>P. \<lbrace>\<lambda>s. P (f s)\<rbrace> m \<lbrace>\<lambda>_ s. P (f s)\<rbrace>"
+  assumes "\<And>f. \<lbrace>\<lambda>s. P f s\<rbrace> m \<lbrace>\<lambda>_ s. Q f s\<rbrace>"
+  shows "\<lbrace>\<lambda>s. P (f s) s\<rbrace> m \<lbrace>\<lambda>_ s. Q (f s) s \<rbrace>"
+  apply (rule hoare_post_imp[where Q="\<lambda>_ s. \<exists>y. y = f s \<and> Q y s"], simp)
+  apply (wpsimp wp: hoare_vcg_ex_lift assms)
   done
 
-lemma hoare_return_sp:
-  "\<lbrace>P\<rbrace> return x \<lbrace>\<lambda>r. P and K (r = x)\<rbrace>"
-  by (simp add: valid_def return_def mres_def)
-
-lemma hoare_fail_any [simp]:
-  "\<lbrace>P\<rbrace> fail \<lbrace>Q\<rbrace>" by wp
+lemma hoare_fail_any[simp]:
+  "\<lbrace>P\<rbrace> fail \<lbrace>Q\<rbrace>"
+  by wp
 
-lemma hoare_failE [simp]: "\<lbrace>P\<rbrace> fail \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>" by  wp
+lemma hoare_failE[simp]:
+  "\<lbrace>P\<rbrace> fail \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>"
+  by wp
 
-lemma hoare_FalseE [simp]:
-  "\<lbrace>\<lambda>s. False\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
+lemma hoare_FalseE[simp]:
+  "\<lbrace>\<bottom>\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>"
   by (simp add: valid_def validE_def)
 
-lemma hoare_K_bind [wp]:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> K_bind f x \<lbrace>Q\<rbrace>"
-  by simp
-
-text \<open>Setting up the precondition case splitter.\<close>
-
-lemma wpc_helper_valid:
-  "\<lbrace>Q\<rbrace> g \<lbrace>S\<rbrace> \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> g \<lbrace>S\<rbrace>"
-  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
-
-lemma wpc_helper_validE:
-  "\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>"
-  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
-
-lemma wpc_helper_validE_R:
-  "\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,- \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>,-"
-  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
-
-lemma wpc_helper_validR_R:
-  "\<lbrace>Q\<rbrace> f -,\<lbrace>E\<rbrace> \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> f -,\<lbrace>E\<rbrace>"
-  by (clarsimp simp: wpc_helper_def elim!: hoare_pre)
-
-lemma wpc_helper_no_fail_final:
-  "no_fail Q f \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') (no_fail P f)"
-  by (clarsimp simp: wpc_helper_def elim!: no_fail_pre)
-
-lemma wpc_helper_validNF:
-  "\<lbrace>Q\<rbrace> g \<lbrace>S\<rbrace>! \<Longrightarrow> wpc_helper (P, P', P'') (Q, Q', Q'') \<lbrace>P\<rbrace> g \<lbrace>S\<rbrace>!"
-  apply (clarsimp simp: wpc_helper_def)
-  by (metis hoare_wp_combs(2) no_fail_pre validNF_def)
-
-(* FIXME: this needs adjustment, case_prod Q is unlikely to unify *)
-lemma wpc_helper_validI:
-  "(\<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>) \<Longrightarrow> wpc_helper (P, P', P'') (case_prod Q, Q', Q'') (\<lbrace>curry P\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>)"
-  by (clarsimp simp: wpc_helper_def elim!: validI_weaken_pre)
-
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>" wpc_helper_valid
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>" wpc_helper_validE
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>,-" wpc_helper_validE_R
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m -,\<lbrace>E\<rbrace>" wpc_helper_validR_R
-wpc_setup "\<lambda>m. no_fail P m" wpc_helper_no_fail_final
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>!" wpc_helper_validNF
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> m \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>" wpc_helper_validI
-
-lemma in_liftM:
- "((r, s') \<in> mres (liftM t f s)) = (\<exists>r'. (r', s') \<in> mres (f s) \<and> r = t r')"
-  by (simp add: liftM_def in_return in_bind)
-
-lemma hoare_fun_app_wp[wp]:
-  "\<lbrace>P\<rbrace> f' x \<lbrace>Q'\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f' $ x \<lbrace>Q'\<rbrace>"
-  "\<lbrace>P\<rbrace> f x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f $ x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  "\<lbrace>P\<rbrace> f x \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f $ x \<lbrace>Q\<rbrace>,-"
-  "\<lbrace>P\<rbrace> f x -,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f $ x -,\<lbrace>E\<rbrace>"
-  by simp+
-
 lemma hoare_validE_pred_conj:
-  "\<lbrakk> \<lbrace>P\<rbrace>f\<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<lbrace>P\<rbrace>f\<lbrace>R\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace>f\<lbrace>Q and R\<rbrace>,\<lbrace>E\<rbrace>"
-  unfolding valid_def validE_def by (simp add: split_def split: sum.splits)
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q and R\<rbrace>, \<lbrace>E\<rbrace>"
+  unfolding valid_def validE_def
+  by (simp add: split_def split: sum.splits)
 
 lemma hoare_validE_conj:
-  "\<lbrakk> \<lbrace>P\<rbrace>f\<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<lbrace>P\<rbrace>f\<lbrace>R\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> R r s\<rbrace>,\<lbrace>E\<rbrace>"
-  unfolding valid_def validE_def by (simp add: split_def split: sum.splits)
-
-lemma hoare_valid_validE:
-  "\<lbrace>P\<rbrace>f\<lbrace>\<lambda>r. Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace>f\<lbrace>\<lambda>r. Q\<rbrace>,\<lbrace>\<lambda>r. Q\<rbrace>"
-  unfolding valid_def validE_def by (simp add: split_def split: sum.splits)
-
-lemma liftE_validE_E [wp]:
-  "\<lbrace>\<top>\<rbrace> liftE f -, \<lbrace>Q\<rbrace>"
-  by (clarsimp simp: validE_E_def valid_def)
-
-lemma validE_validE_E [wp_comb]:
-  "\<lbrace>P\<rbrace> f \<lbrace>\<top>\<top>\<rbrace>, \<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -, \<lbrace>E\<rbrace>"
-  by (simp add: validE_E_def)
+  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> R rv s\<rbrace>, \<lbrace>E\<rbrace>"
+  unfolding valid_def validE_def
+  by (simp add: split_def split: sum.splits)
 
-lemma validE_E_validE:
-  "\<lbrace>P\<rbrace> f -, \<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<top>\<top>\<rbrace>, \<lbrace>E\<rbrace>"
-  by (simp add: validE_E_def)
+lemmas hoare_valid_validE = valid_validE (* FIXME lib: eliminate one *)
 
-(*
- * if_validE_E:
- *
- * \<lbrakk>?P1 \<Longrightarrow> \<lbrace>?Q1\<rbrace> ?f1 -, \<lbrace>?E\<rbrace>; \<not> ?P1 \<Longrightarrow> \<lbrace>?R1\<rbrace> ?g1 -, \<lbrace>?E\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. (?P1 \<longrightarrow> ?Q1 s) \<and> (\<not> ?P1 \<longrightarrow> ?R1 s)\<rbrace> if ?P1 then ?f1 else ?g1 -, \<lbrace>?E\<rbrace>
- *)
-lemmas if_validE_E [wp_split] =
-  validE_validE_E [OF hoare_vcg_split_ifE [OF validE_E_validE validE_E_validE]]
+declare validE_validE_E[wp_comb]
 
-lemma returnOk_E [wp]:
-  "\<lbrace>\<top>\<rbrace> returnOk r -, \<lbrace>Q\<rbrace>"
-  by (simp add: validE_E_def) wp
+lemmas if_validE_E[wp_split] =
+  validE_validE_E[OF hoare_vcg_if_splitE[OF validE_E_validE validE_E_validE]]
 
 lemma hoare_drop_imp:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. R r s \<longrightarrow> Q r s\<rbrace>"
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. R rv s \<longrightarrow> Q rv s\<rbrace>"
   by (auto simp: valid_def)
 
 lemma hoare_drop_impE:
-  "\<lbrakk>\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. Q\<rbrace>, \<lbrace>E\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. R r s \<longrightarrow> Q s\<rbrace>, \<lbrace>E\<rbrace>"
+  "\<lbrakk>\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. Q\<rbrace>, \<lbrace>E\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. R rv s \<longrightarrow> Q s\<rbrace>, \<lbrace>E\<rbrace>"
   by (simp add: validE_weaken)
 
 lemma hoare_drop_impE_R:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. R r s \<longrightarrow> Q r s\<rbrace>, -"
+  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. R rv s \<longrightarrow> Q rv s\<rbrace>, -"
   by (auto simp: validE_R_def validE_def valid_def split_def split: sum.splits)
 
 lemma hoare_drop_impE_E:
-  "\<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -,\<lbrace>\<lambda>r s. R r s \<longrightarrow> Q r s\<rbrace>"
+  "\<lbrace>P\<rbrace> f -,\<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f -, \<lbrace>\<lambda>rv s. R rv s \<longrightarrow> Q rv s\<rbrace>"
   by (auto simp: validE_E_def validE_def valid_def split_def split: sum.splits)
 
 lemmas hoare_drop_imps = hoare_drop_imp hoare_drop_impE_R hoare_drop_impE_E
-lemma mres_union:
- "mres (a \<union> b) = mres a \<union> mres b"
-  by (simp add: mres_def image_Un)
 
-lemma mres_Failed_empty:
-  "mres ((\<lambda>xs. (xs, Failed)) ` X ) = {}"
-  "mres ((\<lambda>xs. (xs, Incomplete)) ` X ) = {}"
-  by (auto simp add: mres_def image_def)
+lemmas bindE_E_wp[wp_split] = validE_validE_E[OF hoare_vcg_seqE [OF validE_E_validE]]
 
-lemma det_set_option_eq:
-  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
-       (ts, Some (rr, ss)) \<in> m \<Longrightarrow> rr = r \<and> ss = s'"
-  by (metis UN_I option.set_intros prod.inject singleton_iff snd_conv)
+lemma True_E_E[wp]:
+  "\<lbrace>\<top>\<rbrace> f -,\<lbrace>\<top>\<top>\<rbrace>"
+  by (auto simp: validE_E_def validE_def valid_def split: sum.splits)
 
-lemma det_set_option_eq':
-  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
-       Some (r, s') \<in> snd ` m"
-  using image_iff by fastforce
 
-lemma bind_det_exec:
-  "mres (a s) = {(r,s')} \<Longrightarrow> mres ((a >>= b) s) = mres (b r s')"
-  by (simp add: in_bind set_eq_iff)
+subsection \<open>Strongest postcondition rules\<close>
 
-lemma in_bind_det_exec:
-  "mres (a s) = {(r,s')} \<Longrightarrow> (s'' \<in> mres ((a >>= b) s)) = (s'' \<in> mres (b r s'))"
-  by (cases s'', simp add: in_bind)
+lemma get_sp:
+  "\<lbrace>P\<rbrace> get \<lbrace>\<lambda>rv s. s = rv \<and> P s\<rbrace>"
+  by(simp add:get_def valid_def mres_def)
 
-lemma exec_put:
-  "(put s' >>= m) s = m () s'"
-  by (auto simp add: bind_def put_def mres_def split_def)
+lemma put_sp:
+  "\<lbrace>\<top>\<rbrace> put a \<lbrace>\<lambda>_ s. s = a\<rbrace>"
+  by(simp add:put_def valid_def mres_def)
 
-lemma bind_execI:
-  "\<lbrakk> (r'',s'') \<in> mres (f s); \<exists>x \<in> mres (g r'' s''). P x \<rbrakk> \<Longrightarrow>
-  \<exists>x \<in> mres ((f >>= g) s). P x"
-  by (fastforce simp add: Bex_def in_bind)
+lemma return_sp:
+  "\<lbrace>P\<rbrace> return a \<lbrace>\<lambda>rv s. rv = a \<and> P s\<rbrace>"
+  by(simp add:return_def valid_def mres_def)
 
-lemma True_E_E [wp]: "\<lbrace>\<top>\<rbrace> f -,\<lbrace>\<top>\<top>\<rbrace>"
-  by (auto simp: validE_E_def validE_def valid_def split: sum.splits)
+lemma hoare_return_sp: (* FIXME lib: eliminate *)
+  "\<lbrace>P\<rbrace> return x \<lbrace>\<lambda>rv. P and K (rv = x)\<rbrace>"
+  by (simp add: valid_def return_def mres_def)
 
-(*
- * \<lbrakk>\<And>x. \<lbrace>?B1 x\<rbrace> ?g1 x -, \<lbrace>?E\<rbrace>; \<lbrace>?P\<rbrace> ?f1 \<lbrace>?B1\<rbrace>, \<lbrace>?E\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>?P\<rbrace> ?f1 >>=E ?g1 -, \<lbrace>?E\<rbrace>
- *)
-lemmas [wp_split] =
-  validE_validE_E [OF hoare_vcg_seqE [OF validE_E_validE]]
+lemma assert_sp:
+  "\<lbrace>P\<rbrace> assert Q \<lbrace>\<lambda>_ s. P s \<and> Q \<rbrace>"
+  by (simp add: assert_def fail_def return_def valid_def mres_def)
 
-lemma case_option_wp:
-  assumes x: "\<And>x. \<lbrace>P x\<rbrace> m x \<lbrace>Q\<rbrace>"
-  assumes y: "\<lbrace>P'\<rbrace> m' \<lbrace>Q\<rbrace>"
-  shows      "\<lbrace>\<lambda>s. (x = None \<longrightarrow> P' s) \<and> (x \<noteq> None \<longrightarrow> P (the x) s)\<rbrace>
-                case_option m' m x \<lbrace>Q\<rbrace>"
-  apply (cases x; simp)
-   apply (rule y)
-  apply (rule x)
-  done
+lemma hoare_gets_sp:
+  "\<lbrace>P\<rbrace> gets f \<lbrace>\<lambda>rv s. rv = f s \<and> P s\<rbrace>"
+  by (simp add: valid_def simpler_gets_def mres_def)
 
-lemma case_option_wpE:
-  assumes x: "\<And>x. \<lbrace>P x\<rbrace> m x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  assumes y: "\<lbrace>P'\<rbrace> m' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  shows      "\<lbrace>\<lambda>s. (x = None \<longrightarrow> P' s) \<and> (x \<noteq> None \<longrightarrow> P (the x) s)\<rbrace>
-                case_option m' m x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
-  apply (cases x; simp)
-   apply (rule y)
-  apply (rule x)
+lemma hoare_returnOk_sp:
+  "\<lbrace>P\<rbrace> returnOk x \<lbrace>\<lambda>rv s. rv = x \<and> P s\<rbrace>, \<lbrace>Q\<rbrace>"
+  by (simp add: valid_def validE_def returnOk_def return_def mres_def)
+
+
+
+
+lemma trace_steps_append:
+  "trace_steps (xs @ ys) s
+    = trace_steps xs s \<union> trace_steps ys (last_st_tr (rev xs) s)"
+  by (induct xs arbitrary: s, simp_all add: last_st_tr_def hd_append)
+
+lemma rely_cond_append:
+  "rely_cond R s (xs @ ys) = (rely_cond R s ys \<and> rely_cond R (last_st_tr ys s) xs)"
+  by (simp add: rely_cond_def trace_steps_append ball_Un conj_comms)
+
+lemma guar_cond_append:
+  "guar_cond G s (xs @ ys) = (guar_cond G s ys \<and> guar_cond G (last_st_tr ys s) xs)"
+  by (simp add: guar_cond_def trace_steps_append ball_Un conj_comms)
+
+lemma prefix_closed_bind:
+  "prefix_closed f \<Longrightarrow> (\<forall>x. prefix_closed (g x)) \<Longrightarrow> prefix_closed (f >>= g)"
+  apply (subst prefix_closed_def, clarsimp simp: bind_def)
+  apply (auto simp: Cons_eq_append_conv split: tmres.split_asm
+             dest!: prefix_closedD[rotated];
+    fastforce elim: rev_bexI)
   done
 
-lemma in_bindE:
-  "(rv, s') \<in> mres ((f >>=E (\<lambda>rv'. g rv')) s) =
-  ((\<exists>ex. rv = Inl ex \<and> (Inl ex, s') \<in> mres (f s)) \<or>
-  (\<exists>rv' s''. (rv, s') \<in> mres (g rv' s'') \<and> (Inr rv', s'') \<in> mres (f s)))"
-  apply (clarsimp simp: bindE_def in_bind lift_def in_throwError)
-  apply (safe del: disjCI; strengthen subst[where P="\<lambda>x. x \<in> mres (f s)", mk_strg I _ E];
-    auto simp: in_throwError split: sum.splits)
+lemmas prefix_closed_bind[rule_format, wp_split]
+
+lemma last_st_tr_append[simp]:
+  "last_st_tr (tr @ tr') s = last_st_tr tr (last_st_tr tr' s)"
+  by (simp add: last_st_tr_def hd_append)
+
+lemma last_st_tr_Nil[simp]:
+  "last_st_tr [] s = s"
+  by (simp add: last_st_tr_def)
+
+lemma last_st_tr_Cons[simp]:
+  "last_st_tr (x # xs) s = snd x"
+  by (simp add: last_st_tr_def)
+
+lemma bind_twp[wp_split]:
+  "\<lbrakk>  \<And>r. \<lbrace>Q' r\<rbrace>,\<lbrace>R\<rbrace> g r \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f >>= (\<lambda>r. g r) \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (subst validI_def, rule conjI)
+   apply (blast intro: prefix_closed_bind validI_prefix_closed)
+  apply (clarsimp simp: bind_def rely_def)
+  apply (drule(2) validI_D)
+   apply (clarsimp simp: rely_cond_append split: tmres.split_asm)
+  apply (clarsimp split: tmres.split_asm)
+  apply (drule meta_spec, frule(2) validI_D)
+   apply (clarsimp simp: rely_cond_append split: if_split_asm)
+  apply (clarsimp simp: guar_cond_append)
   done
 
-(*
- * \<lbrace>?P\<rbrace> ?m1 -, \<lbrace>?E\<rbrace> \<Longrightarrow> \<lbrace>?P\<rbrace> liftME ?f1 ?m1 -, \<lbrace>?E\<rbrace>
- *)
-lemmas [wp_split] = validE_validE_E [OF liftME_wp, simplified, OF validE_E_validE]
+lemma trace_steps_rev_drop_nth:
+  "trace_steps (rev (drop n tr)) s
+        = (\<lambda>i. (fst (rev tr ! i), (if i = 0 then s else snd (rev tr ! (i - 1))),
+            snd (rev tr ! i))) ` {..< length tr - n}"
+  apply (simp add: trace_steps_nth)
+  apply (intro image_cong refl)
+  apply (simp add: rev_nth)
+  done
 
-lemma assert_A_True[simp]: "assert True = return ()"
-  by (simp add: assert_def)
+lemma prefix_closed_drop:
+  "(tr, res) \<in> f s \<Longrightarrow> prefix_closed f \<Longrightarrow> \<exists>res'. (drop n tr, res') \<in> f s"
+proof (induct n arbitrary: res)
+  case 0 then show ?case by auto
+next
+  case (Suc n)
+  have drop_1: "\<And>tr res. (tr, res) \<in> f s \<Longrightarrow> \<exists>res'. (drop 1 tr, res') \<in> f s"
+    by (case_tac tr; fastforce dest: prefix_closedD[rotated] intro: Suc)
+  show ?case
+    using Suc.hyps[OF Suc.prems]
+    by (metis drop_1[simplified] drop_drop add_0 add_Suc)
+qed
 
-lemma assert_wp [wp]: "\<lbrace>\<lambda>s. P \<longrightarrow> Q () s\<rbrace> assert P \<lbrace>Q\<rbrace>"
-  by (cases P, (simp add: assert_def | wp)+)
+lemma validI_GD_drop:
+  "\<lbrakk> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>; P s0 s; (tr, res) \<in> f s;
+        rely_cond R s0 (drop n tr) \<rbrakk>
+    \<Longrightarrow> guar_cond G s0 (drop n tr)"
+  apply (drule prefix_closed_drop[where n=n], erule validI_prefix_closed)
+  apply (auto dest: validI_GD)
+  done
 
-lemma list_cases_wp:
-  assumes a: "\<lbrace>P_A\<rbrace> a \<lbrace>Q\<rbrace>"
-  assumes b: "\<And>x xs. ts = x#xs \<Longrightarrow> \<lbrace>P_B x xs\<rbrace> b x xs \<lbrace>Q\<rbrace>"
-  shows "\<lbrace>case_list P_A P_B ts\<rbrace> case ts of [] \<Rightarrow> a | x # xs \<Rightarrow> b x xs \<lbrace>Q\<rbrace>"
-  by (cases ts, auto simp: a b)
+lemma parallel_prefix_closed[wp_split]:
+  "prefix_closed f \<Longrightarrow> prefix_closed g
+    \<Longrightarrow> prefix_closed (parallel f g)"
+  apply (subst prefix_closed_def, clarsimp simp: parallel_def)
+  apply (case_tac f_steps; clarsimp)
+  apply (drule(1) prefix_closedD)+
+  apply fastforce
+  done
 
-(* FIXME: make wp *)
-lemma whenE_throwError_wp:
-  "\<lbrace>\<lambda>s. \<not>Q \<longrightarrow> P s\<rbrace> whenE Q (throwError e) \<lbrace>\<lambda>rv. P\<rbrace>, -"
-  unfolding whenE_def by wp blast
+lemma rely_cond_drop:
+  "rely_cond R s0 xs \<Longrightarrow> rely_cond R s0 (drop n xs)"
+  using rely_cond_append[where xs="take n xs" and ys="drop n xs"]
+  by simp
 
-lemma select_throwError_wp:
-  "\<lbrace>\<lambda>s. \<forall>x\<in>S. Q x s\<rbrace> select S >>= throwError -, \<lbrace>Q\<rbrace>"
-  by (clarsimp simp add: bind_def throwError_def return_def select_def validE_E_def
-                validE_def valid_def mres_def)
+lemma rely_cond_is_drop:
+  "rely_cond R s0 xs
+    \<Longrightarrow> (ys = drop (length xs - length ys) xs)
+    \<Longrightarrow> rely_cond R s0 ys"
+  by (metis rely_cond_drop)
 
+lemma bounded_rev_nat_induct:
+  "(\<And>n. N \<le> n \<Longrightarrow> P n) \<Longrightarrow> (\<And>n. n < N \<Longrightarrow> P (Suc n) \<Longrightarrow> P n)
+    \<Longrightarrow> P n"
+  by (induct diff\<equiv>"N - n" arbitrary: n; simp)
 
-section "validNF Rules"
+lemma drop_n_induct:
+  "P [] \<Longrightarrow> (\<And>n. n < length xs \<Longrightarrow> P (drop (Suc n) xs) \<Longrightarrow> P (drop n xs))
+    \<Longrightarrow> P (drop n xs)"
+  by (induct len\<equiv>"length (drop n xs)" arbitrary: n xs; simp)
 
-subsection "Basic validNF theorems"
+lemma guar_cond_Cons_eq:
+  "guar_cond R s0 (x # xs)
+        = (guar_cond R s0 xs \<and> (fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
+  by (cases "fst x"; simp add: guar_cond_def trace_steps_append conj_comms)
 
-lemma validNF [intro?]:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>; no_fail P f \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!"
-  by (clarsimp simp: validNF_def)
+lemma guar_cond_Cons:
+  "guar_cond R s0 xs
+    \<Longrightarrow> fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
+    \<Longrightarrow> guar_cond R s0 (x # xs)"
+  by (simp add: guar_cond_Cons_eq)
 
-lemma validNF_valid: "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>"
-  by (clarsimp simp: validNF_def)
+lemma guar_cond_drop_Suc_eq:
+  "n < length xs
+    \<Longrightarrow> guar_cond R s0 (drop n xs) = (guar_cond R s0 (drop (Suc n) xs)
+        \<and> (fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
+  apply (rule trans[OF _ guar_cond_Cons_eq])
+  apply (simp add: Cons_nth_drop_Suc)
+  done
 
-lemma validNF_no_fail: "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>! \<rbrakk> \<Longrightarrow> no_fail P f"
-  by (clarsimp simp: validNF_def)
+lemma guar_cond_drop_Suc:
+  "guar_cond R s0 (drop (Suc n) xs)
+    \<Longrightarrow> fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
+    \<Longrightarrow> guar_cond R s0 (drop n xs)"
+  by (case_tac "n < length xs"; simp add: guar_cond_drop_Suc_eq)
 
-lemma snd_validNF:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!; P s \<rbrakk> \<Longrightarrow> Failed \<notin> snd ` (f s)"
-  by (clarsimp simp: validNF_def no_fail_def)
+lemma rely_cond_Cons_eq:
+  "rely_cond R s0 (x # xs)
+        = (rely_cond R s0 xs \<and> (fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
+  by (simp add: rely_cond_def trace_steps_append conj_comms)
 
-lemma use_validNF:
-  "\<lbrakk> (r', s') \<in> mres (f s); \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!; P s \<rbrakk> \<Longrightarrow> Q r' s'"
-  by (fastforce simp: validNF_def valid_def)
+lemma rely_cond_Cons:
+  "rely_cond R s0 xs
+    \<Longrightarrow> fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
+    \<Longrightarrow> rely_cond R s0 (x # xs)"
+  by (simp add: rely_cond_Cons_eq)
 
-subsection "validNF weakest pre-condition rules"
+lemma rely_cond_drop_Suc_eq:
+  "n < length xs
+    \<Longrightarrow> rely_cond R s0 (drop n xs) = (rely_cond R s0 (drop (Suc n) xs)
+        \<and> (fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
+  apply (rule trans[OF _ rely_cond_Cons_eq])
+  apply (simp add: Cons_nth_drop_Suc)
+  done
 
-lemma validNF_return [wp]:
-  "\<lbrace> P x \<rbrace> return x \<lbrace> P \<rbrace>!"
-  by (wp validNF)+
+lemma rely_cond_drop_Suc:
+  "rely_cond R s0 (drop (Suc n) xs)
+    \<Longrightarrow> fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
+    \<Longrightarrow> rely_cond R s0 (drop n xs)"
+  by (cases "n < length xs"; simp add: rely_cond_drop_Suc_eq)
 
-lemma validNF_get [wp]:
-  "\<lbrace> \<lambda>s. P s s  \<rbrace> get \<lbrace> P \<rbrace>!"
-  by (wp validNF)+
+lemma last_st_tr_map_zip_hd:
+  "length flags = length tr
+    \<Longrightarrow> tr \<noteq> [] \<longrightarrow> snd (f (hd flags, hd tr)) = snd (hd tr)
+    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
+  apply (cases tr; simp)
+  apply (cases flags; simp)
+  apply (simp add: fun_eq_iff)
+  done
 
-lemma validNF_put [wp]:
-  "\<lbrace> \<lambda>s. P () x  \<rbrace> put x \<lbrace> P \<rbrace>!"
-  by (wp validNF)+
+lemma last_st_tr_drop_map_zip_hd:
+  "length flags = length tr
+    \<Longrightarrow> n < length tr \<longrightarrow> snd (f (flags ! n, tr ! n)) = snd (tr ! n)
+    \<Longrightarrow> last_st_tr (drop n (map f (zip flags tr))) = last_st_tr (drop n tr)"
+  apply (simp add: drop_map drop_zip)
+  apply (rule last_st_tr_map_zip_hd; clarsimp)
+  apply (simp add: hd_drop_conv_nth)
+  done
 
-lemma validNF_K_bind [wp]:
-  "\<lbrace> P \<rbrace> x \<lbrace> Q \<rbrace>! \<Longrightarrow> \<lbrace> P \<rbrace> K_bind x f \<lbrace> Q \<rbrace>!"
-  by simp
+lemma last_st_tr_map_zip:
+  "length flags = length tr
+    \<Longrightarrow> \<forall>fl tmid s. snd (f (fl, (tmid, s))) = s
+    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
+  apply (erule last_st_tr_map_zip_hd)
+  apply (clarsimp simp: neq_Nil_conv)
+  done
 
-lemma validNF_fail [wp]:
-  "\<lbrace> \<lambda>s. False \<rbrace> fail \<lbrace> Q \<rbrace>!"
-  by (clarsimp simp: validNF_def fail_def no_fail_def)
+lemma parallel_rely_induct:
+  assumes preds: "(tr, v) \<in> parallel f g s" "Pf s0 s" "Pg s0 s"
+  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f' \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
+     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g' \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
+     "f s \<subseteq> f' s" "g s \<subseteq> g' s"
+  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
+     "Gf \<le> Rg" "Gg \<le> Rf"
+  and rely: "rely_cond R s0 (drop n tr)"
+  shows "\<exists>tr_f tr_g. (tr_f, v) \<in> f s \<and> (tr_g, v) \<in> g s
+      \<and> rely_cond Rf s0 (drop n tr_f) \<and> rely_cond Rg s0 (drop n tr_g)
+      \<and> map snd tr_f = map snd tr \<and> map snd tr_g = map snd tr
+      \<and> (\<forall>i \<le> length tr. last_st_tr (drop i tr_g) s0 = last_st_tr (drop i tr_f) s0)
+      \<and> guar_cond G s0 (drop n tr)"
+  (is "\<exists>ys zs. _ \<and> _ \<and> ?concl ys zs")
+proof -
+  obtain ys zs where tr: "tr = map parallel_mrg (zip ys zs)"
+      and all2: "list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs"
+      and ys: "(ys, v) \<in> f s" and zs: "(zs, v) \<in> g s"
+    using preds
+    by (clarsimp simp: parallel_def2)
+  note len[simp] = list_all2_lengthD[OF all2]
 
-lemma validNF_prop [wp_unsafe]:
-  "\<lbrakk> no_fail (\<lambda>s. P) f \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s. P \<rbrace> f \<lbrace> \<lambda>rv s. P \<rbrace>!"
-  by (wp validNF)+
+  have ys': "(ys, v) \<in> f' s" and zs': "(zs, v) \<in> g' s"
+    using ys zs validI by auto
 
-lemma validNF_post_conj [intro!]:
-  "\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> Q \<rbrace>!; \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> a \<lbrace> Q and R \<rbrace>!"
-  by (clarsimp simp: validNF_def)
+  note rely_f_step = validI_GD_drop[OF validI(1) preds(2) ys' rely_cond_drop_Suc]
+  note rely_g_step = validI_GD_drop[OF validI(2) preds(3) zs' rely_cond_drop_Suc]
 
-lemma no_fail_or:
-  "\<lbrakk>no_fail P a; no_fail Q a\<rbrakk> \<Longrightarrow> no_fail (P or Q) a"
-  by (clarsimp simp: no_fail_def)
+  note snd[simp] = list_all2_nthD[OF all2, THEN conjunct2]
 
-lemma validNF_pre_disj [intro!]:
-  "\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>!; \<lbrace> Q \<rbrace> a \<lbrace> R \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P or Q \<rbrace> a \<lbrace> R \<rbrace>!"
-  by (rule validNF) (auto dest: validNF_valid validNF_no_fail intro: no_fail_or)
+  have "?concl ys zs"
+    using rely tr all2 rely_f_step rely_g_step
+    apply (induct n rule: bounded_rev_nat_induct)
+     apply (subst drop_all, assumption)
+     apply clarsimp
+     apply (simp add: list_all2_conv_all_nth last_st_tr_def drop_map[symmetric]
+                      hd_drop_conv_nth hd_append)
+     apply (fastforce simp: split_def intro!: nth_equalityI)
+     apply clarsimp
+    apply (erule_tac x=n in meta_allE)+
+    apply (drule meta_mp, erule rely_cond_is_drop, simp)
+    apply (subst(asm) rely_cond_drop_Suc_eq[where xs="map f xs" for f xs], simp)
+    apply (clarsimp simp: last_st_tr_drop_map_zip_hd if_split[where P="\<lambda>x. x = Env"]
+                          split_def)
+    apply (intro conjI; (rule guar_cond_drop_Suc rely_cond_drop_Suc, assumption))
+      apply (auto simp: guar_cond_drop_Suc_eq last_st_tr_drop_map_zip_hd
+                 intro: compat[THEN predicate2D])
+    done
 
-(*
- * Set up combination rules for WP, which also requires
- * a "wp_trip" rule for validNF.
- *)
+  thus ?thesis
+    using ys zs
+    by auto
+qed
 
-definition "validNF_property Q s b \<equiv> Failed \<notin> snd ` (b s) \<and> (\<forall>(r', s') \<in> mres (b s). Q r' s')"
+lemmas parallel_rely_induct0 = parallel_rely_induct[where n=0, simplified]
 
-lemma validNF_is_triple [wp_trip]:
-  "validNF P f Q = triple_judgement P f (validNF_property Q)"
-  apply (clarsimp simp: validNF_def triple_judgement_def validNF_property_def)
-  apply (auto simp: no_fail_def valid_def)
+lemma rg_validI:
+  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
+     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
+  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
+     "Gf \<le> Rg" "Gg \<le> Rf"
+  shows "\<lbrace>Pf and Pg\<rbrace>,\<lbrace>R\<rbrace> parallel f g \<lbrace>G\<rbrace>,\<lbrace>\<lambda>rv. Qf rv and Qg rv\<rbrace>"
+  apply (clarsimp simp: validI_def rely_def pred_conj_def
+                        parallel_prefix_closed validI[THEN validI_prefix_closed])
+  apply (drule(3) parallel_rely_induct0[OF _ _ _ validI order_refl order_refl compat])
+  apply clarsimp
+  apply (drule(2) validI[THEN validI_rvD])+
+  apply (simp add: last_st_tr_def)
   done
 
-lemma validNF_weaken_pre [wp_comb]:
-  "\<lbrakk>\<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>!; \<And>s. P s \<Longrightarrow> Q s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>!"
-  by (metis hoare_pre_imp no_fail_pre validNF_def)
+lemma validI_weaken_pre[wp_pre]:
+  "\<lbrace>P'\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
+    \<Longrightarrow> (\<And>s0 s. P s0 s \<Longrightarrow> P' s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (simp add: validI_def, blast)
 
-lemma validNF_post_comb_imp_conj:
-  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>!; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
-  by (fastforce simp: validNF_def valid_def)
+lemma rely_weaken:
+  "(\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
+    \<Longrightarrow> (tr, res) \<in> rely f R s s0 \<Longrightarrow> (tr, res) \<in> rely f R' s s0"
+  by (simp add: rely_def rely_cond_def, blast)
 
-lemma validNF_post_comb_conj_L:
-  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
-  apply (clarsimp simp: validNF_def valid_def no_fail_def)
-  apply force
-  done
+lemma validI_weaken_rely[wp_pre]:
+  "\<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
+    \<Longrightarrow> (\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: validI_def)
+  by (metis rely_weaken)
 
-lemma validNF_post_comb_conj_R:
-  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
-  apply (clarsimp simp: validNF_def valid_def no_fail_def)
-  apply force
-  done
+lemma validI_strengthen_post:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace>
+    \<Longrightarrow> (\<forall>v s0 s. Q' v s0 s \<longrightarrow> Q v s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (simp add: validI_def)
 
-lemma validNF_post_comb_conj:
-  "\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
-  apply (clarsimp simp: validNF_def valid_def no_fail_def)
-  apply force
-  done
+lemma validI_strengthen_guar:
+  "\<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G'\<rbrace>, \<lbrace>Q\<rbrace>
+    \<Longrightarrow> (\<forall>s0 s. G' s0 s \<longrightarrow> G s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>"
+  by (force simp: validI_def guar_cond_def)
 
-lemma validNF_split_if [wp_split]:
-  "\<lbrakk>P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>S\<rbrace>!; \<not> P \<Longrightarrow> \<lbrace>R\<rbrace> g \<lbrace>S\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not> P \<longrightarrow> R s)\<rbrace> if P then f else g \<lbrace>S\<rbrace>!"
-  by simp
+lemma rely_prim[simp]:
+  "rely (\<lambda>s. insert (v s) (f s)) R s0 = (\<lambda>s. {x. x = v s \<and> rely_cond R s0 (fst x)} \<union> (rely f R s0 s))"
+  "rely (\<lambda>s. {}) R s0 = (\<lambda>_. {})"
+  by (auto simp: rely_def prod_eq_iff)
 
-lemma validNF_vcg_conj_lift:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow>
-      \<lbrace>\<lambda>s. P s \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>!"
-  apply (subst pred_conj_def[symmetric], subst pred_conj_def[symmetric], rule validNF_post_conj)
-   apply (erule validNF_weaken_pre, fastforce)
-  apply (erule validNF_weaken_pre, fastforce)
-  done
+lemma prefix_closed_put_trace_elem[iff]:
+  "prefix_closed (put_trace_elem x)"
+  by (clarsimp simp: prefix_closed_def put_trace_elem_def)
 
-lemma validNF_vcg_disj_lift:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>! \<rbrakk> \<Longrightarrow>
-       \<lbrace>\<lambda>s. P s \<or> P' s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<or> Q' rv s\<rbrace>!"
-  apply (clarsimp simp: validNF_def)
-  apply safe
-   apply (auto intro!: hoare_vcg_disj_lift)[1]
-  apply (clarsimp simp: no_fail_def)
-  done
+lemma prefix_closed_return[iff]:
+  "prefix_closed (return x)"
+  by (simp add: prefix_closed_def return_def)
 
-lemma validNF_vcg_all_lift [wp]:
-  "\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>!"
-  apply atomize
-  apply (rule validNF)
-   apply (clarsimp simp: validNF_def)
-   apply (rule hoare_vcg_all_lift)
-   apply force
-  apply (clarsimp simp: no_fail_def validNF_def)
-  done
+lemma prefix_closed_put_trace[iff]:
+  "prefix_closed (put_trace tr)"
+  by (induct tr; clarsimp simp: prefix_closed_bind)
 
-lemma no_fail_bind[wp_split]:
-  "\<lbrakk> no_fail P f; \<And>x. no_fail (R x) (g x); \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace> \<rbrakk>
-    \<Longrightarrow> no_fail (P and Q) (do x \<leftarrow> f; g x od)"
-  apply (simp add: no_fail_def bind_def2 image_Un image_image
-                   in_image_constant)
-  apply (intro allI conjI impI)
-   apply (fastforce simp: image_def)
+lemma put_trace_eq_drop:
+  "put_trace xs s
+    = ((\<lambda>n. (drop n xs, if n = 0 then Result ((), s) else Incomplete)) ` {.. length xs})"
+  apply (induct xs)
+   apply (clarsimp simp: return_def)
+  apply (clarsimp simp: put_trace_elem_def bind_def)
+  apply (simp add: atMost_Suc_eq_insert_0 image_image)
+  apply (rule equalityI; clarsimp)
+   apply (split if_split_asm; clarsimp)
+   apply (auto intro: image_eqI[where x=0])[1]
+  apply (rule rev_bexI, simp)
   apply clarsimp
-  apply (drule(1) post_by_hoare, erule in_mres)
-  apply (fastforce simp: image_def)
   done
 
-lemma validNF_bind [wp_split]:
-  "\<lbrakk> \<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>! \<rbrakk> \<Longrightarrow>
-       \<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>C\<rbrace>!"
-  apply (rule validNF)
-   apply (metis validNF_valid hoare_seq_ext)
-  apply (frule no_fail_bind[OF validNF_no_fail, where g=g])
-    apply (rule validNF_no_fail, assumption)
-   apply (erule validNF_valid)
-  apply (simp add: no_fail_def)
+lemma put_trace_res:
+  "(tr, res) \<in> put_trace xs s
+    \<Longrightarrow> \<exists>n. tr = drop n xs \<and> n \<le> length xs
+        \<and> res = (case n of 0 \<Rightarrow> Result ((), s) | _ \<Rightarrow> Incomplete)"
+  apply (clarsimp simp: put_trace_eq_drop)
+  apply (case_tac n; auto intro: exI[where x=0])
   done
 
-lemmas validNF_seq_ext = validNF_bind
-
-subsection "validNF compound rules"
-lemma validNF_state_assert [wp]:
-  "\<lbrace> \<lambda>s. P () s \<and> G s  \<rbrace> state_assert G \<lbrace> P \<rbrace>!"
-  apply (rule validNF)
-  apply wpsimp
-  apply (clarsimp simp: no_fail_def state_assert_def
-              bind_def2 assert_def return_def get_def)
+lemma put_trace_twp[wp]:
+  "\<lbrace>\<lambda>s0 s. (\<forall>n. rely_cond R s0 (drop n xs) \<longrightarrow> guar_cond G s0 (drop n xs))
+    \<and> (rely_cond R s0 xs \<longrightarrow> Q () (last_st_tr xs s0) s)\<rbrace>,\<lbrace>R\<rbrace> put_trace xs \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (clarsimp simp: validI_def rely_def)
+  apply (drule put_trace_res)
+  apply (clarsimp; clarsimp split: nat.split_asm)
   done
 
-lemma validNF_modify [wp]:
-  "\<lbrace> \<lambda>s. P () (f s) \<rbrace> modify f \<lbrace> P \<rbrace>!"
-  apply (clarsimp simp: modify_def)
-  apply wp
-  done
+lemmas put_trace_elem_twp = put_trace_twp[where xs="[x]" for x, simplified]
 
-lemma validNF_gets [wp]:
-  "\<lbrace>\<lambda>s. P (f s) s\<rbrace> gets f \<lbrace>P\<rbrace>!"
-  apply (clarsimp simp: gets_def)
-  apply wp
-  done
+lemma prefix_closed_select[iff]:
+  "prefix_closed (select S)"
+  by (simp add: prefix_closed_def select_def image_def)
 
-lemma validNF_condition [wp]:
-  "\<lbrakk> \<lbrace> Q \<rbrace> A \<lbrace>P\<rbrace>!; \<lbrace> R \<rbrace> B \<lbrace>P\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. if C s then Q s else R s\<rbrace> condition C A B \<lbrace>P\<rbrace>!"
-  apply rule
-   apply (drule validNF_valid)+
-   apply (erule (1) condition_wp)
-  apply (drule validNF_no_fail)+
-  apply (clarsimp simp: no_fail_def condition_def)
+lemma rely_cond_rtranclp:
+  "rely_cond R s (map (Pair Env) xs) \<Longrightarrow> rtranclp R s (last_st_tr (map (Pair Env) xs) s)"
+  apply (induct xs arbitrary: s rule: rev_induct)
+   apply simp
+  apply (clarsimp simp add: rely_cond_def)
+  apply (erule converse_rtranclp_into_rtranclp)
+  apply simp
   done
 
-lemma validNF_alt_def:
-  "validNF P m Q = (\<forall>s. P s \<longrightarrow> ((\<forall>(r', s') \<in> mres (m s). Q r' s') \<and> Failed \<notin> snd ` (m s)))"
-  by (auto simp: validNF_def valid_def no_fail_def mres_def image_def)
+definition
+  no_trace :: "('s,'a) tmonad  \<Rightarrow> bool"
+where
+  "no_trace f = (\<forall>tr res s. (tr, res) \<in> f s \<longrightarrow> tr = [] \<and> res \<noteq> Incomplete)"
+
+lemmas no_traceD = no_trace_def[THEN iffD1, rule_format]
 
-lemma validNF_assert [wp]:
-    "\<lbrace> (\<lambda>s. P) and (R ()) \<rbrace> assert P \<lbrace> R \<rbrace>!"
-  apply (rule validNF)
-   apply (clarsimp simp: valid_def in_return)
-  apply (clarsimp simp: no_fail_def return_def)
-  done
+lemma no_trace_emp:
+  "no_trace f \<Longrightarrow> (tr, r) \<in> f s \<Longrightarrow> tr = []"
+  by (simp add: no_traceD)
 
-lemma validNF_false_pre:
-  "\<lbrace> \<lambda>_. False \<rbrace> P \<lbrace> Q \<rbrace>!"
-  by (clarsimp simp: validNF_def no_fail_def)
+lemma no_trace_Incomplete_mem:
+  "no_trace f \<Longrightarrow> (tr, Incomplete) \<notin> f s"
+  by (auto dest: no_traceD)
 
-lemma validNF_chain:
-   "\<lbrakk>\<lbrace>P'\<rbrace> a \<lbrace>R'\<rbrace>!; \<And>s. P s \<Longrightarrow> P' s; \<And>r s. R' r s \<Longrightarrow> R r s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>!"
-  by (fastforce simp: validNF_def valid_def no_fail_def Ball_def)
+lemma no_trace_Incomplete_eq:
+  "no_trace f \<Longrightarrow> (tr, res) \<in> f s \<Longrightarrow> res \<noteq> Incomplete"
+  by (auto dest: no_traceD)
 
-lemma validNF_case_prod [wp]:
-  "\<lbrakk> \<And>x y. validNF (P x y) (B x y) Q \<rbrakk> \<Longrightarrow> validNF (case_prod P v) (case_prod (\<lambda>x y. B x y) v) Q"
-  by (metis prod.exhaust split_conv)
+lemma no_trace_prefix_closed:
+  "no_trace f \<Longrightarrow> prefix_closed f"
+  by (auto simp add: prefix_closed_def dest: no_trace_emp)
 
-lemma validE_NF_case_prod [wp]:
-    "\<lbrakk> \<And>a b. \<lbrace>P a b\<rbrace> f a b \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow>
-          \<lbrace>case x of (a, b) \<Rightarrow> P a b\<rbrace> case x of (a, b) \<Rightarrow> f a b \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!"
-  apply (clarsimp simp: validE_NF_alt_def)
-  apply (erule validNF_case_prod)
+(* Attempt to define triple_judgement to use valid_validI_wp as wp_comb rule.
+   It doesn't work. It seems that wp_comb rules cannot take more than 1 assumption *)
+lemma validI_is_triple:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> =
+     triple_judgement (\<lambda>(s0, s). prefix_closed f \<longrightarrow> P s0 s) f
+                      (\<lambda>(s0,s) f. prefix_closed f \<and> (\<forall>tr res. (tr, res) \<in> rely f R s0 s
+                          \<longrightarrow> guar_cond G s0 tr
+                              \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
+  apply (simp add: triple_judgement_def validI_def )
+  apply (cases "prefix_closed f"; simp)
   done
 
-lemma no_fail_is_validNF_True: "no_fail P s = (\<lbrace> P \<rbrace> s \<lbrace> \<lambda>_ _. True \<rbrace>!)"
-  by (clarsimp simp: no_fail_def validNF_def valid_def)
-
-subsection "validNF reasoning in the exception monad"
+lemma no_trace_is_triple:
+  "no_trace f = triple_judgement \<top> f (\<lambda>() f. id no_trace f)"
+  by (simp add: triple_judgement_def split: unit.split)
 
-lemma validE_NF [intro?]:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>; no_fail P f \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>!"
-  apply (clarsimp simp: validE_NF_def)
-  done
+lemmas [wp_trip] = validI_is_triple no_trace_is_triple
 
-lemma validE_NF_valid:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>"
-  apply (clarsimp simp: validE_NF_def)
-  done
+lemma valid_validI_wp[wp_comb]:
+  "no_trace f \<Longrightarrow> (\<And>s0. \<lbrace>P s0\<rbrace> f \<lbrace>\<lambda>v. Q v s0 \<rbrace>)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (fastforce simp: rely_def validI_def valid_def mres_def no_trace_prefix_closed dest: no_trace_emp
+    elim: image_eqI[rotated])
 
-lemma validE_NF_no_fail:
-  "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>! \<rbrakk> \<Longrightarrow> no_fail P f"
-  apply (clarsimp simp: validE_NF_def)
-  done
+(* Since valid_validI_wp in wp_comb doesn't work, we add the rules directly in the wp set *)
+lemma no_trace_prim:
+  "no_trace get"
+  "no_trace (put s)"
+  "no_trace (modify f)"
+  "no_trace (return v)"
+  "no_trace fail"
+  by (simp_all add: no_trace_def get_def put_def modify_def bind_def
+                    return_def select_def fail_def)
 
-lemma validE_NF_weaken_pre [wp_comb]:
-   "\<lbrakk>\<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>!; \<And>s. P s \<Longrightarrow> Q s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>!"
-  apply (clarsimp simp: validE_NF_alt_def)
-  apply (erule validNF_weaken_pre)
-  apply simp
-  done
+lemma no_trace_select:
+  "no_trace (select S)"
+  by (clarsimp simp add: no_trace_def select_def)
 
-lemma validE_NF_post_comb_conj_L:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace> E \<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace> \<lambda>_ _. True \<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>, \<lbrace> E \<rbrace>!"
-  apply (clarsimp simp: validE_NF_alt_def validE_def validNF_def
-          valid_def no_fail_def split: sum.splits)
-  apply force
+lemma no_trace_bind:
+  "no_trace f \<Longrightarrow> \<forall>rv. no_trace (g rv)
+    \<Longrightarrow> no_trace (do rv \<leftarrow> f; g rv od)"
+  apply (subst no_trace_def)
+  apply (clarsimp simp add: bind_def split: tmres.split_asm;
+    auto dest: no_traceD[rotated])
   done
 
-lemma validE_NF_post_comb_conj_R:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace> \<lambda>_ _. True \<rbrace>; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace> E \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>, \<lbrace> E \<rbrace>!"
-  apply (clarsimp simp: validE_NF_alt_def validE_def validNF_def
-          valid_def no_fail_def split: sum.splits)
-  apply force
-  done
+lemma no_trace_extra:
+  "no_trace (gets f)"
+  "no_trace (assert P)"
+  "no_trace (assert_opt Q)"
+  by (simp_all add: gets_def assert_def assert_opt_def no_trace_bind no_trace_prim
+             split: option.split)
 
-lemma validE_NF_post_comb_conj:
-  "\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace> E \<rbrace>!; \<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>, \<lbrace> E \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' s \<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace>, \<lbrace> E \<rbrace>!"
-  apply (clarsimp simp: validE_NF_alt_def validE_def validNF_def
-          valid_def no_fail_def split: sum.splits)
-  apply force
-  done
+lemmas no_trace_all[wp, iff] = no_trace_prim no_trace_select no_trace_extra
 
-lemma validE_NF_chain:
-   "\<lbrakk>\<lbrace>P'\<rbrace> a \<lbrace>R'\<rbrace>,\<lbrace>E'\<rbrace>!;
-    \<And>s. P s \<Longrightarrow> P' s;
-    \<And>r' s'. R' r' s' \<Longrightarrow> R r' s';
-    \<And>r'' s''. E' r'' s'' \<Longrightarrow> E r'' s''\<rbrakk> \<Longrightarrow>
-  \<lbrace>\<lambda>s. P s \<rbrace> a \<lbrace>\<lambda>r' s'. R r' s'\<rbrace>,\<lbrace>\<lambda>r'' s''. E r'' s''\<rbrace>!"
-  by (fastforce simp: validE_NF_def validE_def2 no_fail_def Ball_def split: sum.splits)
-
-lemma validE_NF_bind_wp [wp]:
-  "\<lbrakk>\<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>, \<lbrace>E\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> f >>=E (\<lambda>x. g x) \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>!"
-  apply (unfold validE_NF_alt_def bindE_def)
-  apply (rule validNF_bind [rotated])
-   apply assumption
-  apply (clarsimp simp: lift_def throwError_def split: sum.splits)
-    apply wpsimp
+lemma env_steps_twp[wp]:
+  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s0 s' \<longrightarrow> Q () s' s') \<and> Q () s0 s\<rbrace>,\<lbrace>R\<rbrace> env_steps \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: interference_def env_steps_def)
+  apply wp
+  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
+  apply (drule rely_cond_rtranclp)
+  apply (clarsimp simp add: last_st_tr_def hd_append)
   done
 
-lemma validNF_catch [wp]:
-  "\<lbrakk>\<And>x. \<lbrace>E x\<rbrace> handler x \<lbrace>Q\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f <catch> (\<lambda>x. handler x) \<lbrace>Q\<rbrace>!"
-  apply (unfold validE_NF_alt_def catch_def)
-  apply (rule validNF_bind [rotated])
-   apply assumption
-  apply (clarsimp simp: lift_def throwError_def split: sum.splits)
+lemma interference_twp[wp]:
+  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s s' \<longrightarrow> Q () s' s') \<and> G s0 s\<rbrace>,\<lbrace>R\<rbrace>  interference \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: interference_def commit_step_def del: put_trace.simps)
   apply wp
+  apply clarsimp
+  apply (simp add: drop_Cons nat.split rely_cond_def guar_cond_def)
   done
 
-lemma validNF_throwError [wp]:
-  "\<lbrace>E e\<rbrace> throwError e \<lbrace>P\<rbrace>, \<lbrace>E\<rbrace>!"
-  by (unfold validE_NF_alt_def throwError_def o_def) wpsimp
-
-lemma validNF_returnOk [wp]:
-  "\<lbrace>P e\<rbrace> returnOk e \<lbrace>P\<rbrace>, \<lbrace>E\<rbrace>!"
- by (clarsimp simp: validE_NF_alt_def returnOk_def) wpsimp
-
-lemma validNF_whenE [wp]:
-  "(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>!) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>!"
-  unfolding whenE_def by clarsimp wp
-
-lemma validNF_nobindE [wp]:
-  "\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>!;
-     \<lbrace>A\<rbrace> f \<lbrace>\<lambda>r s. B s\<rbrace>,\<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow>
-   \<lbrace>A\<rbrace> doE f; g odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>!"
-  by clarsimp wp
-
-(*
- * Setup triple rules for validE_NF so that we can use the
- * "wp_comb" attribute.
- *)
-
-definition "validE_NF_property Q E s b \<equiv> Failed \<notin> snd ` (b s)
-       \<and> (\<forall>(r', s') \<in> mres (b s). case r' of Inl x \<Rightarrow> E x s' | Inr x \<Rightarrow> Q x s')"
-
-lemma validE_NF_is_triple [wp_trip]:
-  "validE_NF P f Q E = triple_judgement P f (validE_NF_property Q E)"
-  apply (clarsimp simp: validE_NF_def validE_def2 no_fail_def triple_judgement_def
-           validE_NF_property_def split: sum.splits)
-  apply blast
+(* what Await does if we haven't committed our step is a little
+   strange. this assumes we have, which means s0 = s. we should
+   revisit this if we find a use for Await when this isn't the
+   case *)
+lemma Await_sync_twp:
+  "\<lbrace>\<lambda>s0 s. s = s0 \<and> (\<forall>x. R\<^sup>*\<^sup>* s0 x \<and> c x \<longrightarrow> Q () x x)\<rbrace>,\<lbrace>R\<rbrace> Await c \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: Await_def split_def)
+  apply wp
+  apply clarsimp
+  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
+  apply (drule rely_cond_rtranclp)
+  apply (simp add: o_def)
   done
 
-lemmas [wp_comb] = validE_NF_weaken_pre
+(* FIXME: this needs adjustment, case_prod Q is unlikely to unify *)
+lemma wpc_helper_validI:
+  "(\<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>) \<Longrightarrow> wpc_helper (P, P', P'') (case_prod Q, Q', Q'') (\<lbrace>curry P\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>)"
+  by (clarsimp simp: wpc_helper_def elim!: validI_weaken_pre)
 
-lemma validNF_cong:
-   "\<lbrakk> \<And>s. P s = P' s; \<And>s. P s \<Longrightarrow> m s = m' s;
-           \<And>r' s' s. \<lbrakk> P s; (r', s') \<in> mres (m s) \<rbrakk> \<Longrightarrow> Q r' s' = Q' r' s' \<rbrakk> \<Longrightarrow>
-     (\<lbrace> P \<rbrace> m \<lbrace> Q \<rbrace>!) = (\<lbrace> P' \<rbrace> m' \<lbrace> Q' \<rbrace>!)"
-  by (fastforce simp: validNF_alt_def)
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> m \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>" wpc_helper_validI
 
-lemma validE_NF_liftE [wp]:
-  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>! \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
-  by (wpsimp simp: validE_NF_alt_def liftE_def)
+lemma mres_union:
+ "mres (a \<union> b) = mres a \<union> mres b"
+  by (simp add: mres_def image_Un)
 
-lemma validE_NF_handleE' [wp]:
-  "\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>! \<rbrakk> \<Longrightarrow>
-   \<lbrace>P\<rbrace> f <handle2> (\<lambda>x. handler x) \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
-  apply (unfold validE_NF_alt_def handleE'_def)
-  apply (rule validNF_bind [rotated])
-   apply assumption
-  apply (clarsimp split: sum.splits)
-  apply wpsimp
-  done
+lemma mres_Failed_empty:
+  "mres ((\<lambda>xs. (xs, Failed)) ` X ) = {}"
+  "mres ((\<lambda>xs. (xs, Incomplete)) ` X ) = {}"
+  by (auto simp add: mres_def image_def)
 
-lemma validE_NF_handleE [wp]:
-  "\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>! \<rbrakk> \<Longrightarrow>
-   \<lbrace>P\<rbrace> f <handle> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
-  apply (unfold handleE_def)
-  apply (metis validE_NF_handleE')
-  done
+lemma det_set_option_eq:
+  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
+       (ts, Some (rr, ss)) \<in> m \<Longrightarrow> rr = r \<and> ss = s'"
+  by (metis UN_I option.set_intros prod.inject singleton_iff snd_conv)
 
-lemma validE_NF_condition [wp]:
-  "\<lbrakk> \<lbrace> Q \<rbrace> A \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!; \<lbrace> R \<rbrace> B \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!\<rbrakk>
-      \<Longrightarrow> \<lbrace>\<lambda>s. if C s then Q s else R s\<rbrace> condition C A B \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!"
-  apply rule
-   apply (drule validE_NF_valid)+
-   apply wp
-  apply (drule validE_NF_no_fail)+
-  apply (clarsimp simp: no_fail_def condition_def)
-  done
+lemma det_set_option_eq':
+  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
+       Some (r, s') \<in> snd ` m"
+  using image_iff by fastforce
 
 lemma validI_name_pre:
   "prefix_closed f \<Longrightarrow>
@@ -2550,36 +1607,4 @@ lemma validI_well_behaved':
 
 lemmas validI_well_behaved = validI_well_behaved'[unfolded le_fun_def, simplified]
 
-text \<open>Strengthen setup.\<close>
-
-context strengthen_implementation begin
-
-lemma strengthen_hoare [strg]:
-  "(\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
-    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>)"
-  by (cases F, auto elim: hoare_strengthen_post)
-
-lemma strengthen_validE_R_cong[strg]:
-  "(\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
-    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, -) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, -)"
-  by (cases F, auto intro: hoare_post_imp_R)
-
-lemma strengthen_validE_cong[strg]:
-  "(\<And>r s. st F (\<longrightarrow>) (Q r s) (R r s))
-    \<Longrightarrow> (\<And>r s. st F (\<longrightarrow>) (S r s) (T r s))
-    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>S\<rbrace>) (\<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>T\<rbrace>)"
-  by (cases F, auto elim: hoare_post_impErr)
-
-lemma strengthen_validE_E_cong[strg]:
-  "(\<And>r s. st F (\<longrightarrow>) (S r s) (T r s))
-    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace> f -, \<lbrace>S\<rbrace>) (\<lbrace>P\<rbrace> f -, \<lbrace>T\<rbrace>)"
-  by (cases F, auto elim: hoare_post_impErr simp: validE_E_def)
-
-lemma strengthen_validI[strg]:
-  "(\<And>r s0 s. st F (\<longrightarrow>) (Q r s0 s) (Q' r s0 s))
-    \<Longrightarrow> st F (\<longrightarrow>) (\<lbrace>P\<rbrace>,\<lbrace>G\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>Q\<rbrace>) (\<lbrace>P\<rbrace>,\<lbrace>G\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>Q'\<rbrace>)"
-  by (cases F, auto elim: validI_strengthen_post)
-
-end
-
 end

From 7b9ca48fe2c33dea2df9aca8e3cc844e0fc14765 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Mon, 14 Aug 2023 15:35:46 +1000
Subject: [PATCH 3/5] lib/monads: split content out into Trace_RG and
 Trace_No_Trace

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 lib/Monads/trace/Trace_Lemmas_Old.thy       | 335 ----------
 lib/Monads/trace/Trace_Monad.thy            |  82 ---
 lib/Monads/trace/Trace_Monad_Equations.thy  | 203 ++++++
 lib/Monads/trace/Trace_No_Trace.thy         |  70 ++
 lib/Monads/trace/Trace_RG.thy               | 691 ++++++++++++++++++++
 lib/Monads/trace/Trace_Strengthen_Setup.thy |   2 +-
 lib/Monads/trace/Trace_VCG.thy              | 532 +--------------
 7 files changed, 968 insertions(+), 947 deletions(-)
 delete mode 100644 lib/Monads/trace/Trace_Lemmas_Old.thy
 create mode 100644 lib/Monads/trace/Trace_No_Trace.thy
 create mode 100644 lib/Monads/trace/Trace_RG.thy

diff --git a/lib/Monads/trace/Trace_Lemmas_Old.thy b/lib/Monads/trace/Trace_Lemmas_Old.thy
deleted file mode 100644
index 2c5bc81e67..0000000000
--- a/lib/Monads/trace/Trace_Lemmas_Old.thy
+++ /dev/null
@@ -1,335 +0,0 @@
-(*
- * Copyright 2023, Proofcraft Pty Ltd
- * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
- *
- * SPDX-License-Identifier: BSD-2-Clause
- *)
-
-theory Trace_Lemmas_Old
-  imports
-    Trace_More_VCG
-    Trace_Monad_Equations
-begin
-
-lemma mapM_Cons:
-  "mapM f (x # xs) = do
-    y \<leftarrow> f x;
-    ys \<leftarrow> mapM f xs;
-    return (y # ys)
-  od"
-  and mapM_Nil:
-  "mapM f [] = return []"
-  by (simp_all add: mapM_def sequence_def)
-
-lemma mapM_x_Cons:
-  "mapM_x f (x # xs) = do
-    y \<leftarrow> f x;
-    mapM_x f xs
-  od"
-  and mapM_x_Nil:
-  "mapM_x f [] = return ()"
-  by (simp_all add: mapM_x_def sequence_x_def)
-
-lemma mapM_append:
-  "mapM f (xs @ ys) = (do
-    fxs \<leftarrow> mapM f xs;
-    fys \<leftarrow> mapM f ys;
-    return (fxs @ fys)
-  od)"
-  by (induct xs, simp_all add: mapM_Cons mapM_Nil bind_assoc)
-
-lemma mapM_x_append:
-  "mapM_x f (xs @ ys) = (do
-    x \<leftarrow> mapM_x f xs;
-    mapM_x f ys
-  od)"
-  by (induct xs, simp_all add: mapM_x_Cons mapM_x_Nil bind_assoc)
-
-lemma mapM_map:
-  "mapM f (map g xs) = mapM (f o g) xs"
-  by (induct xs; simp add: mapM_Nil mapM_Cons)
-
-lemma mapM_x_map:
-  "mapM_x f (map g xs) = mapM_x (f o g) xs"
-  by (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
-
-primrec
-  repeat_n :: "nat \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
-where
-    "repeat_n 0 f = return ()"
-  | "repeat_n (Suc n) f = do f; repeat_n n f od"
-
-lemma repeat_n_mapM_x:
-  "repeat_n n f = mapM_x (\<lambda>_. f) (replicate n ())"
-  by (induct n, simp_all add: mapM_x_Cons mapM_x_Nil)
-
-definition
-  repeat :: "('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
-where
-  "repeat f = do n \<leftarrow> select UNIV; repeat_n n f od"
-
-definition
-  env_step :: "('s,unit) tmonad"
-where
-  "env_step =
-  (do
-    s' \<leftarrow> select UNIV;
-    put_trace_elem (Env, s');
-    put s'
-  od)"
-
-abbreviation
-  "env_n_steps n \<equiv> repeat_n n env_step"
-
-lemma elem_select_bind:
-  "(tr, res) \<in> (do x \<leftarrow> select S; f x od) s
-    = (\<exists>x \<in> S. (tr, res) \<in> f x s)"
-  by (simp add: bind_def select_def)
-
-lemma select_bind_UN:
-  "(do x \<leftarrow> select S; f x od) = (\<lambda>s. \<Union>x \<in> S. f x s)"
-  by (rule ext, auto simp: elem_select_bind)
-
-lemma select_early:
-  "S \<noteq> {}
-    \<Longrightarrow> do x \<leftarrow> f; y \<leftarrow> select S; g x y od
-        = do y \<leftarrow> select S; x \<leftarrow> f; g x y od"
-  apply (simp add: bind_def select_def Sigma_def)
-  apply (rule ext)
-  apply (fastforce elim: rev_bexI image_eqI[rotated] split: tmres.split_asm)
-  done
-
-lemma repeat_n_choice:
-  "S \<noteq> {}
-    \<Longrightarrow> repeat_n n (do x \<leftarrow> select S; f x od)
-        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S \<and> length xs = n}; mapM_x f xs od)"
-  apply (induct n; simp?)
-   apply (simp add: select_def bind_def mapM_x_Nil cong: conj_cong)
-  apply (simp add: select_early bind_assoc)
-  apply (subst select_early)
-   apply simp
-   apply (auto intro: exI[where x="replicate n xs" for n xs])[1]
-  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
-  apply (simp only: conj_comms[where Q="length xs = n" for xs n])
-  apply (simp only: ex_simps[symmetric] conj_assoc length_Suc_conv, simp)
-  apply (auto simp: mapM_x_Cons)
-  done
-
-lemma repeat_choice:
-  "S \<noteq> {}
-    \<Longrightarrow> repeat (do x \<leftarrow> select S; f x od)
-        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S}; mapM_x f xs od)"
-  apply (simp add: repeat_def repeat_n_choice)
-  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
-  done
-
-lemma put_trace_append:
-  "put_trace (xs @ ys) = do put_trace ys; put_trace xs od"
-  by (induct xs; simp add: bind_assoc)
-
-lemma put_trace_elem_put_comm:
-  "do y \<leftarrow> put_trace_elem x; put s od
-    = do y \<leftarrow> put s; put_trace_elem x od"
-  by (simp add: put_def put_trace_elem_def bind_def insert_commute)
-
-lemma put_trace_put_comm:
-  "do y \<leftarrow> put_trace xs; put s od
-    = do y \<leftarrow> put s; put_trace xs od"
-  apply (rule sym; induct xs; simp)
-  apply (simp add: bind_assoc put_trace_elem_put_comm)
-  apply (simp add: bind_assoc[symmetric])
-  done
-
-lemma mapM_x_comm:
-  "(\<forall>x \<in> set xs. do y \<leftarrow> g; f x od = do y \<leftarrow> f x; g od)
-    \<Longrightarrow> do y \<leftarrow> g; mapM_x f xs od = do y \<leftarrow> mapM_x f xs; g od"
-  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
-  apply (simp add: bind_assoc[symmetric], simp add: bind_assoc)
-  done
-
-lemma mapM_x_split:
-  "(\<forall>x \<in> set xs. \<forall>y \<in> set xs. do z \<leftarrow> g y; f x od = do (z :: unit) \<leftarrow> f x; g y od)
-    \<Longrightarrow> mapM_x (\<lambda>x. do z \<leftarrow> f x; g x od) xs = do y \<leftarrow> mapM_x f xs; mapM_x g xs od"
-  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons bind_assoc)
-  apply (subst bind_assoc[symmetric], subst mapM_x_comm[where f=f and g="g x" for x])
-   apply simp
-  apply (simp add: bind_assoc)
-  done
-
-lemma mapM_x_put:
-  "mapM_x put xs = unless (xs = []) (put (last xs))"
-  apply (induct xs rule: rev_induct)
-   apply (simp add: mapM_x_Nil unless_def when_def)
-  apply (simp add: mapM_x_append mapM_x_Cons mapM_x_Nil)
-  apply (simp add: bind_def unless_def when_def put_def return_def)
-  done
-
-lemma put_trace_mapM_x:
-  "put_trace xs = mapM_x put_trace_elem (rev xs)"
-  by (induct xs; simp add: mapM_x_Nil mapM_x_append mapM_x_Cons)
-
-lemma rev_surj:
-  "surj rev"
-  by (rule_tac f=rev in surjI, simp)
-
-lemma select_image:
-  "select (f ` S) = do x \<leftarrow> select S; return (f x) od"
-  by (auto simp add: bind_def select_def return_def Sigma_def)
-
-lemma env_steps_repeat:
-  "env_steps = repeat env_step"
-  apply (simp add: env_step_def repeat_choice env_steps_def
-                   select_early)
-  apply (simp add: put_trace_elem_put_comm)
-  apply (simp add: mapM_x_split put_trace_elem_put_comm put_trace_put_comm
-                   mapM_x_put)
-  apply (simp add: put_trace_mapM_x rev_map mapM_x_map o_def)
-  apply (subst rev_surj[symmetric], simp add: select_image bind_assoc)
-  apply (rule arg_cong2[where f=bind, OF refl ext])
-  apply (simp add: bind_def get_def put_def unless_def when_def return_def)
-  apply (simp add: last_st_tr_def hd_map hd_rev)
-  done
-
-lemma repeat_n_plus:
-  "repeat_n (n + m) f = do repeat_n n f; repeat_n m f od"
-  by (induct n; simp add: bind_assoc)
-
-lemma repeat_eq_twice[simp]:
-  "(do x \<leftarrow> repeat f; repeat f od) = repeat f"
-  apply (simp add: repeat_def select_early)
-  apply (simp add: bind_assoc repeat_n_plus[symmetric, simplified])
-  apply (simp add: bind_def select_def Sigma_def)
-  apply (rule ext, fastforce intro: exI[where x=0])
-  done
-
-lemmas repeat_eq_twice_then[simp]
-    = repeat_eq_twice[THEN bind_then_eq, simplified bind_assoc]
-
-lemmas env_steps_eq_twice[simp]
-    = repeat_eq_twice[where f=env_step, folded env_steps_repeat]
-lemmas env_steps_eq_twice_then[simp]
-    = env_steps_eq_twice[THEN bind_then_eq, simplified bind_assoc]
-
-lemmas mapM_collapse_append = mapM_append[symmetric, THEN bind_then_eq,
-    simplified bind_assoc, simplified]
-
-lemma prefix_closed_mapM[rule_format, wp_split]:
-  "(\<forall>x \<in> set xs. prefix_closed (f x)) \<Longrightarrow> prefix_closed (mapM f xs)"
-  apply (induct xs)
-   apply (simp add: mapM_def sequence_def)
-  apply (clarsimp simp: mapM_Cons)
-  apply (intro prefix_closed_bind allI; clarsimp)
-  done
-
-lemmas bind_promote_If
-    = if_distrib[where f="\<lambda>f. bind f g" for g]
-      if_distrib[where f="\<lambda>g. bind f g" for f]
-
-lemma bind_promote_If2:
-  "do x \<leftarrow> f; if P then g x else h x od
-    = (if P then bind f g else bind f h)"
-  by simp
-
-lemma exec_put_trace[unfolded K_bind_def]:
-  "(do put_trace xs; f od) s
-    = (\<Union>n \<in> {n. 0 < n \<and> n \<le> length xs}. {(drop n xs, Incomplete)})
-        \<union> ((\<lambda>(a, b). (a @ xs, b)) ` f s)"
-  apply (simp add: put_trace_eq_drop bind_def)
-  apply (safe; (clarsimp split: if_split_asm)?;
-      fastforce intro: bexI[where x=0] rev_bexI)
-  done
-
-lemma UN_If_distrib:
-  "(\<Union>x \<in> S. if P x then A x else B x)
-    = ((\<Union>x \<in> S \<inter> {x. P x}. A x) \<union> (\<Union>x \<in> S \<inter> {x. \<not> P x}. B x))"
-  by (fastforce split: if_split_asm)
-
-lemma Await_redef:
-  "Await P = do
-    s1 \<leftarrow> select {s. P s};
-    env_steps;
-    s \<leftarrow> get;
-    select (if P s then {()} else {})
-  od"
-  apply (simp add: Await_def env_steps_def bind_assoc)
-  apply (cases "{s. P s} = {}")
-   apply (simp add: select_def bind_def get_def)
-  apply (rule ext)
-  apply (simp add: exec_get select_bind_UN put_then_get_then)
-  apply (simp add: bind_promote_If2 if_distribR if_distrib[where f=select])
-  apply (simp add: exec_put_trace cong: if_cong)
-  apply (simp add: put_def bind_def select_def cong: if_cong)
-  apply (strengthen equalityI)
-  apply clarsimp
-  apply (strengthen exI[where x="s # xs" for s xs])
-  apply (strengthen exI[where x="Suc n" for n])
-  apply simp
-  apply blast
-  done
-
-lemma eq_Me_neq_Env:
-  "(x = Me) = (x \<noteq> Env)"
-  by (cases x; simp)
-
-lemma validI_invariant_imp:
-  assumes v: "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-    and P: "\<forall>s0 s. P s0 s \<longrightarrow> I s0"
-    and R: "\<forall>s0 s. I s0 \<longrightarrow> R s0 s \<longrightarrow> I s"
-    and G: "\<forall>s0 s. I s0 \<longrightarrow> G s0 s \<longrightarrow> I s"
-  shows "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. I s0 \<and> I s \<and> G s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. I s0 \<and> Q rv s0 s\<rbrace>"
-proof -
-  { fix tr s0 i
-  assume r: "rely_cond R s0 tr" and g: "guar_cond G s0 tr"
-    and I: "I s0"
-  hence imp: "\<forall>(_, s, s') \<in> trace_steps (rev tr) s0. I s \<longrightarrow> I s'"
-    apply (clarsimp simp: guar_cond_def rely_cond_def)
-    apply (drule(1) bspec)+
-    apply (clarsimp simp: eq_Me_neq_Env)
-    apply (metis R G)
-    done
-  hence "i < length tr \<longrightarrow> I (snd (rev tr ! i))"
-    using I
-    apply (induct i)
-     apply (clarsimp simp: neq_Nil_conv[where xs="rev tr" for tr, simplified])
-    apply clarsimp
-    apply (drule bspec, fastforce simp add: trace_steps_nth)
-    apply simp
-    done
-  }
-  note I = this
-  show ?thesis
-    using v
-    apply (clarsimp simp: validI_def rely_def imp_conjL)
-    apply (drule spec2, drule(1) mp)+
-    apply clarsimp
-    apply (frule P[rule_format])
-    apply (clarsimp simp: guar_cond_def trace_steps_nth I last_st_tr_def
-                          hd_append last_rev[symmetric]
-                          last_conv_nth rev_map)
-    done
-qed
-
-lemma validI_guar_post_conj_lift:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G1\<rbrace>,\<lbrace>Q1\<rbrace>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G2\<rbrace>,\<lbrace>Q2\<rbrace>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. G1 s0 s \<and> G2 s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. Q1 rv s0 s \<and> Q2 rv s0 s\<rbrace>"
-  apply (frule validI_prefix_closed)
-  apply (subst validI_def, clarsimp simp: rely_def)
-  apply (drule(3) validI_D)+
-  apply (auto simp: guar_cond_def)
-  done
-
-lemmas modify_prefix_closed[simp] =
-  modify_wp[THEN valid_validI_wp[OF no_trace_all(3)], THEN validI_prefix_closed]
-lemmas await_prefix_closed[simp] = Await_sync_twp[THEN validI_prefix_closed]
-
-lemma repeat_prefix_closed[intro!]:
-  "prefix_closed f \<Longrightarrow> prefix_closed (repeat f)"
-  apply (simp add: repeat_def)
-  apply (rule prefix_closed_bind; clarsimp)
-  apply (rename_tac n)
-  apply (induct_tac n; simp)
-  apply (auto intro: prefix_closed_bind)
-  done
-
-end
diff --git a/lib/Monads/trace/Trace_Monad.thy b/lib/Monads/trace/Trace_Monad.thy
index 3de9644457..ede246ed79 100644
--- a/lib/Monads/trace/Trace_Monad.thy
+++ b/lib/Monads/trace/Trace_Monad.thy
@@ -721,86 +721,4 @@ lemma parallel_def3:
     \<and> list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs})"
   by (simp add: parallel_def2, rule ext, auto simp: image_def)
 
-primrec
-  trace_steps :: "(tmid \<times> 's) list \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's \<times> 's) set" where
-  "trace_steps (elem # trace) s0 = {(fst elem, s0, snd elem)} \<union> trace_steps trace (snd elem)"
-| "trace_steps [] s0 = {}"
-
-lemma trace_steps_nth:
-  "trace_steps xs s0 = (\<lambda>i. (fst (xs ! i), (if i = 0 then s0 else snd (xs ! (i - 1))), snd (xs ! i))) ` {..< length xs}"
-proof (induct xs arbitrary: s0)
-  case Nil
-  show ?case by simp
-next
-  case (Cons a xs)
-  show ?case
-    apply (simp add: lessThan_Suc_eq_insert_0 Cons image_image nth_Cons')
-    apply (intro arg_cong2[where f=insert] refl image_cong)
-    apply simp
-    done
-qed
-
-text \<open>rg_pred type: Rely-Guaranty predicates (state before => state after => bool)\<close>
-type_synonym 's rg_pred = "'s \<Rightarrow> 's \<Rightarrow> bool"
-
-text \<open>Abbreviations for trivial postconditions (taking three arguments):\<close>
-abbreviation(input)
-  toptoptop :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>\<top>") where
-  "\<top>\<top>\<top> \<equiv> \<lambda>_ _ _. True"
-
-abbreviation(input)
-  botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>") where
-  "\<bottom>\<bottom>\<bottom> \<equiv> \<lambda>_ _ _. False"
-
-definition rely_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
-  "rely_cond R s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Env \<longrightarrow> R s0 s)"
-
-definition guar_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
-  "guar_cond G s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Me \<longrightarrow> G s0 s)"
-
-lemma rg_empty_conds[simp]:
-  "rely_cond R s0s []"
-  "guar_cond G s0s []"
-  by (simp_all add: rely_cond_def guar_cond_def)
-
-definition rely :: "('s, 'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> 's \<Rightarrow> ('s, 'a) tmonad" where
-  "rely f R s0s \<equiv> (\<lambda>s. f s \<inter> ({tr. rely_cond R s0s tr} \<times> UNIV))"
-
-definition prefix_closed :: "('s, 'a) tmonad \<Rightarrow> bool" where
-  "prefix_closed f = (\<forall>s. \<forall>x xs. (x # xs) \<in> fst ` f s \<longrightarrow> (xs, Incomplete) \<in> f s)"
-
-definition validI ::
-  "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's rg_pred \<Rightarrow> ('s,'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
-  ("(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)") where
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> \<equiv> prefix_closed f \<and> (\<forall>s0 s. P s0 s
-    \<longrightarrow> (\<forall>tr res. (tr, res) \<in> (rely f R s0 s) \<longrightarrow> guar_cond G s0 tr
-        \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
-
-lemma in_rely:
-  "\<lbrakk> (tr, res) \<in> f s; rely_cond R s0s tr \<rbrakk> \<Longrightarrow> (tr, res) \<in> rely f R s0s s"
-  by (simp add: rely_def)
-
-lemmas validI_D =
-  validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, rule_format, OF _ _ in_rely]
-lemmas validI_GD = validI_D[THEN conjunct1]
-lemmas validI_rvD = validI_D[THEN conjunct2, rule_format, rotated -1, OF refl]
-lemmas validI_prefix_closed = validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct1]
-lemmas validI_prefix_closed_T =
-  validI_prefix_closed[where P="\<lambda>_ _. False" and R="\<lambda>_ _. False" and G="\<lambda>_ _. True"
-                         and Q="\<lambda>_ _ _. True"]
-
-lemmas prefix_closedD1 = prefix_closed_def[THEN iffD1, rule_format]
-
-lemma in_fst_snd_image_eq:
-  "x \<in> fst ` S = (\<exists>y. (x, y) \<in> S)"
-  "y \<in> snd ` S = (\<exists>x. (x, y) \<in> S)"
-  by (auto elim: image_eqI[rotated])
-
-lemma in_fst_snd_image:
-  "(x, y) \<in> S \<Longrightarrow> x \<in> fst ` S"
-  "(x, y) \<in> S \<Longrightarrow> y \<in> snd ` S"
-  by (auto simp: in_fst_snd_image_eq)
-
-lemmas prefix_closedD = prefix_closedD1[OF _ in_fst_snd_image(1)]
-
 end
diff --git a/lib/Monads/trace/Trace_Monad_Equations.thy b/lib/Monads/trace/Trace_Monad_Equations.thy
index 4fef376434..a2072db008 100644
--- a/lib/Monads/trace/Trace_Monad_Equations.thy
+++ b/lib/Monads/trace/Trace_Monad_Equations.thy
@@ -45,4 +45,207 @@ lemma fail_bind[simp]:
   "fail >>= f = fail"
   by (simp add: bind_def fail_def)
 
+
+lemma mapM_Cons:
+  "mapM f (x # xs) = do
+    y \<leftarrow> f x;
+    ys \<leftarrow> mapM f xs;
+    return (y # ys)
+  od"
+  and mapM_Nil:
+  "mapM f [] = return []"
+  by (simp_all add: mapM_def sequence_def)
+
+lemma mapM_x_Cons:
+  "mapM_x f (x # xs) = do
+    y \<leftarrow> f x;
+    mapM_x f xs
+  od"
+  and mapM_x_Nil:
+  "mapM_x f [] = return ()"
+  by (simp_all add: mapM_x_def sequence_x_def)
+
+lemma mapM_append:
+  "mapM f (xs @ ys) = (do
+    fxs \<leftarrow> mapM f xs;
+    fys \<leftarrow> mapM f ys;
+    return (fxs @ fys)
+  od)"
+  by (induct xs, simp_all add: mapM_Cons mapM_Nil bind_assoc)
+
+lemma mapM_x_append:
+  "mapM_x f (xs @ ys) = (do
+    x \<leftarrow> mapM_x f xs;
+    mapM_x f ys
+  od)"
+  by (induct xs, simp_all add: mapM_x_Cons mapM_x_Nil bind_assoc)
+
+lemma mapM_map:
+  "mapM f (map g xs) = mapM (f o g) xs"
+  by (induct xs; simp add: mapM_Nil mapM_Cons)
+
+lemma mapM_x_map:
+  "mapM_x f (map g xs) = mapM_x (f o g) xs"
+  by (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
+
+primrec
+  repeat_n :: "nat \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
+where
+    "repeat_n 0 f = return ()"
+  | "repeat_n (Suc n) f = do f; repeat_n n f od"
+
+lemma repeat_n_mapM_x:
+  "repeat_n n f = mapM_x (\<lambda>_. f) (replicate n ())"
+  by (induct n, simp_all add: mapM_x_Cons mapM_x_Nil)
+
+definition
+  repeat :: "('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
+where
+  "repeat f = do n \<leftarrow> select UNIV; repeat_n n f od"
+
+definition
+  env_step :: "('s,unit) tmonad"
+where
+  "env_step =
+  (do
+    s' \<leftarrow> select UNIV;
+    put_trace_elem (Env, s');
+    put s'
+  od)"
+
+abbreviation
+  "env_n_steps n \<equiv> repeat_n n env_step"
+
+lemma elem_select_bind:
+  "(tr, res) \<in> (do x \<leftarrow> select S; f x od) s
+    = (\<exists>x \<in> S. (tr, res) \<in> f x s)"
+  by (simp add: bind_def select_def)
+
+lemma select_bind_UN:
+  "(do x \<leftarrow> select S; f x od) = (\<lambda>s. \<Union>x \<in> S. f x s)"
+  by (rule ext, auto simp: elem_select_bind)
+
+lemma select_early:
+  "S \<noteq> {}
+    \<Longrightarrow> do x \<leftarrow> f; y \<leftarrow> select S; g x y od
+        = do y \<leftarrow> select S; x \<leftarrow> f; g x y od"
+  apply (simp add: bind_def select_def Sigma_def)
+  apply (rule ext)
+  apply (fastforce elim: rev_bexI image_eqI[rotated] split: tmres.split_asm)
+  done
+
+lemma repeat_n_choice:
+  "S \<noteq> {}
+    \<Longrightarrow> repeat_n n (do x \<leftarrow> select S; f x od)
+        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S \<and> length xs = n}; mapM_x f xs od)"
+  apply (induct n; simp?)
+   apply (simp add: select_def bind_def mapM_x_Nil cong: conj_cong)
+  apply (simp add: select_early bind_assoc)
+  apply (subst select_early)
+   apply simp
+   apply (auto intro: exI[where x="replicate n xs" for n xs])[1]
+  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
+  apply (simp only: conj_comms[where Q="length xs = n" for xs n])
+  apply (simp only: ex_simps[symmetric] conj_assoc length_Suc_conv, simp)
+  apply (auto simp: mapM_x_Cons)
+  done
+
+lemma repeat_choice:
+  "S \<noteq> {}
+    \<Longrightarrow> repeat (do x \<leftarrow> select S; f x od)
+        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S}; mapM_x f xs od)"
+  apply (simp add: repeat_def repeat_n_choice)
+  apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
+  done
+
+lemma put_trace_append:
+  "put_trace (xs @ ys) = do put_trace ys; put_trace xs od"
+  by (induct xs; simp add: bind_assoc)
+
+lemma put_trace_elem_put_comm:
+  "do y \<leftarrow> put_trace_elem x; put s od
+    = do y \<leftarrow> put s; put_trace_elem x od"
+  by (simp add: put_def put_trace_elem_def bind_def insert_commute)
+
+lemma put_trace_put_comm:
+  "do y \<leftarrow> put_trace xs; put s od
+    = do y \<leftarrow> put s; put_trace xs od"
+  apply (rule sym; induct xs; simp)
+  apply (simp add: bind_assoc put_trace_elem_put_comm)
+  apply (simp add: bind_assoc[symmetric])
+  done
+
+lemma mapM_x_comm:
+  "(\<forall>x \<in> set xs. do y \<leftarrow> g; f x od = do y \<leftarrow> f x; g od)
+    \<Longrightarrow> do y \<leftarrow> g; mapM_x f xs od = do y \<leftarrow> mapM_x f xs; g od"
+  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
+  apply (simp add: bind_assoc[symmetric], simp add: bind_assoc)
+  done
+
+lemma mapM_x_split:
+  "(\<forall>x \<in> set xs. \<forall>y \<in> set xs. do z \<leftarrow> g y; f x od = do (z :: unit) \<leftarrow> f x; g y od)
+    \<Longrightarrow> mapM_x (\<lambda>x. do z \<leftarrow> f x; g x od) xs = do y \<leftarrow> mapM_x f xs; mapM_x g xs od"
+  apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons bind_assoc)
+  apply (subst bind_assoc[symmetric], subst mapM_x_comm[where f=f and g="g x" for x])
+   apply simp
+  apply (simp add: bind_assoc)
+  done
+
+lemma mapM_x_put:
+  "mapM_x put xs = unless (xs = []) (put (last xs))"
+  apply (induct xs rule: rev_induct)
+   apply (simp add: mapM_x_Nil unless_def when_def)
+  apply (simp add: mapM_x_append mapM_x_Cons mapM_x_Nil)
+  apply (simp add: bind_def unless_def when_def put_def return_def)
+  done
+
+lemma put_trace_mapM_x:
+  "put_trace xs = mapM_x put_trace_elem (rev xs)"
+  by (induct xs; simp add: mapM_x_Nil mapM_x_append mapM_x_Cons)
+
+lemma rev_surj:
+  "surj rev"
+  by (rule_tac f=rev in surjI, simp)
+
+lemma select_image:
+  "select (f ` S) = do x \<leftarrow> select S; return (f x) od"
+  by (auto simp add: bind_def select_def return_def Sigma_def)
+
+lemma env_steps_repeat:
+  "env_steps = repeat env_step"
+  apply (simp add: env_step_def repeat_choice env_steps_def
+                   select_early)
+  apply (simp add: put_trace_elem_put_comm)
+  apply (simp add: mapM_x_split put_trace_elem_put_comm put_trace_put_comm
+                   mapM_x_put)
+  apply (simp add: put_trace_mapM_x rev_map mapM_x_map o_def)
+  apply (subst rev_surj[symmetric], simp add: select_image bind_assoc)
+  apply (rule arg_cong2[where f=bind, OF refl ext])
+  apply (simp add: bind_def get_def put_def unless_def when_def return_def)
+  apply (simp add: last_st_tr_def hd_map hd_rev)
+  done
+
+lemma repeat_n_plus:
+  "repeat_n (n + m) f = do repeat_n n f; repeat_n m f od"
+  by (induct n; simp add: bind_assoc)
+
+lemma repeat_eq_twice[simp]:
+  "(do x \<leftarrow> repeat f; repeat f od) = repeat f"
+  apply (simp add: repeat_def select_early)
+  apply (simp add: bind_assoc repeat_n_plus[symmetric, simplified])
+  apply (simp add: bind_def select_def Sigma_def)
+  apply (rule ext, fastforce intro: exI[where x=0])
+  done
+
+lemmas repeat_eq_twice_then[simp]
+    = repeat_eq_twice[THEN bind_then_eq, simplified bind_assoc]
+
+lemmas env_steps_eq_twice[simp]
+    = repeat_eq_twice[where f=env_step, folded env_steps_repeat]
+lemmas env_steps_eq_twice_then[simp]
+    = env_steps_eq_twice[THEN bind_then_eq, simplified bind_assoc]
+
+lemmas mapM_collapse_append = mapM_append[symmetric, THEN bind_then_eq,
+    simplified bind_assoc, simplified]
+
 end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_No_Trace.thy b/lib/Monads/trace/Trace_No_Trace.thy
new file mode 100644
index 0000000000..aff4cab62e
--- /dev/null
+++ b/lib/Monads/trace/Trace_No_Trace.thy
@@ -0,0 +1,70 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_No_Trace
+  imports
+    Trace_Monad
+    WPSimp
+begin
+
+definition
+  no_trace :: "('s,'a) tmonad  \<Rightarrow> bool"
+where
+  "no_trace f = (\<forall>tr res s. (tr, res) \<in> f s \<longrightarrow> tr = [] \<and> res \<noteq> Incomplete)"
+
+lemmas no_traceD = no_trace_def[THEN iffD1, rule_format]
+
+lemma no_trace_emp:
+  "no_trace f \<Longrightarrow> (tr, r) \<in> f s \<Longrightarrow> tr = []"
+  by (simp add: no_traceD)
+
+lemma no_trace_Incomplete_mem:
+  "no_trace f \<Longrightarrow> (tr, Incomplete) \<notin> f s"
+  by (auto dest: no_traceD)
+
+lemma no_trace_Incomplete_eq:
+  "no_trace f \<Longrightarrow> (tr, res) \<in> f s \<Longrightarrow> res \<noteq> Incomplete"
+  by (auto dest: no_traceD)
+
+lemma no_trace_is_triple:
+  "no_trace f = triple_judgement \<top> f (\<lambda>() f. id no_trace f)"
+  by (simp add: triple_judgement_def split: unit.split)
+
+lemmas [wp_trip] = no_trace_is_triple
+
+(* Since valid_validI_wp in wp_comb doesn't work, we add the rules directly in the wp set *)
+lemma no_trace_prim:
+  "no_trace get"
+  "no_trace (put s)"
+  "no_trace (modify f)"
+  "no_trace (return v)"
+  "no_trace fail"
+  by (simp_all add: no_trace_def get_def put_def modify_def bind_def
+                    return_def select_def fail_def)
+
+lemma no_trace_select:
+  "no_trace (select S)"
+  by (clarsimp simp add: no_trace_def select_def)
+
+lemma no_trace_bind:
+  "no_trace f \<Longrightarrow> \<forall>rv. no_trace (g rv)
+    \<Longrightarrow> no_trace (do rv \<leftarrow> f; g rv od)"
+  apply (subst no_trace_def)
+  apply (clarsimp simp add: bind_def split: tmres.split_asm;
+    auto dest: no_traceD[rotated])
+  done
+
+lemma no_trace_extra:
+  "no_trace (gets f)"
+  "no_trace (assert P)"
+  "no_trace (assert_opt Q)"
+  by (simp_all add: gets_def assert_def assert_opt_def no_trace_bind no_trace_prim
+             split: option.split)
+
+lemmas no_trace_all[wp, iff] = no_trace_prim no_trace_select no_trace_extra
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_RG.thy b/lib/Monads/trace/Trace_RG.thy
new file mode 100644
index 0000000000..6aef80035f
--- /dev/null
+++ b/lib/Monads/trace/Trace_RG.thy
@@ -0,0 +1,691 @@
+(*
+ * Copyright 2023, Proofcraft Pty Ltd
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: BSD-2-Clause
+ *)
+
+theory Trace_RG
+  imports
+    Trace_VCG
+    Trace_Monad_Equations
+    Trace_No_Trace
+begin
+
+primrec
+  trace_steps :: "(tmid \<times> 's) list \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's \<times> 's) set" where
+  "trace_steps (elem # trace) s0 = {(fst elem, s0, snd elem)} \<union> trace_steps trace (snd elem)"
+| "trace_steps [] s0 = {}"
+
+lemma trace_steps_nth:
+  "trace_steps xs s0 = (\<lambda>i. (fst (xs ! i), (if i = 0 then s0 else snd (xs ! (i - 1))), snd (xs ! i))) ` {..< length xs}"
+proof (induct xs arbitrary: s0)
+  case Nil
+  show ?case by simp
+next
+  case (Cons a xs)
+  show ?case
+    apply (simp add: lessThan_Suc_eq_insert_0 Cons image_image nth_Cons')
+    apply (intro arg_cong2[where f=insert] refl image_cong)
+    apply simp
+    done
+qed
+
+text \<open>rg_pred type: Rely-Guaranty predicates (state before => state after => bool)\<close>
+type_synonym 's rg_pred = "'s \<Rightarrow> 's \<Rightarrow> bool"
+
+text \<open>Abbreviations for trivial postconditions (taking three arguments):\<close>
+abbreviation(input)
+  toptoptop :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>\<top>") where
+  "\<top>\<top>\<top> \<equiv> \<lambda>_ _ _. True"
+
+abbreviation(input)
+  botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>") where
+  "\<bottom>\<bottom>\<bottom> \<equiv> \<lambda>_ _ _. False"
+
+definition rely_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
+  "rely_cond R s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Env \<longrightarrow> R s0 s)"
+
+definition guar_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
+  "guar_cond G s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Me \<longrightarrow> G s0 s)"
+
+lemma rg_empty_conds[simp]:
+  "rely_cond R s0s []"
+  "guar_cond G s0s []"
+  by (simp_all add: rely_cond_def guar_cond_def)
+
+definition rely :: "('s, 'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> 's \<Rightarrow> ('s, 'a) tmonad" where
+  "rely f R s0s \<equiv> (\<lambda>s. f s \<inter> ({tr. rely_cond R s0s tr} \<times> UNIV))"
+
+definition prefix_closed :: "('s, 'a) tmonad \<Rightarrow> bool" where
+  "prefix_closed f = (\<forall>s. \<forall>x xs. (x # xs) \<in> fst ` f s \<longrightarrow> (xs, Incomplete) \<in> f s)"
+
+definition validI ::
+  "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's rg_pred \<Rightarrow> ('s,'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
+  ("(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)") where
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> \<equiv> prefix_closed f \<and> (\<forall>s0 s. P s0 s
+    \<longrightarrow> (\<forall>tr res. (tr, res) \<in> (rely f R s0 s) \<longrightarrow> guar_cond G s0 tr
+        \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
+
+(*
+text \<open>Validity for exception monad with interferences. Not as easy to phrase
+ as we need to \<close>
+definition validIE :: "('s, 'a + 'b) tmonad \<Rightarrow>
+             's rg_pred \<Rightarrow>
+             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
+             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
+             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
+ ("_ //PRE _//RELY _//GUAR _//POST _//EXC _" [59,0,0,0,0,0] 60) where
+  "validIE f P R G Q E \<equiv> f SAT [P,R,G,\<lambda>v. case v of Inr r \<Rightarrow> Q r | Inl e \<Rightarrow> E e]"
+
+abbreviation (input)
+  validIEsat :: "('s, 'a + 'b) tmonad \<Rightarrow>
+             's rg_pred \<Rightarrow>
+             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
+             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
+             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
+  ("_ //SAT [_, _, _, _, _]" [59,0,0,0,0,0] 60)
+  where
+  "validIEsat f P R G Q E \<equiv> validIE f P R G Q E"
+ *)
+
+lemma in_rely:
+  "\<lbrakk> (tr, res) \<in> f s; rely_cond R s0s tr \<rbrakk> \<Longrightarrow> (tr, res) \<in> rely f R s0s s"
+  by (simp add: rely_def)
+
+lemmas validI_D =
+  validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, rule_format, OF _ _ in_rely]
+lemmas validI_GD = validI_D[THEN conjunct1]
+lemmas validI_rvD = validI_D[THEN conjunct2, rule_format, rotated -1, OF refl]
+lemmas validI_prefix_closed = validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct1]
+lemmas validI_prefix_closed_T =
+  validI_prefix_closed[where P="\<lambda>_ _. False" and R="\<lambda>_ _. False" and G="\<lambda>_ _. True"
+                         and Q="\<lambda>_ _ _. True"]
+
+lemmas prefix_closedD1 = prefix_closed_def[THEN iffD1, rule_format]
+
+lemma in_fst_snd_image_eq:
+  "x \<in> fst ` S = (\<exists>y. (x, y) \<in> S)"
+  "y \<in> snd ` S = (\<exists>x. (x, y) \<in> S)"
+  by (auto elim: image_eqI[rotated])
+
+lemma in_fst_snd_image:
+  "(x, y) \<in> S \<Longrightarrow> x \<in> fst ` S"
+  "(x, y) \<in> S \<Longrightarrow> y \<in> snd ` S"
+  by (auto simp: in_fst_snd_image_eq)
+
+lemmas prefix_closedD = prefix_closedD1[OF _ in_fst_snd_image(1)]
+
+lemma trace_steps_append:
+  "trace_steps (xs @ ys) s
+    = trace_steps xs s \<union> trace_steps ys (last_st_tr (rev xs) s)"
+  by (induct xs arbitrary: s, simp_all add: last_st_tr_def hd_append)
+
+lemma rely_cond_append:
+  "rely_cond R s (xs @ ys) = (rely_cond R s ys \<and> rely_cond R (last_st_tr ys s) xs)"
+  by (simp add: rely_cond_def trace_steps_append ball_Un conj_comms)
+
+lemma guar_cond_append:
+  "guar_cond G s (xs @ ys) = (guar_cond G s ys \<and> guar_cond G (last_st_tr ys s) xs)"
+  by (simp add: guar_cond_def trace_steps_append ball_Un conj_comms)
+
+lemma prefix_closed_bind:
+  "prefix_closed f \<Longrightarrow> (\<forall>x. prefix_closed (g x)) \<Longrightarrow> prefix_closed (f >>= g)"
+  apply (subst prefix_closed_def, clarsimp simp: bind_def)
+  apply (auto simp: Cons_eq_append_conv split: tmres.split_asm
+             dest!: prefix_closedD[rotated];
+    fastforce elim: rev_bexI)
+  done
+
+lemmas prefix_closed_bind[rule_format, wp_split]
+
+lemma last_st_tr_append[simp]:
+  "last_st_tr (tr @ tr') s = last_st_tr tr (last_st_tr tr' s)"
+  by (simp add: last_st_tr_def hd_append)
+
+lemma last_st_tr_Nil[simp]:
+  "last_st_tr [] s = s"
+  by (simp add: last_st_tr_def)
+
+lemma last_st_tr_Cons[simp]:
+  "last_st_tr (x # xs) s = snd x"
+  by (simp add: last_st_tr_def)
+
+lemma bind_twp[wp_split]:
+  "\<lbrakk>  \<And>r. \<lbrace>Q' r\<rbrace>,\<lbrace>R\<rbrace> g r \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f >>= (\<lambda>r. g r) \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (subst validI_def, rule conjI)
+   apply (blast intro: prefix_closed_bind validI_prefix_closed)
+  apply (clarsimp simp: bind_def rely_def)
+  apply (drule(2) validI_D)
+   apply (clarsimp simp: rely_cond_append split: tmres.split_asm)
+  apply (clarsimp split: tmres.split_asm)
+  apply (drule meta_spec, frule(2) validI_D)
+   apply (clarsimp simp: rely_cond_append split: if_split_asm)
+  apply (clarsimp simp: guar_cond_append)
+  done
+
+lemma trace_steps_rev_drop_nth:
+  "trace_steps (rev (drop n tr)) s
+        = (\<lambda>i. (fst (rev tr ! i), (if i = 0 then s else snd (rev tr ! (i - 1))),
+            snd (rev tr ! i))) ` {..< length tr - n}"
+  apply (simp add: trace_steps_nth)
+  apply (intro image_cong refl)
+  apply (simp add: rev_nth)
+  done
+
+lemma prefix_closed_drop:
+  "(tr, res) \<in> f s \<Longrightarrow> prefix_closed f \<Longrightarrow> \<exists>res'. (drop n tr, res') \<in> f s"
+proof (induct n arbitrary: res)
+  case 0 then show ?case by auto
+next
+  case (Suc n)
+  have drop_1: "\<And>tr res. (tr, res) \<in> f s \<Longrightarrow> \<exists>res'. (drop 1 tr, res') \<in> f s"
+    by (case_tac tr; fastforce dest: prefix_closedD[rotated] intro: Suc)
+  show ?case
+    using Suc.hyps[OF Suc.prems]
+    by (metis drop_1[simplified] drop_drop add_0 add_Suc)
+qed
+
+lemma validI_GD_drop:
+  "\<lbrakk> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>; P s0 s; (tr, res) \<in> f s;
+        rely_cond R s0 (drop n tr) \<rbrakk>
+    \<Longrightarrow> guar_cond G s0 (drop n tr)"
+  apply (drule prefix_closed_drop[where n=n], erule validI_prefix_closed)
+  apply (auto dest: validI_GD)
+  done
+
+lemma parallel_prefix_closed[wp_split]:
+  "prefix_closed f \<Longrightarrow> prefix_closed g
+    \<Longrightarrow> prefix_closed (parallel f g)"
+  apply (subst prefix_closed_def, clarsimp simp: parallel_def)
+  apply (case_tac f_steps; clarsimp)
+  apply (drule(1) prefix_closedD)+
+  apply fastforce
+  done
+
+lemma rely_cond_drop:
+  "rely_cond R s0 xs \<Longrightarrow> rely_cond R s0 (drop n xs)"
+  using rely_cond_append[where xs="take n xs" and ys="drop n xs"]
+  by simp
+
+lemma rely_cond_is_drop:
+  "rely_cond R s0 xs
+    \<Longrightarrow> (ys = drop (length xs - length ys) xs)
+    \<Longrightarrow> rely_cond R s0 ys"
+  by (metis rely_cond_drop)
+
+lemma bounded_rev_nat_induct:
+  "(\<And>n. N \<le> n \<Longrightarrow> P n) \<Longrightarrow> (\<And>n. n < N \<Longrightarrow> P (Suc n) \<Longrightarrow> P n)
+    \<Longrightarrow> P n"
+  by (induct diff\<equiv>"N - n" arbitrary: n; simp)
+
+lemma drop_n_induct:
+  "P [] \<Longrightarrow> (\<And>n. n < length xs \<Longrightarrow> P (drop (Suc n) xs) \<Longrightarrow> P (drop n xs))
+    \<Longrightarrow> P (drop n xs)"
+  by (induct len\<equiv>"length (drop n xs)" arbitrary: n xs; simp)
+
+lemma guar_cond_Cons_eq:
+  "guar_cond R s0 (x # xs)
+        = (guar_cond R s0 xs \<and> (fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
+  by (cases "fst x"; simp add: guar_cond_def trace_steps_append conj_comms)
+
+lemma guar_cond_Cons:
+  "guar_cond R s0 xs
+    \<Longrightarrow> fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
+    \<Longrightarrow> guar_cond R s0 (x # xs)"
+  by (simp add: guar_cond_Cons_eq)
+
+lemma guar_cond_drop_Suc_eq:
+  "n < length xs
+    \<Longrightarrow> guar_cond R s0 (drop n xs) = (guar_cond R s0 (drop (Suc n) xs)
+        \<and> (fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
+  apply (rule trans[OF _ guar_cond_Cons_eq])
+  apply (simp add: Cons_nth_drop_Suc)
+  done
+
+lemma guar_cond_drop_Suc:
+  "guar_cond R s0 (drop (Suc n) xs)
+    \<Longrightarrow> fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
+    \<Longrightarrow> guar_cond R s0 (drop n xs)"
+  by (case_tac "n < length xs"; simp add: guar_cond_drop_Suc_eq)
+
+lemma rely_cond_Cons_eq:
+  "rely_cond R s0 (x # xs)
+        = (rely_cond R s0 xs \<and> (fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
+  by (simp add: rely_cond_def trace_steps_append conj_comms)
+
+lemma rely_cond_Cons:
+  "rely_cond R s0 xs
+    \<Longrightarrow> fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
+    \<Longrightarrow> rely_cond R s0 (x # xs)"
+  by (simp add: rely_cond_Cons_eq)
+
+lemma rely_cond_drop_Suc_eq:
+  "n < length xs
+    \<Longrightarrow> rely_cond R s0 (drop n xs) = (rely_cond R s0 (drop (Suc n) xs)
+        \<and> (fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
+  apply (rule trans[OF _ rely_cond_Cons_eq])
+  apply (simp add: Cons_nth_drop_Suc)
+  done
+
+lemma rely_cond_drop_Suc:
+  "rely_cond R s0 (drop (Suc n) xs)
+    \<Longrightarrow> fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
+    \<Longrightarrow> rely_cond R s0 (drop n xs)"
+  by (cases "n < length xs"; simp add: rely_cond_drop_Suc_eq)
+
+lemma last_st_tr_map_zip_hd:
+  "length flags = length tr
+    \<Longrightarrow> tr \<noteq> [] \<longrightarrow> snd (f (hd flags, hd tr)) = snd (hd tr)
+    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
+  apply (cases tr; simp)
+  apply (cases flags; simp)
+  apply (simp add: fun_eq_iff)
+  done
+
+lemma last_st_tr_drop_map_zip_hd:
+  "length flags = length tr
+    \<Longrightarrow> n < length tr \<longrightarrow> snd (f (flags ! n, tr ! n)) = snd (tr ! n)
+    \<Longrightarrow> last_st_tr (drop n (map f (zip flags tr))) = last_st_tr (drop n tr)"
+  apply (simp add: drop_map drop_zip)
+  apply (rule last_st_tr_map_zip_hd; clarsimp)
+  apply (simp add: hd_drop_conv_nth)
+  done
+
+lemma last_st_tr_map_zip:
+  "length flags = length tr
+    \<Longrightarrow> \<forall>fl tmid s. snd (f (fl, (tmid, s))) = s
+    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
+  apply (erule last_st_tr_map_zip_hd)
+  apply (clarsimp simp: neq_Nil_conv)
+  done
+
+lemma parallel_rely_induct:
+  assumes preds: "(tr, v) \<in> parallel f g s" "Pf s0 s" "Pg s0 s"
+  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f' \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
+     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g' \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
+     "f s \<subseteq> f' s" "g s \<subseteq> g' s"
+  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
+     "Gf \<le> Rg" "Gg \<le> Rf"
+  and rely: "rely_cond R s0 (drop n tr)"
+  shows "\<exists>tr_f tr_g. (tr_f, v) \<in> f s \<and> (tr_g, v) \<in> g s
+      \<and> rely_cond Rf s0 (drop n tr_f) \<and> rely_cond Rg s0 (drop n tr_g)
+      \<and> map snd tr_f = map snd tr \<and> map snd tr_g = map snd tr
+      \<and> (\<forall>i \<le> length tr. last_st_tr (drop i tr_g) s0 = last_st_tr (drop i tr_f) s0)
+      \<and> guar_cond G s0 (drop n tr)"
+  (is "\<exists>ys zs. _ \<and> _ \<and> ?concl ys zs")
+proof -
+  obtain ys zs where tr: "tr = map parallel_mrg (zip ys zs)"
+      and all2: "list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs"
+      and ys: "(ys, v) \<in> f s" and zs: "(zs, v) \<in> g s"
+    using preds
+    by (clarsimp simp: parallel_def2)
+  note len[simp] = list_all2_lengthD[OF all2]
+
+  have ys': "(ys, v) \<in> f' s" and zs': "(zs, v) \<in> g' s"
+    using ys zs validI by auto
+
+  note rely_f_step = validI_GD_drop[OF validI(1) preds(2) ys' rely_cond_drop_Suc]
+  note rely_g_step = validI_GD_drop[OF validI(2) preds(3) zs' rely_cond_drop_Suc]
+
+  note snd[simp] = list_all2_nthD[OF all2, THEN conjunct2]
+
+  have "?concl ys zs"
+    using rely tr all2 rely_f_step rely_g_step
+    apply (induct n rule: bounded_rev_nat_induct)
+     apply (subst drop_all, assumption)
+     apply clarsimp
+     apply (simp add: list_all2_conv_all_nth last_st_tr_def drop_map[symmetric]
+                      hd_drop_conv_nth hd_append)
+     apply (fastforce simp: split_def intro!: nth_equalityI)
+     apply clarsimp
+    apply (erule_tac x=n in meta_allE)+
+    apply (drule meta_mp, erule rely_cond_is_drop, simp)
+    apply (subst(asm) rely_cond_drop_Suc_eq[where xs="map f xs" for f xs], simp)
+    apply (clarsimp simp: last_st_tr_drop_map_zip_hd if_split[where P="\<lambda>x. x = Env"]
+                          split_def)
+    apply (intro conjI; (rule guar_cond_drop_Suc rely_cond_drop_Suc, assumption))
+      apply (auto simp: guar_cond_drop_Suc_eq last_st_tr_drop_map_zip_hd
+                 intro: compat[THEN predicate2D])
+    done
+
+  thus ?thesis
+    using ys zs
+    by auto
+qed
+
+lemmas parallel_rely_induct0 = parallel_rely_induct[where n=0, simplified]
+
+lemma rg_validI:
+  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
+     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
+  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
+     "Gf \<le> Rg" "Gg \<le> Rf"
+  shows "\<lbrace>Pf and Pg\<rbrace>,\<lbrace>R\<rbrace> parallel f g \<lbrace>G\<rbrace>,\<lbrace>\<lambda>rv. Qf rv and Qg rv\<rbrace>"
+  apply (clarsimp simp: validI_def rely_def pred_conj_def
+                        parallel_prefix_closed validI[THEN validI_prefix_closed])
+  apply (drule(3) parallel_rely_induct0[OF _ _ _ validI order_refl order_refl compat])
+  apply clarsimp
+  apply (drule(2) validI[THEN validI_rvD])+
+  apply (simp add: last_st_tr_def)
+  done
+
+lemma validI_weaken_pre[wp_pre]:
+  "\<lbrace>P'\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
+    \<Longrightarrow> (\<And>s0 s. P s0 s \<Longrightarrow> P' s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (simp add: validI_def, blast)
+
+lemma rely_weaken:
+  "(\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
+    \<Longrightarrow> (tr, res) \<in> rely f R s s0 \<Longrightarrow> (tr, res) \<in> rely f R' s s0"
+  by (simp add: rely_def rely_cond_def, blast)
+
+lemma validI_weaken_rely[wp_pre]:
+  "\<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
+    \<Longrightarrow> (\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: validI_def)
+  by (metis rely_weaken)
+
+lemma validI_strengthen_post:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace>
+    \<Longrightarrow> (\<forall>v s0 s. Q' v s0 s \<longrightarrow> Q v s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (simp add: validI_def)
+
+lemma validI_strengthen_guar:
+  "\<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G'\<rbrace>, \<lbrace>Q\<rbrace>
+    \<Longrightarrow> (\<forall>s0 s. G' s0 s \<longrightarrow> G s0 s)
+    \<Longrightarrow> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>"
+  by (force simp: validI_def guar_cond_def)
+
+lemma rely_prim[simp]:
+  "rely (\<lambda>s. insert (v s) (f s)) R s0 = (\<lambda>s. {x. x = v s \<and> rely_cond R s0 (fst x)} \<union> (rely f R s0 s))"
+  "rely (\<lambda>s. {}) R s0 = (\<lambda>_. {})"
+  by (auto simp: rely_def prod_eq_iff)
+
+lemma prefix_closed_put_trace_elem[iff]:
+  "prefix_closed (put_trace_elem x)"
+  by (clarsimp simp: prefix_closed_def put_trace_elem_def)
+
+lemma prefix_closed_return[iff]:
+  "prefix_closed (return x)"
+  by (simp add: prefix_closed_def return_def)
+
+lemma prefix_closed_put_trace[iff]:
+  "prefix_closed (put_trace tr)"
+  by (induct tr; clarsimp simp: prefix_closed_bind)
+
+lemma put_trace_eq_drop:
+  "put_trace xs s
+    = ((\<lambda>n. (drop n xs, if n = 0 then Result ((), s) else Incomplete)) ` {.. length xs})"
+  apply (induct xs)
+   apply (clarsimp simp: return_def)
+  apply (clarsimp simp: put_trace_elem_def bind_def)
+  apply (simp add: atMost_Suc_eq_insert_0 image_image)
+  apply (rule equalityI; clarsimp)
+   apply (split if_split_asm; clarsimp)
+   apply (auto intro: image_eqI[where x=0])[1]
+  apply (rule rev_bexI, simp)
+  apply clarsimp
+  done
+
+lemma put_trace_res:
+  "(tr, res) \<in> put_trace xs s
+    \<Longrightarrow> \<exists>n. tr = drop n xs \<and> n \<le> length xs
+        \<and> res = (case n of 0 \<Rightarrow> Result ((), s) | _ \<Rightarrow> Incomplete)"
+  apply (clarsimp simp: put_trace_eq_drop)
+  apply (case_tac n; auto intro: exI[where x=0])
+  done
+
+lemma put_trace_twp[wp]:
+  "\<lbrace>\<lambda>s0 s. (\<forall>n. rely_cond R s0 (drop n xs) \<longrightarrow> guar_cond G s0 (drop n xs))
+    \<and> (rely_cond R s0 xs \<longrightarrow> Q () (last_st_tr xs s0) s)\<rbrace>,\<lbrace>R\<rbrace> put_trace xs \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (clarsimp simp: validI_def rely_def)
+  apply (drule put_trace_res)
+  apply (clarsimp; clarsimp split: nat.split_asm)
+  done
+
+lemmas put_trace_elem_twp = put_trace_twp[where xs="[x]" for x, simplified]
+
+lemma prefix_closed_select[iff]:
+  "prefix_closed (select S)"
+  by (simp add: prefix_closed_def select_def image_def)
+
+lemma rely_cond_rtranclp:
+  "rely_cond R s (map (Pair Env) xs) \<Longrightarrow> rtranclp R s (last_st_tr (map (Pair Env) xs) s)"
+  apply (induct xs arbitrary: s rule: rev_induct)
+   apply simp
+  apply (clarsimp simp add: rely_cond_def)
+  apply (erule converse_rtranclp_into_rtranclp)
+  apply simp
+  done
+
+
+
+(* Attempt to define triple_judgement to use valid_validI_wp as wp_comb rule.
+   It doesn't work. It seems that wp_comb rules cannot take more than 1 assumption *)
+lemma validI_is_triple:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> =
+     triple_judgement (\<lambda>(s0, s). prefix_closed f \<longrightarrow> P s0 s) f
+                      (\<lambda>(s0,s) f. prefix_closed f \<and> (\<forall>tr res. (tr, res) \<in> rely f R s0 s
+                          \<longrightarrow> guar_cond G s0 tr
+                              \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
+  apply (simp add: triple_judgement_def validI_def )
+  apply (cases "prefix_closed f"; simp)
+  done
+
+lemmas [wp_trip] = validI_is_triple
+
+lemma no_trace_prefix_closed:
+  "no_trace f \<Longrightarrow> prefix_closed f"
+  by (auto simp add: prefix_closed_def dest: no_trace_emp)
+
+lemma valid_validI_wp[wp_comb]:
+  "no_trace f \<Longrightarrow> (\<And>s0. \<lbrace>P s0\<rbrace> f \<lbrace>\<lambda>v. Q v s0 \<rbrace>)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (fastforce simp: rely_def validI_def valid_def mres_def no_trace_prefix_closed dest: no_trace_emp
+    elim: image_eqI[rotated])
+
+lemma env_steps_twp[wp]:
+  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s0 s' \<longrightarrow> Q () s' s') \<and> Q () s0 s\<rbrace>,\<lbrace>R\<rbrace> env_steps \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: interference_def env_steps_def)
+  apply wp
+  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
+  apply (drule rely_cond_rtranclp)
+  apply (clarsimp simp add: last_st_tr_def hd_append)
+  done
+
+lemma interference_twp[wp]:
+  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s s' \<longrightarrow> Q () s' s') \<and> G s0 s\<rbrace>,\<lbrace>R\<rbrace>  interference \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: interference_def commit_step_def del: put_trace.simps)
+  apply wp
+  apply clarsimp
+  apply (simp add: drop_Cons nat.split rely_cond_def guar_cond_def)
+  done
+
+(* what Await does if we haven't committed our step is a little
+   strange. this assumes we have, which means s0 = s. we should
+   revisit this if we find a use for Await when this isn't the
+   case *)
+lemma Await_sync_twp:
+  "\<lbrace>\<lambda>s0 s. s = s0 \<and> (\<forall>x. R\<^sup>*\<^sup>* s0 x \<and> c x \<longrightarrow> Q () x x)\<rbrace>,\<lbrace>R\<rbrace> Await c \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: Await_def split_def)
+  apply wp
+  apply clarsimp
+  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
+  apply (drule rely_cond_rtranclp)
+  apply (simp add: o_def)
+  done
+
+(* FIXME: this needs adjustment, case_prod Q is unlikely to unify *)
+lemma wpc_helper_validI:
+  "(\<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>) \<Longrightarrow> wpc_helper (P, P', P'') (case_prod Q, Q', Q'') (\<lbrace>curry P\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>)"
+  by (clarsimp simp: wpc_helper_def elim!: validI_weaken_pre)
+
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> m \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>" wpc_helper_validI
+
+lemma mres_union:
+ "mres (a \<union> b) = mres a \<union> mres b"
+  by (simp add: mres_def image_Un)
+
+lemma mres_Failed_empty:
+  "mres ((\<lambda>xs. (xs, Failed)) ` X ) = {}"
+  "mres ((\<lambda>xs. (xs, Incomplete)) ` X ) = {}"
+  by (auto simp add: mres_def image_def)
+
+lemma det_set_option_eq:
+  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
+       (ts, Some (rr, ss)) \<in> m \<Longrightarrow> rr = r \<and> ss = s'"
+  by (metis UN_I option.set_intros prod.inject singleton_iff snd_conv)
+
+lemma det_set_option_eq':
+  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
+       Some (r, s') \<in> snd ` m"
+  using image_iff by fastforce
+
+lemma validI_name_pre:
+  "prefix_closed f \<Longrightarrow>
+  (\<And>s0 s. P s0 s \<Longrightarrow> \<lbrace>\<lambda>s0' s'. s0' = s0 \<and> s' = s\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>)
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  unfolding validI_def
+  by metis
+
+lemma validI_well_behaved':
+  "prefix_closed f
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G'\<rbrace>,\<lbrace>Q\<rbrace>
+    \<Longrightarrow> R \<le> R'
+    \<Longrightarrow> G' \<le> G
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (subst validI_def, clarsimp)
+  apply (clarsimp simp add: rely_def)
+  apply (drule (2)  validI_D)
+  apply (fastforce simp: rely_cond_def guar_cond_def)+
+  done
+
+lemmas validI_well_behaved = validI_well_behaved'[unfolded le_fun_def, simplified]
+
+
+
+lemma prefix_closed_mapM[rule_format, wp_split]:
+  "(\<forall>x \<in> set xs. prefix_closed (f x)) \<Longrightarrow> prefix_closed (mapM f xs)"
+  apply (induct xs)
+   apply (simp add: mapM_def sequence_def)
+  apply (clarsimp simp: mapM_Cons)
+  apply (intro prefix_closed_bind allI; clarsimp)
+  done
+
+lemmas bind_promote_If
+    = if_distrib[where f="\<lambda>f. bind f g" for g]
+      if_distrib[where f="\<lambda>g. bind f g" for f]
+
+lemma bind_promote_If2:
+  "do x \<leftarrow> f; if P then g x else h x od
+    = (if P then bind f g else bind f h)"
+  by simp
+
+lemma exec_put_trace[unfolded K_bind_def]:
+  "(do put_trace xs; f od) s
+    = (\<Union>n \<in> {n. 0 < n \<and> n \<le> length xs}. {(drop n xs, Incomplete)})
+        \<union> ((\<lambda>(a, b). (a @ xs, b)) ` f s)"
+  apply (simp add: put_trace_eq_drop bind_def)
+  apply (safe; (clarsimp split: if_split_asm)?;
+      fastforce intro: bexI[where x=0] rev_bexI)
+  done
+
+lemma UN_If_distrib:
+  "(\<Union>x \<in> S. if P x then A x else B x)
+    = ((\<Union>x \<in> S \<inter> {x. P x}. A x) \<union> (\<Union>x \<in> S \<inter> {x. \<not> P x}. B x))"
+  by (fastforce split: if_split_asm)
+
+lemma Await_redef:
+  "Await P = do
+    s1 \<leftarrow> select {s. P s};
+    env_steps;
+    s \<leftarrow> get;
+    select (if P s then {()} else {})
+  od"
+  apply (simp add: Await_def env_steps_def bind_assoc)
+  apply (cases "{s. P s} = {}")
+   apply (simp add: select_def bind_def get_def)
+  apply (rule ext)
+  apply (simp add: exec_get select_bind_UN put_then_get_then)
+  apply (simp add: bind_promote_If2 if_distribR if_distrib[where f=select])
+  apply (simp add: exec_put_trace cong: if_cong)
+  apply (simp add: put_def bind_def select_def cong: if_cong)
+  apply (strengthen equalityI)
+  apply clarsimp
+  apply (strengthen exI[where x="s # xs" for s xs])
+  apply (strengthen exI[where x="Suc n" for n])
+  apply simp
+  apply blast
+  done
+
+lemma eq_Me_neq_Env:
+  "(x = Me) = (x \<noteq> Env)"
+  by (cases x; simp)
+
+lemma validI_invariant_imp:
+  assumes v: "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+    and P: "\<forall>s0 s. P s0 s \<longrightarrow> I s0"
+    and R: "\<forall>s0 s. I s0 \<longrightarrow> R s0 s \<longrightarrow> I s"
+    and G: "\<forall>s0 s. I s0 \<longrightarrow> G s0 s \<longrightarrow> I s"
+  shows "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. I s0 \<and> I s \<and> G s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. I s0 \<and> Q rv s0 s\<rbrace>"
+proof -
+  { fix tr s0 i
+  assume r: "rely_cond R s0 tr" and g: "guar_cond G s0 tr"
+    and I: "I s0"
+  hence imp: "\<forall>(_, s, s') \<in> trace_steps (rev tr) s0. I s \<longrightarrow> I s'"
+    apply (clarsimp simp: guar_cond_def rely_cond_def)
+    apply (drule(1) bspec)+
+    apply (clarsimp simp: eq_Me_neq_Env)
+    apply (metis R G)
+    done
+  hence "i < length tr \<longrightarrow> I (snd (rev tr ! i))"
+    using I
+    apply (induct i)
+     apply (clarsimp simp: neq_Nil_conv[where xs="rev tr" for tr, simplified])
+    apply clarsimp
+    apply (drule bspec, fastforce simp add: trace_steps_nth)
+    apply simp
+    done
+  }
+  note I = this
+  show ?thesis
+    using v
+    apply (clarsimp simp: validI_def rely_def imp_conjL)
+    apply (drule spec2, drule(1) mp)+
+    apply clarsimp
+    apply (frule P[rule_format])
+    apply (clarsimp simp: guar_cond_def trace_steps_nth I last_st_tr_def
+                          hd_append last_rev[symmetric]
+                          last_conv_nth rev_map)
+    done
+qed
+
+lemma validI_guar_post_conj_lift:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G1\<rbrace>,\<lbrace>Q1\<rbrace>
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G2\<rbrace>,\<lbrace>Q2\<rbrace>
+    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. G1 s0 s \<and> G2 s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. Q1 rv s0 s \<and> Q2 rv s0 s\<rbrace>"
+  apply (frule validI_prefix_closed)
+  apply (subst validI_def, clarsimp simp: rely_def)
+  apply (drule(3) validI_D)+
+  apply (auto simp: guar_cond_def)
+  done
+
+lemmas modify_prefix_closed[simp] =
+  modify_wp[THEN valid_validI_wp[OF no_trace_all(3)], THEN validI_prefix_closed]
+lemmas await_prefix_closed[simp] = Await_sync_twp[THEN validI_prefix_closed]
+
+lemma repeat_prefix_closed[intro!]:
+  "prefix_closed f \<Longrightarrow> prefix_closed (repeat f)"
+  apply (simp add: repeat_def)
+  apply (rule prefix_closed_bind; clarsimp)
+  apply (rename_tac n)
+  apply (induct_tac n; simp)
+  apply (auto intro: prefix_closed_bind)
+  done
+
+end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_Strengthen_Setup.thy b/lib/Monads/trace/Trace_Strengthen_Setup.thy
index bd978d60c1..024d370f8b 100644
--- a/lib/Monads/trace/Trace_Strengthen_Setup.thy
+++ b/lib/Monads/trace/Trace_Strengthen_Setup.thy
@@ -9,7 +9,7 @@ theory Trace_Strengthen_Setup
   imports
     Strengthen
     Trace_No_Fail
-    Trace_VCG
+    Trace_RG
 begin
 
 section \<open>Strengthen setup.\<close>
diff --git a/lib/Monads/trace/Trace_VCG.thy b/lib/Monads/trace/Trace_VCG.thy
index 944650d4a7..12e2576aa0 100644
--- a/lib/Monads/trace/Trace_VCG.thy
+++ b/lib/Monads/trace/Trace_VCG.thy
@@ -32,8 +32,8 @@ text \<open>
   the monad satisfy the postcondition. Note that if the computation returns
   the empty set, the triple is trivially valid. This means @{term "assert P"}
   does not require us to prove that @{term P} holds, but rather allows us
-  to assume @{term P}! Proving non-failure is done via separate predicate and
-  calculus (see below).\<close>
+  to assume @{term P}! Proving non-failure is done via a separate predicate and
+  calculus (see Trace_No_Fail).\<close>
 
 definition valid :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
   ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>") where
@@ -58,27 +58,7 @@ definition validE ::
 lemma validE_def2:
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). case r of Inr b \<Rightarrow> Q b s' | Inl a \<Rightarrow> E a s')"
   by (unfold valid_def validE_def)
-(*
-text \<open>Validity for exception monad with interferences. Not as easy to phrase
- as we need to \<close>
-definition validIE :: "('s, 'a + 'b) tmonad \<Rightarrow>
-             's rg_pred \<Rightarrow>
-             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
-             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
-             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
- ("_ //PRE _//RELY _//GUAR _//POST _//EXC _" [59,0,0,0,0,0] 60) where
-  "validIE f P R G Q E \<equiv> f SAT [P,R,G,\<lambda>v. case v of Inr r \<Rightarrow> Q r | Inl e \<Rightarrow> E e]"
-
-abbreviation (input)
-  validIEsat :: "('s, 'a + 'b) tmonad \<Rightarrow>
-             's rg_pred \<Rightarrow>
-             's rg_pred \<Rightarrow> 's rg_pred \<Rightarrow>
-             ('b \<Rightarrow> 's rg_pred) \<Rightarrow>
-             ('a \<Rightarrow> 's rg_pred) \<Rightarrow> bool"
-  ("_ //SAT [_, _, _, _, _]" [59,0,0,0,0,0] 60)
-  where
-  "validIEsat f P R G Q E \<equiv> validIE f P R G Q E"
- *)
+
 text \<open>
   The following two instantiations are convenient to separate reasoning for exceptional and
   normal case.\<close>
@@ -1101,510 +1081,4 @@ lemma hoare_returnOk_sp:
   "\<lbrace>P\<rbrace> returnOk x \<lbrace>\<lambda>rv s. rv = x \<and> P s\<rbrace>, \<lbrace>Q\<rbrace>"
   by (simp add: valid_def validE_def returnOk_def return_def mres_def)
 
-
-
-
-lemma trace_steps_append:
-  "trace_steps (xs @ ys) s
-    = trace_steps xs s \<union> trace_steps ys (last_st_tr (rev xs) s)"
-  by (induct xs arbitrary: s, simp_all add: last_st_tr_def hd_append)
-
-lemma rely_cond_append:
-  "rely_cond R s (xs @ ys) = (rely_cond R s ys \<and> rely_cond R (last_st_tr ys s) xs)"
-  by (simp add: rely_cond_def trace_steps_append ball_Un conj_comms)
-
-lemma guar_cond_append:
-  "guar_cond G s (xs @ ys) = (guar_cond G s ys \<and> guar_cond G (last_st_tr ys s) xs)"
-  by (simp add: guar_cond_def trace_steps_append ball_Un conj_comms)
-
-lemma prefix_closed_bind:
-  "prefix_closed f \<Longrightarrow> (\<forall>x. prefix_closed (g x)) \<Longrightarrow> prefix_closed (f >>= g)"
-  apply (subst prefix_closed_def, clarsimp simp: bind_def)
-  apply (auto simp: Cons_eq_append_conv split: tmres.split_asm
-             dest!: prefix_closedD[rotated];
-    fastforce elim: rev_bexI)
-  done
-
-lemmas prefix_closed_bind[rule_format, wp_split]
-
-lemma last_st_tr_append[simp]:
-  "last_st_tr (tr @ tr') s = last_st_tr tr (last_st_tr tr' s)"
-  by (simp add: last_st_tr_def hd_append)
-
-lemma last_st_tr_Nil[simp]:
-  "last_st_tr [] s = s"
-  by (simp add: last_st_tr_def)
-
-lemma last_st_tr_Cons[simp]:
-  "last_st_tr (x # xs) s = snd x"
-  by (simp add: last_st_tr_def)
-
-lemma bind_twp[wp_split]:
-  "\<lbrakk>  \<And>r. \<lbrace>Q' r\<rbrace>,\<lbrace>R\<rbrace> g r \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f >>= (\<lambda>r. g r) \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (subst validI_def, rule conjI)
-   apply (blast intro: prefix_closed_bind validI_prefix_closed)
-  apply (clarsimp simp: bind_def rely_def)
-  apply (drule(2) validI_D)
-   apply (clarsimp simp: rely_cond_append split: tmres.split_asm)
-  apply (clarsimp split: tmres.split_asm)
-  apply (drule meta_spec, frule(2) validI_D)
-   apply (clarsimp simp: rely_cond_append split: if_split_asm)
-  apply (clarsimp simp: guar_cond_append)
-  done
-
-lemma trace_steps_rev_drop_nth:
-  "trace_steps (rev (drop n tr)) s
-        = (\<lambda>i. (fst (rev tr ! i), (if i = 0 then s else snd (rev tr ! (i - 1))),
-            snd (rev tr ! i))) ` {..< length tr - n}"
-  apply (simp add: trace_steps_nth)
-  apply (intro image_cong refl)
-  apply (simp add: rev_nth)
-  done
-
-lemma prefix_closed_drop:
-  "(tr, res) \<in> f s \<Longrightarrow> prefix_closed f \<Longrightarrow> \<exists>res'. (drop n tr, res') \<in> f s"
-proof (induct n arbitrary: res)
-  case 0 then show ?case by auto
-next
-  case (Suc n)
-  have drop_1: "\<And>tr res. (tr, res) \<in> f s \<Longrightarrow> \<exists>res'. (drop 1 tr, res') \<in> f s"
-    by (case_tac tr; fastforce dest: prefix_closedD[rotated] intro: Suc)
-  show ?case
-    using Suc.hyps[OF Suc.prems]
-    by (metis drop_1[simplified] drop_drop add_0 add_Suc)
-qed
-
-lemma validI_GD_drop:
-  "\<lbrakk> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>; P s0 s; (tr, res) \<in> f s;
-        rely_cond R s0 (drop n tr) \<rbrakk>
-    \<Longrightarrow> guar_cond G s0 (drop n tr)"
-  apply (drule prefix_closed_drop[where n=n], erule validI_prefix_closed)
-  apply (auto dest: validI_GD)
-  done
-
-lemma parallel_prefix_closed[wp_split]:
-  "prefix_closed f \<Longrightarrow> prefix_closed g
-    \<Longrightarrow> prefix_closed (parallel f g)"
-  apply (subst prefix_closed_def, clarsimp simp: parallel_def)
-  apply (case_tac f_steps; clarsimp)
-  apply (drule(1) prefix_closedD)+
-  apply fastforce
-  done
-
-lemma rely_cond_drop:
-  "rely_cond R s0 xs \<Longrightarrow> rely_cond R s0 (drop n xs)"
-  using rely_cond_append[where xs="take n xs" and ys="drop n xs"]
-  by simp
-
-lemma rely_cond_is_drop:
-  "rely_cond R s0 xs
-    \<Longrightarrow> (ys = drop (length xs - length ys) xs)
-    \<Longrightarrow> rely_cond R s0 ys"
-  by (metis rely_cond_drop)
-
-lemma bounded_rev_nat_induct:
-  "(\<And>n. N \<le> n \<Longrightarrow> P n) \<Longrightarrow> (\<And>n. n < N \<Longrightarrow> P (Suc n) \<Longrightarrow> P n)
-    \<Longrightarrow> P n"
-  by (induct diff\<equiv>"N - n" arbitrary: n; simp)
-
-lemma drop_n_induct:
-  "P [] \<Longrightarrow> (\<And>n. n < length xs \<Longrightarrow> P (drop (Suc n) xs) \<Longrightarrow> P (drop n xs))
-    \<Longrightarrow> P (drop n xs)"
-  by (induct len\<equiv>"length (drop n xs)" arbitrary: n xs; simp)
-
-lemma guar_cond_Cons_eq:
-  "guar_cond R s0 (x # xs)
-        = (guar_cond R s0 xs \<and> (fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
-  by (cases "fst x"; simp add: guar_cond_def trace_steps_append conj_comms)
-
-lemma guar_cond_Cons:
-  "guar_cond R s0 xs
-    \<Longrightarrow> fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
-    \<Longrightarrow> guar_cond R s0 (x # xs)"
-  by (simp add: guar_cond_Cons_eq)
-
-lemma guar_cond_drop_Suc_eq:
-  "n < length xs
-    \<Longrightarrow> guar_cond R s0 (drop n xs) = (guar_cond R s0 (drop (Suc n) xs)
-        \<and> (fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
-  apply (rule trans[OF _ guar_cond_Cons_eq])
-  apply (simp add: Cons_nth_drop_Suc)
-  done
-
-lemma guar_cond_drop_Suc:
-  "guar_cond R s0 (drop (Suc n) xs)
-    \<Longrightarrow> fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
-    \<Longrightarrow> guar_cond R s0 (drop n xs)"
-  by (case_tac "n < length xs"; simp add: guar_cond_drop_Suc_eq)
-
-lemma rely_cond_Cons_eq:
-  "rely_cond R s0 (x # xs)
-        = (rely_cond R s0 xs \<and> (fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
-  by (simp add: rely_cond_def trace_steps_append conj_comms)
-
-lemma rely_cond_Cons:
-  "rely_cond R s0 xs
-    \<Longrightarrow> fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
-    \<Longrightarrow> rely_cond R s0 (x # xs)"
-  by (simp add: rely_cond_Cons_eq)
-
-lemma rely_cond_drop_Suc_eq:
-  "n < length xs
-    \<Longrightarrow> rely_cond R s0 (drop n xs) = (rely_cond R s0 (drop (Suc n) xs)
-        \<and> (fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
-  apply (rule trans[OF _ rely_cond_Cons_eq])
-  apply (simp add: Cons_nth_drop_Suc)
-  done
-
-lemma rely_cond_drop_Suc:
-  "rely_cond R s0 (drop (Suc n) xs)
-    \<Longrightarrow> fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
-    \<Longrightarrow> rely_cond R s0 (drop n xs)"
-  by (cases "n < length xs"; simp add: rely_cond_drop_Suc_eq)
-
-lemma last_st_tr_map_zip_hd:
-  "length flags = length tr
-    \<Longrightarrow> tr \<noteq> [] \<longrightarrow> snd (f (hd flags, hd tr)) = snd (hd tr)
-    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
-  apply (cases tr; simp)
-  apply (cases flags; simp)
-  apply (simp add: fun_eq_iff)
-  done
-
-lemma last_st_tr_drop_map_zip_hd:
-  "length flags = length tr
-    \<Longrightarrow> n < length tr \<longrightarrow> snd (f (flags ! n, tr ! n)) = snd (tr ! n)
-    \<Longrightarrow> last_st_tr (drop n (map f (zip flags tr))) = last_st_tr (drop n tr)"
-  apply (simp add: drop_map drop_zip)
-  apply (rule last_st_tr_map_zip_hd; clarsimp)
-  apply (simp add: hd_drop_conv_nth)
-  done
-
-lemma last_st_tr_map_zip:
-  "length flags = length tr
-    \<Longrightarrow> \<forall>fl tmid s. snd (f (fl, (tmid, s))) = s
-    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
-  apply (erule last_st_tr_map_zip_hd)
-  apply (clarsimp simp: neq_Nil_conv)
-  done
-
-lemma parallel_rely_induct:
-  assumes preds: "(tr, v) \<in> parallel f g s" "Pf s0 s" "Pg s0 s"
-  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f' \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
-     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g' \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
-     "f s \<subseteq> f' s" "g s \<subseteq> g' s"
-  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
-     "Gf \<le> Rg" "Gg \<le> Rf"
-  and rely: "rely_cond R s0 (drop n tr)"
-  shows "\<exists>tr_f tr_g. (tr_f, v) \<in> f s \<and> (tr_g, v) \<in> g s
-      \<and> rely_cond Rf s0 (drop n tr_f) \<and> rely_cond Rg s0 (drop n tr_g)
-      \<and> map snd tr_f = map snd tr \<and> map snd tr_g = map snd tr
-      \<and> (\<forall>i \<le> length tr. last_st_tr (drop i tr_g) s0 = last_st_tr (drop i tr_f) s0)
-      \<and> guar_cond G s0 (drop n tr)"
-  (is "\<exists>ys zs. _ \<and> _ \<and> ?concl ys zs")
-proof -
-  obtain ys zs where tr: "tr = map parallel_mrg (zip ys zs)"
-      and all2: "list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs"
-      and ys: "(ys, v) \<in> f s" and zs: "(zs, v) \<in> g s"
-    using preds
-    by (clarsimp simp: parallel_def2)
-  note len[simp] = list_all2_lengthD[OF all2]
-
-  have ys': "(ys, v) \<in> f' s" and zs': "(zs, v) \<in> g' s"
-    using ys zs validI by auto
-
-  note rely_f_step = validI_GD_drop[OF validI(1) preds(2) ys' rely_cond_drop_Suc]
-  note rely_g_step = validI_GD_drop[OF validI(2) preds(3) zs' rely_cond_drop_Suc]
-
-  note snd[simp] = list_all2_nthD[OF all2, THEN conjunct2]
-
-  have "?concl ys zs"
-    using rely tr all2 rely_f_step rely_g_step
-    apply (induct n rule: bounded_rev_nat_induct)
-     apply (subst drop_all, assumption)
-     apply clarsimp
-     apply (simp add: list_all2_conv_all_nth last_st_tr_def drop_map[symmetric]
-                      hd_drop_conv_nth hd_append)
-     apply (fastforce simp: split_def intro!: nth_equalityI)
-     apply clarsimp
-    apply (erule_tac x=n in meta_allE)+
-    apply (drule meta_mp, erule rely_cond_is_drop, simp)
-    apply (subst(asm) rely_cond_drop_Suc_eq[where xs="map f xs" for f xs], simp)
-    apply (clarsimp simp: last_st_tr_drop_map_zip_hd if_split[where P="\<lambda>x. x = Env"]
-                          split_def)
-    apply (intro conjI; (rule guar_cond_drop_Suc rely_cond_drop_Suc, assumption))
-      apply (auto simp: guar_cond_drop_Suc_eq last_st_tr_drop_map_zip_hd
-                 intro: compat[THEN predicate2D])
-    done
-
-  thus ?thesis
-    using ys zs
-    by auto
-qed
-
-lemmas parallel_rely_induct0 = parallel_rely_induct[where n=0, simplified]
-
-lemma rg_validI:
-  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
-     "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
-  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
-     "Gf \<le> Rg" "Gg \<le> Rf"
-  shows "\<lbrace>Pf and Pg\<rbrace>,\<lbrace>R\<rbrace> parallel f g \<lbrace>G\<rbrace>,\<lbrace>\<lambda>rv. Qf rv and Qg rv\<rbrace>"
-  apply (clarsimp simp: validI_def rely_def pred_conj_def
-                        parallel_prefix_closed validI[THEN validI_prefix_closed])
-  apply (drule(3) parallel_rely_induct0[OF _ _ _ validI order_refl order_refl compat])
-  apply clarsimp
-  apply (drule(2) validI[THEN validI_rvD])+
-  apply (simp add: last_st_tr_def)
-  done
-
-lemma validI_weaken_pre[wp_pre]:
-  "\<lbrace>P'\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<And>s0 s. P s0 s \<Longrightarrow> P' s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (simp add: validI_def, blast)
-
-lemma rely_weaken:
-  "(\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
-    \<Longrightarrow> (tr, res) \<in> rely f R s s0 \<Longrightarrow> (tr, res) \<in> rely f R' s s0"
-  by (simp add: rely_def rely_cond_def, blast)
-
-lemma validI_weaken_rely[wp_pre]:
-  "\<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: validI_def)
-  by (metis rely_weaken)
-
-lemma validI_strengthen_post:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace>
-    \<Longrightarrow> (\<forall>v s0 s. Q' v s0 s \<longrightarrow> Q v s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (simp add: validI_def)
-
-lemma validI_strengthen_guar:
-  "\<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G'\<rbrace>, \<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<forall>s0 s. G' s0 s \<longrightarrow> G s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>"
-  by (force simp: validI_def guar_cond_def)
-
-lemma rely_prim[simp]:
-  "rely (\<lambda>s. insert (v s) (f s)) R s0 = (\<lambda>s. {x. x = v s \<and> rely_cond R s0 (fst x)} \<union> (rely f R s0 s))"
-  "rely (\<lambda>s. {}) R s0 = (\<lambda>_. {})"
-  by (auto simp: rely_def prod_eq_iff)
-
-lemma prefix_closed_put_trace_elem[iff]:
-  "prefix_closed (put_trace_elem x)"
-  by (clarsimp simp: prefix_closed_def put_trace_elem_def)
-
-lemma prefix_closed_return[iff]:
-  "prefix_closed (return x)"
-  by (simp add: prefix_closed_def return_def)
-
-lemma prefix_closed_put_trace[iff]:
-  "prefix_closed (put_trace tr)"
-  by (induct tr; clarsimp simp: prefix_closed_bind)
-
-lemma put_trace_eq_drop:
-  "put_trace xs s
-    = ((\<lambda>n. (drop n xs, if n = 0 then Result ((), s) else Incomplete)) ` {.. length xs})"
-  apply (induct xs)
-   apply (clarsimp simp: return_def)
-  apply (clarsimp simp: put_trace_elem_def bind_def)
-  apply (simp add: atMost_Suc_eq_insert_0 image_image)
-  apply (rule equalityI; clarsimp)
-   apply (split if_split_asm; clarsimp)
-   apply (auto intro: image_eqI[where x=0])[1]
-  apply (rule rev_bexI, simp)
-  apply clarsimp
-  done
-
-lemma put_trace_res:
-  "(tr, res) \<in> put_trace xs s
-    \<Longrightarrow> \<exists>n. tr = drop n xs \<and> n \<le> length xs
-        \<and> res = (case n of 0 \<Rightarrow> Result ((), s) | _ \<Rightarrow> Incomplete)"
-  apply (clarsimp simp: put_trace_eq_drop)
-  apply (case_tac n; auto intro: exI[where x=0])
-  done
-
-lemma put_trace_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>n. rely_cond R s0 (drop n xs) \<longrightarrow> guar_cond G s0 (drop n xs))
-    \<and> (rely_cond R s0 xs \<longrightarrow> Q () (last_st_tr xs s0) s)\<rbrace>,\<lbrace>R\<rbrace> put_trace xs \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (clarsimp simp: validI_def rely_def)
-  apply (drule put_trace_res)
-  apply (clarsimp; clarsimp split: nat.split_asm)
-  done
-
-lemmas put_trace_elem_twp = put_trace_twp[where xs="[x]" for x, simplified]
-
-lemma prefix_closed_select[iff]:
-  "prefix_closed (select S)"
-  by (simp add: prefix_closed_def select_def image_def)
-
-lemma rely_cond_rtranclp:
-  "rely_cond R s (map (Pair Env) xs) \<Longrightarrow> rtranclp R s (last_st_tr (map (Pair Env) xs) s)"
-  apply (induct xs arbitrary: s rule: rev_induct)
-   apply simp
-  apply (clarsimp simp add: rely_cond_def)
-  apply (erule converse_rtranclp_into_rtranclp)
-  apply simp
-  done
-
-definition
-  no_trace :: "('s,'a) tmonad  \<Rightarrow> bool"
-where
-  "no_trace f = (\<forall>tr res s. (tr, res) \<in> f s \<longrightarrow> tr = [] \<and> res \<noteq> Incomplete)"
-
-lemmas no_traceD = no_trace_def[THEN iffD1, rule_format]
-
-lemma no_trace_emp:
-  "no_trace f \<Longrightarrow> (tr, r) \<in> f s \<Longrightarrow> tr = []"
-  by (simp add: no_traceD)
-
-lemma no_trace_Incomplete_mem:
-  "no_trace f \<Longrightarrow> (tr, Incomplete) \<notin> f s"
-  by (auto dest: no_traceD)
-
-lemma no_trace_Incomplete_eq:
-  "no_trace f \<Longrightarrow> (tr, res) \<in> f s \<Longrightarrow> res \<noteq> Incomplete"
-  by (auto dest: no_traceD)
-
-lemma no_trace_prefix_closed:
-  "no_trace f \<Longrightarrow> prefix_closed f"
-  by (auto simp add: prefix_closed_def dest: no_trace_emp)
-
-(* Attempt to define triple_judgement to use valid_validI_wp as wp_comb rule.
-   It doesn't work. It seems that wp_comb rules cannot take more than 1 assumption *)
-lemma validI_is_triple:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> =
-     triple_judgement (\<lambda>(s0, s). prefix_closed f \<longrightarrow> P s0 s) f
-                      (\<lambda>(s0,s) f. prefix_closed f \<and> (\<forall>tr res. (tr, res) \<in> rely f R s0 s
-                          \<longrightarrow> guar_cond G s0 tr
-                              \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
-  apply (simp add: triple_judgement_def validI_def )
-  apply (cases "prefix_closed f"; simp)
-  done
-
-lemma no_trace_is_triple:
-  "no_trace f = triple_judgement \<top> f (\<lambda>() f. id no_trace f)"
-  by (simp add: triple_judgement_def split: unit.split)
-
-lemmas [wp_trip] = validI_is_triple no_trace_is_triple
-
-lemma valid_validI_wp[wp_comb]:
-  "no_trace f \<Longrightarrow> (\<And>s0. \<lbrace>P s0\<rbrace> f \<lbrace>\<lambda>v. Q v s0 \<rbrace>)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (fastforce simp: rely_def validI_def valid_def mres_def no_trace_prefix_closed dest: no_trace_emp
-    elim: image_eqI[rotated])
-
-(* Since valid_validI_wp in wp_comb doesn't work, we add the rules directly in the wp set *)
-lemma no_trace_prim:
-  "no_trace get"
-  "no_trace (put s)"
-  "no_trace (modify f)"
-  "no_trace (return v)"
-  "no_trace fail"
-  by (simp_all add: no_trace_def get_def put_def modify_def bind_def
-                    return_def select_def fail_def)
-
-lemma no_trace_select:
-  "no_trace (select S)"
-  by (clarsimp simp add: no_trace_def select_def)
-
-lemma no_trace_bind:
-  "no_trace f \<Longrightarrow> \<forall>rv. no_trace (g rv)
-    \<Longrightarrow> no_trace (do rv \<leftarrow> f; g rv od)"
-  apply (subst no_trace_def)
-  apply (clarsimp simp add: bind_def split: tmres.split_asm;
-    auto dest: no_traceD[rotated])
-  done
-
-lemma no_trace_extra:
-  "no_trace (gets f)"
-  "no_trace (assert P)"
-  "no_trace (assert_opt Q)"
-  by (simp_all add: gets_def assert_def assert_opt_def no_trace_bind no_trace_prim
-             split: option.split)
-
-lemmas no_trace_all[wp, iff] = no_trace_prim no_trace_select no_trace_extra
-
-lemma env_steps_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s0 s' \<longrightarrow> Q () s' s') \<and> Q () s0 s\<rbrace>,\<lbrace>R\<rbrace> env_steps \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: interference_def env_steps_def)
-  apply wp
-  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
-  apply (drule rely_cond_rtranclp)
-  apply (clarsimp simp add: last_st_tr_def hd_append)
-  done
-
-lemma interference_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s s' \<longrightarrow> Q () s' s') \<and> G s0 s\<rbrace>,\<lbrace>R\<rbrace>  interference \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: interference_def commit_step_def del: put_trace.simps)
-  apply wp
-  apply clarsimp
-  apply (simp add: drop_Cons nat.split rely_cond_def guar_cond_def)
-  done
-
-(* what Await does if we haven't committed our step is a little
-   strange. this assumes we have, which means s0 = s. we should
-   revisit this if we find a use for Await when this isn't the
-   case *)
-lemma Await_sync_twp:
-  "\<lbrace>\<lambda>s0 s. s = s0 \<and> (\<forall>x. R\<^sup>*\<^sup>* s0 x \<and> c x \<longrightarrow> Q () x x)\<rbrace>,\<lbrace>R\<rbrace> Await c \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: Await_def split_def)
-  apply wp
-  apply clarsimp
-  apply (clarsimp simp: guar_cond_def trace_steps_rev_drop_nth rev_nth)
-  apply (drule rely_cond_rtranclp)
-  apply (simp add: o_def)
-  done
-
-(* FIXME: this needs adjustment, case_prod Q is unlikely to unify *)
-lemma wpc_helper_validI:
-  "(\<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>) \<Longrightarrow> wpc_helper (P, P', P'') (case_prod Q, Q', Q'') (\<lbrace>curry P\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>)"
-  by (clarsimp simp: wpc_helper_def elim!: validI_weaken_pre)
-
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> m \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>" wpc_helper_validI
-
-lemma mres_union:
- "mres (a \<union> b) = mres a \<union> mres b"
-  by (simp add: mres_def image_Un)
-
-lemma mres_Failed_empty:
-  "mres ((\<lambda>xs. (xs, Failed)) ` X ) = {}"
-  "mres ((\<lambda>xs. (xs, Incomplete)) ` X ) = {}"
-  by (auto simp add: mres_def image_def)
-
-lemma det_set_option_eq:
-  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
-       (ts, Some (rr, ss)) \<in> m \<Longrightarrow> rr = r \<and> ss = s'"
-  by (metis UN_I option.set_intros prod.inject singleton_iff snd_conv)
-
-lemma det_set_option_eq':
-  "(\<Union>a\<in>m. set_option (snd a)) = {(r, s')} \<Longrightarrow>
-       Some (r, s') \<in> snd ` m"
-  using image_iff by fastforce
-
-lemma validI_name_pre:
-  "prefix_closed f \<Longrightarrow>
-  (\<And>s0 s. P s0 s \<Longrightarrow> \<lbrace>\<lambda>s0' s'. s0' = s0 \<and> s' = s\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  unfolding validI_def
-  by metis
-
-lemma validI_well_behaved':
-  "prefix_closed f
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G'\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> R \<le> R'
-    \<Longrightarrow> G' \<le> G
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (subst validI_def, clarsimp)
-  apply (clarsimp simp add: rely_def)
-  apply (drule (2)  validI_D)
-  apply (fastforce simp: rely_cond_def guar_cond_def)+
-  done
-
-lemmas validI_well_behaved = validI_well_behaved'[unfolded le_fun_def, simplified]
-
 end

From be00ab2e535b59c7f79a29762b769f4c64748298 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Mon, 14 Aug 2023 17:31:27 +1000
Subject: [PATCH 4/5] lib/monads: restyle and reorder trace monad files

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 lib/Monads/trace/Trace_Monad.thy           |  69 ++--
 lib/Monads/trace/Trace_Monad_Equations.thy |  90 +++---
 lib/Monads/trace/Trace_No_Fail.thy         |   4 +-
 lib/Monads/trace/Trace_No_Trace.thy        |  23 +-
 lib/Monads/trace/Trace_RG.thy              | 353 ++++++++++++---------
 lib/Monads/trace/Trace_VCG.thy             |  13 +-
 6 files changed, 300 insertions(+), 252 deletions(-)

diff --git a/lib/Monads/trace/Trace_Monad.thy b/lib/Monads/trace/Trace_Monad.thy
index ede246ed79..8ddf802f4d 100644
--- a/lib/Monads/trace/Trace_Monad.thy
+++ b/lib/Monads/trace/Trace_Monad.thy
@@ -41,9 +41,9 @@ abbreviation map_tmres_rv :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s, 'a) tmres
 section "The Monad"
 
 text \<open>
-  tmonad returns a set of non-deterministic  computations, including
+  tmonad returns a set of non-deterministic computations, including
   a trace as a list of "thread identifier" \<times> state, and an optional
-  pair result, state when the computation did not fail.\<close>
+  pair of result and state when the computation did not fail.\<close>
 type_synonym ('s, 'a) tmonad = "'s \<Rightarrow> ((tmid \<times> 's) list \<times> ('s, 'a) tmres) set"
 
 text \<open>Returns monad results, ignoring failures and traces.\<close>
@@ -86,10 +86,12 @@ abbreviation(input) bind_rev ::
   "g =<< f \<equiv> f >>= g"
 
 text \<open>
-  The basic accessor functions of the state monad. @{text get} returns
-  the current state as result, does not fail, and does not change the state.
-  @{text "put s"} returns nothing (@{typ unit}), changes the current state
-  to @{text s} and does not fail.\<close>
+  The basic accessor functions of the state monad. @{text get} returns the
+  current state as result, does not change the state, and does not add to the
+  trace. @{text "put s"} returns nothing (@{typ unit}), changes the current
+  state to @{text s}, and does not add to the trace. @{text "put_trace xs"}
+  returns nothing (@{typ unit}), does not change the state, and adds @{text xs}
+  to the trace.\<close>
 definition get :: "('s,'s) tmonad" where
   "get \<equiv> \<lambda>s. {([], Result (s, s))}"
 
@@ -107,10 +109,10 @@ subsection "Nondeterminism"
 
 text \<open>
   Basic nondeterministic functions. @{text "select A"} chooses an element
-  of the set @{text A}, does not change the state, and does not fail
-  (even if the set is empty). @{text "f \<sqinter> g"} executes @{text f} or
-  executes @{text g}. It retuns the union of results of @{text f} and
-  @{text g}, and may have failed if either may have failed.\<close>
+  of the set @{text A} as the result, does not change the state, does not add
+  to the trace, and does not fail (even if the set is empty). @{text "f \<sqinter> g"}
+  executes @{text f} or executes @{text g}. It returns the union of results and
+  traces of @{text f} and @{text g}.\<close>
 definition select :: "'a set \<Rightarrow> ('s, 'a) tmonad" where
   "select A \<equiv> \<lambda>s. (Pair [] ` Result ` (A \<times> {s}))"
 
@@ -119,13 +121,13 @@ definition alternative :: "('s,'a) tmonad \<Rightarrow> ('s,'a) tmonad \<Rightar
   "f \<sqinter> g \<equiv> \<lambda>s. (f s \<union> g s)"
 
 text \<open>
-  The @{text select_f} function was left out here until we figure
+  FIXME: The @{text select_f} function was left out here until we figure
   out what variant we actually need.\<close>
 
 subsection "Failure"
 
 text \<open>
-  The monad function that always fails. Returns an empty set of results and sets the failure flag.\<close>
+  The monad function that always fails. Returns an empty trace with a Failed result.\<close>
 definition fail :: "('s, 'a) tmonad" where
   "fail \<equiv> \<lambda>s. {([], Failed)}"
 
@@ -208,6 +210,7 @@ lemma elem_bindE:
 
 text \<open>Each monad satisfies at least the following three laws.\<close>
 
+\<comment> \<open>FIXME: is this necessary? If it is, move it\<close>
 declare map_option.identity[simp]
 
 text \<open>@{term return} is absorbed at the left of a @{term bind}, applying the return value directly:\<close>
@@ -445,31 +448,36 @@ text \<open>
 definition last_st_tr :: "(tmid * 's) list \<Rightarrow> 's \<Rightarrow> 's" where
   "last_st_tr tr s0 \<equiv> hd (map snd tr @ [s0])"
 
+text \<open>Nondeterministically add all possible environment events to the trace.\<close>
 definition env_steps :: "('s,unit) tmonad" where
   "env_steps \<equiv>
-  do
-    s \<leftarrow> get;
-    \<comment> \<open>Add unfiltered environment events to the trace\<close>
-    xs \<leftarrow> select UNIV;
-    tr \<leftarrow> return (map (Pair Env) xs);
-    put_trace tr;
-    \<comment> \<open>Pick the last event of the trace as the final state\<close>
-    put (last_st_tr tr s)
-  od"
+   do
+     s \<leftarrow> get;
+     \<comment> \<open>Add unfiltered environment events to the trace\<close>
+     xs \<leftarrow> select UNIV;
+     tr \<leftarrow> return (map (Pair Env) xs);
+     put_trace tr;
+     \<comment> \<open>Pick the last event of the trace as the final state\<close>
+     put (last_st_tr tr s)
+   od"
 
+text \<open>Add the current state to the trace, tagged as a self action.\<close>
 definition commit_step :: "('s,unit) tmonad" where
   "commit_step \<equiv>
-  do
-    s \<leftarrow> get;
-    put_trace [(Me,s)]
-  od"
+   do
+     s \<leftarrow> get;
+     put_trace [(Me,s)]
+   od"
 
+text \<open>
+  Record the action taken by the current thread since the last interference point and
+  then add unfiltered environment events.\<close>
 definition interference :: "('s,unit) tmonad" where
   "interference \<equiv>
-  do
-    commit_step;
-    env_steps
-  od"
+   do
+     commit_step;
+     env_steps
+   od"
 
 
 section "Library of additional Monadic Functions and Combinators"
@@ -616,7 +624,8 @@ subsection "Loops"
 text \<open>
   Loops are handled using the following inductive predicate;
   non-termination is represented using the failure flag of the
-  monad.\<close>
+  monad.
+FIXME: update comment about non-termination\<close>
 
 inductive_set whileLoop_results ::
   "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('r \<Rightarrow> ('s, 'r) tmonad) \<Rightarrow> (('r \<times> 's) \<times> ((tmid \<times> 's) list \<times> ('s, 'r) tmres)) set"
diff --git a/lib/Monads/trace/Trace_Monad_Equations.thy b/lib/Monads/trace/Trace_Monad_Equations.thy
index a2072db008..ee0730def0 100644
--- a/lib/Monads/trace/Trace_Monad_Equations.thy
+++ b/lib/Monads/trace/Trace_Monad_Equations.thy
@@ -46,38 +46,40 @@ lemma fail_bind[simp]:
   by (simp add: bind_def fail_def)
 
 
+subsection \<open>Alternative env_steps with repeat\<close>
+
 lemma mapM_Cons:
   "mapM f (x # xs) = do
-    y \<leftarrow> f x;
-    ys \<leftarrow> mapM f xs;
-    return (y # ys)
-  od"
+     y \<leftarrow> f x;
+     ys \<leftarrow> mapM f xs;
+     return (y # ys)
+   od"
   and mapM_Nil:
   "mapM f [] = return []"
   by (simp_all add: mapM_def sequence_def)
 
 lemma mapM_x_Cons:
   "mapM_x f (x # xs) = do
-    y \<leftarrow> f x;
-    mapM_x f xs
-  od"
+     y \<leftarrow> f x;
+     mapM_x f xs
+   od"
   and mapM_x_Nil:
   "mapM_x f [] = return ()"
   by (simp_all add: mapM_x_def sequence_x_def)
 
 lemma mapM_append:
   "mapM f (xs @ ys) = (do
-    fxs \<leftarrow> mapM f xs;
-    fys \<leftarrow> mapM f ys;
-    return (fxs @ fys)
-  od)"
+     fxs \<leftarrow> mapM f xs;
+     fys \<leftarrow> mapM f ys;
+     return (fxs @ fys)
+   od)"
   by (induct xs, simp_all add: mapM_Cons mapM_Nil bind_assoc)
 
 lemma mapM_x_append:
   "mapM_x f (xs @ ys) = (do
-    x \<leftarrow> mapM_x f xs;
-    mapM_x f ys
-  od)"
+     x \<leftarrow> mapM_x f xs;
+     mapM_x f ys
+   od)"
   by (induct xs, simp_all add: mapM_x_Cons mapM_x_Nil bind_assoc)
 
 lemma mapM_map:
@@ -88,9 +90,7 @@ lemma mapM_x_map:
   "mapM_x f (map g xs) = mapM_x (f o g) xs"
   by (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
 
-primrec
-  repeat_n :: "nat \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
-where
+primrec repeat_n :: "nat \<Rightarrow> ('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad" where
     "repeat_n 0 f = return ()"
   | "repeat_n (Suc n) f = do f; repeat_n n f od"
 
@@ -98,27 +98,23 @@ lemma repeat_n_mapM_x:
   "repeat_n n f = mapM_x (\<lambda>_. f) (replicate n ())"
   by (induct n, simp_all add: mapM_x_Cons mapM_x_Nil)
 
-definition
-  repeat :: "('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad"
-where
+definition repeat :: "('s, unit) tmonad \<Rightarrow> ('s, unit) tmonad" where
   "repeat f = do n \<leftarrow> select UNIV; repeat_n n f od"
 
-definition
-  env_step :: "('s,unit) tmonad"
-where
+definition env_step :: "('s,unit) tmonad" where
   "env_step =
-  (do
-    s' \<leftarrow> select UNIV;
-    put_trace_elem (Env, s');
-    put s'
-  od)"
+   do
+     s' \<leftarrow> select UNIV;
+     put_trace_elem (Env, s');
+     put s'
+   od"
 
 abbreviation
   "env_n_steps n \<equiv> repeat_n n env_step"
 
 lemma elem_select_bind:
   "(tr, res) \<in> (do x \<leftarrow> select S; f x od) s
-    = (\<exists>x \<in> S. (tr, res) \<in> f x s)"
+   = (\<exists>x \<in> S. (tr, res) \<in> f x s)"
   by (simp add: bind_def select_def)
 
 lemma select_bind_UN:
@@ -127,8 +123,8 @@ lemma select_bind_UN:
 
 lemma select_early:
   "S \<noteq> {}
-    \<Longrightarrow> do x \<leftarrow> f; y \<leftarrow> select S; g x y od
-        = do y \<leftarrow> select S; x \<leftarrow> f; g x y od"
+   \<Longrightarrow> do x \<leftarrow> f; y \<leftarrow> select S; g x y od
+       = do y \<leftarrow> select S; x \<leftarrow> f; g x y od"
   apply (simp add: bind_def select_def Sigma_def)
   apply (rule ext)
   apply (fastforce elim: rev_bexI image_eqI[rotated] split: tmres.split_asm)
@@ -136,8 +132,8 @@ lemma select_early:
 
 lemma repeat_n_choice:
   "S \<noteq> {}
-    \<Longrightarrow> repeat_n n (do x \<leftarrow> select S; f x od)
-        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S \<and> length xs = n}; mapM_x f xs od)"
+   \<Longrightarrow> repeat_n n (do x \<leftarrow> select S; f x od)
+       = (do xs \<leftarrow> select {xs. set xs \<subseteq> S \<and> length xs = n}; mapM_x f xs od)"
   apply (induct n; simp?)
    apply (simp add: select_def bind_def mapM_x_Nil cong: conj_cong)
   apply (simp add: select_early bind_assoc)
@@ -152,8 +148,8 @@ lemma repeat_n_choice:
 
 lemma repeat_choice:
   "S \<noteq> {}
-    \<Longrightarrow> repeat (do x \<leftarrow> select S; f x od)
-        = (do xs \<leftarrow> select {xs. set xs \<subseteq> S}; mapM_x f xs od)"
+   \<Longrightarrow> repeat (do x \<leftarrow> select S; f x od)
+       = (do xs \<leftarrow> select {xs. set xs \<subseteq> S}; mapM_x f xs od)"
   apply (simp add: repeat_def repeat_n_choice)
   apply (simp(no_asm) add: fun_eq_iff set_eq_iff elem_select_bind)
   done
@@ -164,12 +160,12 @@ lemma put_trace_append:
 
 lemma put_trace_elem_put_comm:
   "do y \<leftarrow> put_trace_elem x; put s od
-    = do y \<leftarrow> put s; put_trace_elem x od"
+   = do y \<leftarrow> put s; put_trace_elem x od"
   by (simp add: put_def put_trace_elem_def bind_def insert_commute)
 
 lemma put_trace_put_comm:
   "do y \<leftarrow> put_trace xs; put s od
-    = do y \<leftarrow> put s; put_trace xs od"
+   = do y \<leftarrow> put s; put_trace xs od"
   apply (rule sym; induct xs; simp)
   apply (simp add: bind_assoc put_trace_elem_put_comm)
   apply (simp add: bind_assoc[symmetric])
@@ -177,14 +173,14 @@ lemma put_trace_put_comm:
 
 lemma mapM_x_comm:
   "(\<forall>x \<in> set xs. do y \<leftarrow> g; f x od = do y \<leftarrow> f x; g od)
-    \<Longrightarrow> do y \<leftarrow> g; mapM_x f xs od = do y \<leftarrow> mapM_x f xs; g od"
+   \<Longrightarrow> do y \<leftarrow> g; mapM_x f xs od = do y \<leftarrow> mapM_x f xs; g od"
   apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons)
   apply (simp add: bind_assoc[symmetric], simp add: bind_assoc)
   done
 
 lemma mapM_x_split:
   "(\<forall>x \<in> set xs. \<forall>y \<in> set xs. do z \<leftarrow> g y; f x od = do (z :: unit) \<leftarrow> f x; g y od)
-    \<Longrightarrow> mapM_x (\<lambda>x. do z \<leftarrow> f x; g x od) xs = do y \<leftarrow> mapM_x f xs; mapM_x g xs od"
+   \<Longrightarrow> mapM_x (\<lambda>x. do z \<leftarrow> f x; g x od) xs = do y \<leftarrow> mapM_x f xs; mapM_x g xs od"
   apply (induct xs; simp add: mapM_x_Nil mapM_x_Cons bind_assoc)
   apply (subst bind_assoc[symmetric], subst mapM_x_comm[where f=f and g="g x" for x])
    apply simp
@@ -237,15 +233,15 @@ lemma repeat_eq_twice[simp]:
   apply (rule ext, fastforce intro: exI[where x=0])
   done
 
-lemmas repeat_eq_twice_then[simp]
-    = repeat_eq_twice[THEN bind_then_eq, simplified bind_assoc]
+lemmas repeat_eq_twice_then[simp] =
+  repeat_eq_twice[THEN bind_then_eq, simplified bind_assoc]
 
-lemmas env_steps_eq_twice[simp]
-    = repeat_eq_twice[where f=env_step, folded env_steps_repeat]
-lemmas env_steps_eq_twice_then[simp]
-    = env_steps_eq_twice[THEN bind_then_eq, simplified bind_assoc]
+lemmas env_steps_eq_twice[simp] =
+  repeat_eq_twice[where f=env_step, folded env_steps_repeat]
+lemmas env_steps_eq_twice_then[simp] =
+  env_steps_eq_twice[THEN bind_then_eq, simplified bind_assoc]
 
-lemmas mapM_collapse_append = mapM_append[symmetric, THEN bind_then_eq,
-    simplified bind_assoc, simplified]
+lemmas mapM_collapse_append =
+  mapM_append[symmetric, THEN bind_then_eq, simplified bind_assoc, simplified]
 
 end
\ No newline at end of file
diff --git a/lib/Monads/trace/Trace_No_Fail.thy b/lib/Monads/trace/Trace_No_Fail.thy
index 0a8fbf5212..dd47142aac 100644
--- a/lib/Monads/trace/Trace_No_Fail.thy
+++ b/lib/Monads/trace/Trace_No_Fail.thy
@@ -17,9 +17,9 @@ begin
 subsection "Non-Failure"
 
 text \<open>
-  With the failure flag, we can formulate non-failure separately from validity.
+  With the failure result, we can formulate non-failure separately from validity.
   A monad @{text m} does not fail under precondition @{text P}, if for no start
-  state that satisfies the precondition it sets the failure flag.
+  state that satisfies the precondition it returns a @{term Failed} result.
 \<close>
 definition no_fail :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> bool" where
   "no_fail P m \<equiv> \<forall>s. P s \<longrightarrow> Failed \<notin> snd ` (m s)"
diff --git a/lib/Monads/trace/Trace_No_Trace.thy b/lib/Monads/trace/Trace_No_Trace.thy
index aff4cab62e..5b59c87d72 100644
--- a/lib/Monads/trace/Trace_No_Trace.thy
+++ b/lib/Monads/trace/Trace_No_Trace.thy
@@ -11,15 +11,19 @@ theory Trace_No_Trace
     WPSimp
 begin
 
-definition
-  no_trace :: "('s,'a) tmonad  \<Rightarrow> bool"
-where
+subsection "No Trace"
+
+text \<open>
+  A monad of type @{text tmonad} does not have a trace iff for all starting
+  states, all of the potential outcomes have the empty list as a trace and do
+  not return an @{term Incomplete} result.\<close>
+definition no_trace :: "('s,'a) tmonad  \<Rightarrow> bool" where
   "no_trace f = (\<forall>tr res s. (tr, res) \<in> f s \<longrightarrow> tr = [] \<and> res \<noteq> Incomplete)"
 
 lemmas no_traceD = no_trace_def[THEN iffD1, rule_format]
 
 lemma no_trace_emp:
-  "no_trace f \<Longrightarrow> (tr, r) \<in> f s \<Longrightarrow> tr = []"
+  "\<lbrakk>no_trace f; (tr, r) \<in> f s\<rbrakk> \<Longrightarrow> tr = []"
   by (simp add: no_traceD)
 
 lemma no_trace_Incomplete_mem:
@@ -27,16 +31,19 @@ lemma no_trace_Incomplete_mem:
   by (auto dest: no_traceD)
 
 lemma no_trace_Incomplete_eq:
-  "no_trace f \<Longrightarrow> (tr, res) \<in> f s \<Longrightarrow> res \<noteq> Incomplete"
+  "\<lbrakk>no_trace f; (tr, res) \<in> f s\<rbrakk> \<Longrightarrow> res \<noteq> Incomplete"
   by (auto dest: no_traceD)
 
-lemma no_trace_is_triple:
+
+subsection \<open>Set up for @{method wp}\<close>
+
+lemma no_trace_is_triple[wp_trip]:
   "no_trace f = triple_judgement \<top> f (\<lambda>() f. id no_trace f)"
   by (simp add: triple_judgement_def split: unit.split)
 
-lemmas [wp_trip] = no_trace_is_triple
 
-(* Since valid_validI_wp in wp_comb doesn't work, we add the rules directly in the wp set *)
+subsection \<open>Rules\<close>
+
 lemma no_trace_prim:
   "no_trace get"
   "no_trace (put s)"
diff --git a/lib/Monads/trace/Trace_RG.thy b/lib/Monads/trace/Trace_RG.thy
index 6aef80035f..fb844d0f18 100644
--- a/lib/Monads/trace/Trace_RG.thy
+++ b/lib/Monads/trace/Trace_RG.thy
@@ -12,10 +12,35 @@ theory Trace_RG
     Trace_No_Trace
 begin
 
-primrec
-  trace_steps :: "(tmid \<times> 's) list \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's \<times> 's) set" where
-  "trace_steps (elem # trace) s0 = {(fst elem, s0, snd elem)} \<union> trace_steps trace (snd elem)"
-| "trace_steps [] s0 = {}"
+section \<open>Rely-Guarantee Logic\<close>
+
+subsection \<open>Validity\<close>
+
+text \<open>
+  This section defines a Rely_Guarantee logic for partial correctness for
+  the interference trace monad.
+
+  The logic is defined semantically. Rules work directly on the
+  validity predicate.
+
+  In the interference trace monad, RG validity is a quintuple of precondition,
+  rely, monad, guarantee, and postcondition. The precondition is a function
+  from initial state to current state to bool (a state predicate), the rely and
+  guarantee are functions from state before to state after to bool, and the
+  postcondition is a function from return value to last state in the trace to
+  final state to bool. A quintuple is valid if for all initial and current
+  states that satisfy the precondition and all traces that satisfy the rely,
+  all of the pssible self steps performed by the monad satisfy the guarantee
+  and all of the result values and result states that are returned by the monad
+  satisfy the postcondition. Note that if the computation returns an empty
+  trace and no successful results then the quintuple is trivially valid. This
+  means @{term "assert P"} does not require us to prove that @{term P} holds,
+  but rather allows us to assume @{term P}! Proving non-failure is done via a
+  separate predicate and calculus (see Trace_No_Fail).\<close>
+
+primrec trace_steps :: "(tmid \<times> 's) list \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's \<times> 's) set" where
+    "trace_steps (elem # trace) s0 = {(fst elem, s0, snd elem)} \<union> trace_steps trace (snd elem)"
+  | "trace_steps [] s0 = {}"
 
 lemma trace_steps_nth:
   "trace_steps xs s0 = (\<lambda>i. (fst (xs ! i), (if i = 0 then s0 else snd (xs ! (i - 1))), snd (xs ! i))) ` {..< length xs}"
@@ -43,9 +68,15 @@ abbreviation(input)
   botbotbot :: "'a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>\<bottom>") where
   "\<bottom>\<bottom>\<bottom> \<equiv> \<lambda>_ _ _. False"
 
+text \<open>
+  Test whether the enironment steps in @{text tr} satisfy the rely condition @{text R},
+  assuming that @{text s0s} was the initial state before the first step in the trace.\<close>
 definition rely_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
   "rely_cond R s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Env \<longrightarrow> R s0 s)"
 
+text \<open>
+  Test whether the self steps in @{text tr} satisfy the guarantee condition @{text G},
+  assuming that @{text s0s} was the initial state before the first step in the trace.\<close>
 definition guar_cond :: "'s rg_pred \<Rightarrow> 's \<Rightarrow> (tmid \<times> 's) list \<Rightarrow> bool" where
   "guar_cond G s0s tr = (\<forall>(ident, s0, s) \<in> trace_steps (rev tr) s0s. ident = Me \<longrightarrow> G s0 s)"
 
@@ -54,6 +85,10 @@ lemma rg_empty_conds[simp]:
   "guar_cond G s0s []"
   by (simp_all add: rely_cond_def guar_cond_def)
 
+text \<open>
+  @{text "rely f R s0s"} constructs a new function from @{text f}, where the environment
+  steps are constrained by @{text R} and @{text s0s} was the initial state before the first
+  step in the trace.\<close>
 definition rely :: "('s, 'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> 's \<Rightarrow> ('s, 'a) tmonad" where
   "rely f R s0s \<equiv> (\<lambda>s. f s \<inter> ({tr. rely_cond R s0s tr} \<times> UNIV))"
 
@@ -63,9 +98,11 @@ definition prefix_closed :: "('s, 'a) tmonad \<Rightarrow> bool" where
 definition validI ::
   "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's rg_pred \<Rightarrow> ('s,'a) tmonad \<Rightarrow> 's rg_pred \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
   ("(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)/ _ /(\<lbrace>_\<rbrace>,/ \<lbrace>_\<rbrace>)") where
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> \<equiv> prefix_closed f \<and> (\<forall>s0 s. P s0 s
-    \<longrightarrow> (\<forall>tr res. (tr, res) \<in> (rely f R s0 s) \<longrightarrow> guar_cond G s0 tr
-        \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> \<equiv>
+     prefix_closed f
+     \<and> (\<forall>s0 s tr res. P s0 s \<and> (tr, res) \<in> (rely f R s0 s)
+         \<longrightarrow> guar_cond G s0 tr
+           \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s'))"
 
 (*
 text \<open>Validity for exception monad with interferences. Not as easy to phrase
@@ -94,7 +131,8 @@ lemma in_rely:
   by (simp add: rely_def)
 
 lemmas validI_D =
-  validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, rule_format, OF _ _ in_rely]
+  validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, rule_format,
+             OF _ conjI, OF _ _ in_rely]
 lemmas validI_GD = validI_D[THEN conjunct1]
 lemmas validI_rvD = validI_D[THEN conjunct2, rule_format, rotated -1, OF refl]
 lemmas validI_prefix_closed = validI_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct1]
@@ -116,9 +154,55 @@ lemma in_fst_snd_image:
 
 lemmas prefix_closedD = prefix_closedD1[OF _ in_fst_snd_image(1)]
 
+
+section \<open>Lemmas\<close>
+
+lemma validI_weaken_pre:
+  "\<lbrakk>\<lbrace>P'\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<And>s0 s. P s0 s \<Longrightarrow> P' s0 s\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (simp add: validI_def, blast)
+
+lemma rely_weaken:
+  "\<lbrakk>\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s; (tr, res) \<in> rely f R s s0\<rbrakk>
+   \<Longrightarrow> (tr, res) \<in> rely f R' s s0"
+  by (simp add: rely_def rely_cond_def, blast)
+
+lemma validI_weaken_rely:
+  "\<lbrakk>\<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<forall>s0 s. R s0 s \<longrightarrow> R' s0 s\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  apply (simp add: validI_def)
+  by (metis rely_weaken)
+
+lemmas validI_pre[wp_pre] =
+  validI_weaken_pre
+  validI_weaken_rely
+
+lemma validI_strengthen_post:
+  "\<lbrakk>\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace>; \<forall>v s0 s. Q' v s0 s \<longrightarrow> Q v s0 s\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  by (simp add: validI_def)
+
+lemma validI_strengthen_guar:
+  "\<lbrakk>\<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G'\<rbrace>, \<lbrace>Q\<rbrace>; \<forall>s0 s. G' s0 s \<longrightarrow> G s0 s\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>"
+  by (force simp: validI_def guar_cond_def)
+
+
+subsection \<open>Setting up the precondition case splitter.\<close>
+
+(* FIXME: this needs adjustment, case_prod Q is unlikely to unify *)
+lemma wpc_helper_validI:
+  "(\<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>) \<Longrightarrow> wpc_helper (P, P', P'') (case_prod Q, Q', Q'') (\<lbrace>curry P\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>)"
+  by (clarsimp simp: wpc_helper_def elim!: validI_weaken_pre)
+
+wpc_setup "\<lambda>m. \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> m \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>" wpc_helper_validI
+
+
+subsection \<open>RG Logic Rules\<close>
+
 lemma trace_steps_append:
   "trace_steps (xs @ ys) s
-    = trace_steps xs s \<union> trace_steps ys (last_st_tr (rev xs) s)"
+   = trace_steps xs s \<union> trace_steps ys (last_st_tr (rev xs) s)"
   by (induct xs arbitrary: s, simp_all add: last_st_tr_def hd_append)
 
 lemma rely_cond_append:
@@ -130,11 +214,11 @@ lemma guar_cond_append:
   by (simp add: guar_cond_def trace_steps_append ball_Un conj_comms)
 
 lemma prefix_closed_bind:
-  "prefix_closed f \<Longrightarrow> (\<forall>x. prefix_closed (g x)) \<Longrightarrow> prefix_closed (f >>= g)"
+  "\<lbrakk>prefix_closed f; \<forall>x. prefix_closed (g x)\<rbrakk> \<Longrightarrow> prefix_closed (f >>= g)"
   apply (subst prefix_closed_def, clarsimp simp: bind_def)
   apply (auto simp: Cons_eq_append_conv split: tmres.split_asm
              dest!: prefix_closedD[rotated];
-    fastforce elim: rev_bexI)
+         fastforce elim: rev_bexI)
   done
 
 lemmas prefix_closed_bind[rule_format, wp_split]
@@ -152,8 +236,8 @@ lemma last_st_tr_Cons[simp]:
   by (simp add: last_st_tr_def)
 
 lemma bind_twp[wp_split]:
-  "\<lbrakk>  \<And>r. \<lbrace>Q' r\<rbrace>,\<lbrace>R\<rbrace> g r \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f >>= (\<lambda>r. g r) \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  "\<lbrakk> \<And>r. \<lbrace>Q' r\<rbrace>,\<lbrace>R\<rbrace> g r \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f >>= (\<lambda>r. g r) \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
   apply (subst validI_def, rule conjI)
    apply (blast intro: prefix_closed_bind validI_prefix_closed)
   apply (clarsimp simp: bind_def rely_def)
@@ -167,15 +251,15 @@ lemma bind_twp[wp_split]:
 
 lemma trace_steps_rev_drop_nth:
   "trace_steps (rev (drop n tr)) s
-        = (\<lambda>i. (fst (rev tr ! i), (if i = 0 then s else snd (rev tr ! (i - 1))),
-            snd (rev tr ! i))) ` {..< length tr - n}"
+   = (\<lambda>i. (fst (rev tr ! i), (if i = 0 then s else snd (rev tr ! (i - 1))),
+           snd (rev tr ! i))) ` {..< length tr - n}"
   apply (simp add: trace_steps_nth)
   apply (intro image_cong refl)
   apply (simp add: rev_nth)
   done
 
 lemma prefix_closed_drop:
-  "(tr, res) \<in> f s \<Longrightarrow> prefix_closed f \<Longrightarrow> \<exists>res'. (drop n tr, res') \<in> f s"
+  "\<lbrakk>(tr, res) \<in> f s; prefix_closed f\<rbrakk> \<Longrightarrow> \<exists>res'. (drop n tr, res') \<in> f s"
 proof (induct n arbitrary: res)
   case 0 then show ?case by auto
 next
@@ -189,15 +273,15 @@ qed
 
 lemma validI_GD_drop:
   "\<lbrakk> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>; P s0 s; (tr, res) \<in> f s;
-        rely_cond R s0 (drop n tr) \<rbrakk>
-    \<Longrightarrow> guar_cond G s0 (drop n tr)"
+     rely_cond R s0 (drop n tr) \<rbrakk>
+   \<Longrightarrow> guar_cond G s0 (drop n tr)"
   apply (drule prefix_closed_drop[where n=n], erule validI_prefix_closed)
   apply (auto dest: validI_GD)
   done
 
 lemma parallel_prefix_closed[wp_split]:
-  "prefix_closed f \<Longrightarrow> prefix_closed g
-    \<Longrightarrow> prefix_closed (parallel f g)"
+  "\<lbrakk>prefix_closed f; prefix_closed g\<rbrakk>
+   \<Longrightarrow> prefix_closed (parallel f g)"
   apply (subst prefix_closed_def, clarsimp simp: parallel_def)
   apply (case_tac f_steps; clarsimp)
   apply (drule(1) prefix_closedD)+
@@ -210,115 +294,110 @@ lemma rely_cond_drop:
   by simp
 
 lemma rely_cond_is_drop:
-  "rely_cond R s0 xs
-    \<Longrightarrow> (ys = drop (length xs - length ys) xs)
-    \<Longrightarrow> rely_cond R s0 ys"
+  "\<lbrakk>rely_cond R s0 xs; (ys = drop (length xs - length ys) xs)\<rbrakk>
+   \<Longrightarrow> rely_cond R s0 ys"
   by (metis rely_cond_drop)
 
 lemma bounded_rev_nat_induct:
-  "(\<And>n. N \<le> n \<Longrightarrow> P n) \<Longrightarrow> (\<And>n. n < N \<Longrightarrow> P (Suc n) \<Longrightarrow> P n)
-    \<Longrightarrow> P n"
+  "\<lbrakk>(\<And>n. N \<le> n \<Longrightarrow> P n); \<And>n. \<lbrakk>n < N; P (Suc n)\<rbrakk> \<Longrightarrow> P n\<rbrakk>
+   \<Longrightarrow> P n"
   by (induct diff\<equiv>"N - n" arbitrary: n; simp)
 
 lemma drop_n_induct:
-  "P [] \<Longrightarrow> (\<And>n. n < length xs \<Longrightarrow> P (drop (Suc n) xs) \<Longrightarrow> P (drop n xs))
-    \<Longrightarrow> P (drop n xs)"
+  "\<lbrakk>P []; \<And>n. \<lbrakk>n < length xs; P (drop (Suc n) xs)\<rbrakk> \<Longrightarrow> P (drop n xs)\<rbrakk>
+   \<Longrightarrow> P (drop n xs)"
   by (induct len\<equiv>"length (drop n xs)" arbitrary: n xs; simp)
 
 lemma guar_cond_Cons_eq:
   "guar_cond R s0 (x # xs)
-        = (guar_cond R s0 xs \<and> (fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
+   = (guar_cond R s0 xs \<and> (fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
   by (cases "fst x"; simp add: guar_cond_def trace_steps_append conj_comms)
 
 lemma guar_cond_Cons:
-  "guar_cond R s0 xs
-    \<Longrightarrow> fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
-    \<Longrightarrow> guar_cond R s0 (x # xs)"
+  "\<lbrakk>guar_cond R s0 xs; fst x \<noteq> Env \<longrightarrow> R (last_st_tr xs s0) (snd x)\<rbrakk>
+   \<Longrightarrow> guar_cond R s0 (x # xs)"
   by (simp add: guar_cond_Cons_eq)
 
 lemma guar_cond_drop_Suc_eq:
   "n < length xs
-    \<Longrightarrow> guar_cond R s0 (drop n xs) = (guar_cond R s0 (drop (Suc n) xs)
-        \<and> (fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
+   \<Longrightarrow> guar_cond R s0 (drop n xs) = (guar_cond R s0 (drop (Suc n) xs)
+       \<and> (fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
   apply (rule trans[OF _ guar_cond_Cons_eq])
   apply (simp add: Cons_nth_drop_Suc)
   done
 
 lemma guar_cond_drop_Suc:
-  "guar_cond R s0 (drop (Suc n) xs)
-    \<Longrightarrow> fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
-    \<Longrightarrow> guar_cond R s0 (drop n xs)"
+  "\<lbrakk>guar_cond R s0 (drop (Suc n) xs);
+    fst (xs ! n) \<noteq> Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))\<rbrakk>
+   \<Longrightarrow> guar_cond R s0 (drop n xs)"
   by (case_tac "n < length xs"; simp add: guar_cond_drop_Suc_eq)
 
 lemma rely_cond_Cons_eq:
   "rely_cond R s0 (x # xs)
-        = (rely_cond R s0 xs \<and> (fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
+   = (rely_cond R s0 xs \<and> (fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)))"
   by (simp add: rely_cond_def trace_steps_append conj_comms)
 
 lemma rely_cond_Cons:
-  "rely_cond R s0 xs
-    \<Longrightarrow> fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)
-    \<Longrightarrow> rely_cond R s0 (x # xs)"
+  "\<lbrakk>rely_cond R s0 xs; fst x = Env \<longrightarrow> R (last_st_tr xs s0) (snd x)\<rbrakk>
+   \<Longrightarrow> rely_cond R s0 (x # xs)"
   by (simp add: rely_cond_Cons_eq)
 
 lemma rely_cond_drop_Suc_eq:
   "n < length xs
-    \<Longrightarrow> rely_cond R s0 (drop n xs) = (rely_cond R s0 (drop (Suc n) xs)
-        \<and> (fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
+   \<Longrightarrow> rely_cond R s0 (drop n xs) = (rely_cond R s0 (drop (Suc n) xs)
+       \<and> (fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))))"
   apply (rule trans[OF _ rely_cond_Cons_eq])
   apply (simp add: Cons_nth_drop_Suc)
   done
 
 lemma rely_cond_drop_Suc:
-  "rely_cond R s0 (drop (Suc n) xs)
-    \<Longrightarrow> fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))
-    \<Longrightarrow> rely_cond R s0 (drop n xs)"
+  "\<lbrakk>rely_cond R s0 (drop (Suc n) xs);
+    fst (xs ! n) = Env \<longrightarrow> R (last_st_tr (drop (Suc n) xs) s0) (snd (xs ! n))\<rbrakk>
+   \<Longrightarrow> rely_cond R s0 (drop n xs)"
   by (cases "n < length xs"; simp add: rely_cond_drop_Suc_eq)
 
 lemma last_st_tr_map_zip_hd:
-  "length flags = length tr
-    \<Longrightarrow> tr \<noteq> [] \<longrightarrow> snd (f (hd flags, hd tr)) = snd (hd tr)
-    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
+  "\<lbrakk>length flags = length tr; tr \<noteq> [] \<longrightarrow> snd (f (hd flags, hd tr)) = snd (hd tr)\<rbrakk>
+   \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
   apply (cases tr; simp)
   apply (cases flags; simp)
   apply (simp add: fun_eq_iff)
   done
 
 lemma last_st_tr_drop_map_zip_hd:
-  "length flags = length tr
-    \<Longrightarrow> n < length tr \<longrightarrow> snd (f (flags ! n, tr ! n)) = snd (tr ! n)
-    \<Longrightarrow> last_st_tr (drop n (map f (zip flags tr))) = last_st_tr (drop n tr)"
+  "\<lbrakk>length flags = length tr;
+    n < length tr \<longrightarrow> snd (f (flags ! n, tr ! n)) = snd (tr ! n)\<rbrakk>
+   \<Longrightarrow> last_st_tr (drop n (map f (zip flags tr))) = last_st_tr (drop n tr)"
   apply (simp add: drop_map drop_zip)
   apply (rule last_st_tr_map_zip_hd; clarsimp)
   apply (simp add: hd_drop_conv_nth)
   done
 
 lemma last_st_tr_map_zip:
-  "length flags = length tr
-    \<Longrightarrow> \<forall>fl tmid s. snd (f (fl, (tmid, s))) = s
-    \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
+  "\<lbrakk>length flags = length tr; \<forall>fl tmid s. snd (f (fl, (tmid, s))) = s\<rbrakk>
+   \<Longrightarrow> last_st_tr (map f (zip flags tr)) = last_st_tr tr"
   apply (erule last_st_tr_map_zip_hd)
   apply (clarsimp simp: neq_Nil_conv)
   done
 
 lemma parallel_rely_induct:
   assumes preds: "(tr, v) \<in> parallel f g s" "Pf s0 s" "Pg s0 s"
-  assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f' \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
+  and validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f' \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
      "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g' \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
      "f s \<subseteq> f' s" "g s \<subseteq> g' s"
-  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
-     "Gf \<le> Rg" "Gg \<le> Rf"
+  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G" "Gf \<le> Rg" "Gg \<le> Rf"
   and rely: "rely_cond R s0 (drop n tr)"
-  shows "\<exists>tr_f tr_g. (tr_f, v) \<in> f s \<and> (tr_g, v) \<in> g s
-      \<and> rely_cond Rf s0 (drop n tr_f) \<and> rely_cond Rg s0 (drop n tr_g)
-      \<and> map snd tr_f = map snd tr \<and> map snd tr_g = map snd tr
-      \<and> (\<forall>i \<le> length tr. last_st_tr (drop i tr_g) s0 = last_st_tr (drop i tr_f) s0)
-      \<and> guar_cond G s0 (drop n tr)"
+  shows
+    "\<exists>tr_f tr_g. (tr_f, v) \<in> f s \<and> (tr_g, v) \<in> g s
+       \<and> rely_cond Rf s0 (drop n tr_f) \<and> rely_cond Rg s0 (drop n tr_g)
+       \<and> map snd tr_f = map snd tr \<and> map snd tr_g = map snd tr
+       \<and> (\<forall>i \<le> length tr. last_st_tr (drop i tr_g) s0 = last_st_tr (drop i tr_f) s0)
+       \<and> guar_cond G s0 (drop n tr)"
   (is "\<exists>ys zs. _ \<and> _ \<and> ?concl ys zs")
 proof -
   obtain ys zs where tr: "tr = map parallel_mrg (zip ys zs)"
-      and all2: "list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs"
-      and ys: "(ys, v) \<in> f s" and zs: "(zs, v) \<in> g s"
+    and all2: "list_all2 (\<lambda>y z. (fst y = Env \<or> fst z = Env) \<and> snd y = snd z) ys zs"
+    and ys: "(ys, v) \<in> f s" and zs: "(zs, v) \<in> g s"
     using preds
     by (clarsimp simp: parallel_def2)
   note len[simp] = list_all2_lengthD[OF all2]
@@ -339,7 +418,7 @@ proof -
      apply (simp add: list_all2_conv_all_nth last_st_tr_def drop_map[symmetric]
                       hd_drop_conv_nth hd_append)
      apply (fastforce simp: split_def intro!: nth_equalityI)
-     apply clarsimp
+    apply clarsimp
     apply (erule_tac x=n in meta_allE)+
     apply (drule meta_mp, erule rely_cond_is_drop, simp)
     apply (subst(asm) rely_cond_drop_Suc_eq[where xs="map f xs" for f xs], simp)
@@ -360,8 +439,7 @@ lemmas parallel_rely_induct0 = parallel_rely_induct[where n=0, simplified]
 lemma rg_validI:
   assumes validI: "\<lbrace>Pf\<rbrace>,\<lbrace>Rf\<rbrace> f \<lbrace>Gf\<rbrace>,\<lbrace>Qf\<rbrace>"
      "\<lbrace>Pg\<rbrace>,\<lbrace>Rg\<rbrace> g \<lbrace>Gg\<rbrace>,\<lbrace>Qg\<rbrace>"
-  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G"
-     "Gf \<le> Rg" "Gg \<le> Rf"
+  and compat: "R \<le> Rf" "R \<le> Rg" "Gf \<le> G" "Gg \<le> G" "Gf \<le> Rg" "Gg \<le> Rf"
   shows "\<lbrace>Pf and Pg\<rbrace>,\<lbrace>R\<rbrace> parallel f g \<lbrace>G\<rbrace>,\<lbrace>\<lambda>rv. Qf rv and Qg rv\<rbrace>"
   apply (clarsimp simp: validI_def rely_def pred_conj_def
                         parallel_prefix_closed validI[THEN validI_prefix_closed])
@@ -371,36 +449,6 @@ lemma rg_validI:
   apply (simp add: last_st_tr_def)
   done
 
-lemma validI_weaken_pre[wp_pre]:
-  "\<lbrace>P'\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<And>s0 s. P s0 s \<Longrightarrow> P' s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (simp add: validI_def, blast)
-
-lemma rely_weaken:
-  "(\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
-    \<Longrightarrow> (tr, res) \<in> rely f R s s0 \<Longrightarrow> (tr, res) \<in> rely f R' s s0"
-  by (simp add: rely_def rely_cond_def, blast)
-
-lemma validI_weaken_rely[wp_pre]:
-  "\<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<forall>s0 s. R s0 s \<longrightarrow> R' s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  apply (simp add: validI_def)
-  by (metis rely_weaken)
-
-lemma validI_strengthen_post:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q'\<rbrace>
-    \<Longrightarrow> (\<forall>v s0 s. Q' v s0 s \<longrightarrow> Q v s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
-  by (simp add: validI_def)
-
-lemma validI_strengthen_guar:
-  "\<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G'\<rbrace>, \<lbrace>Q\<rbrace>
-    \<Longrightarrow> (\<forall>s0 s. G' s0 s \<longrightarrow> G s0 s)
-    \<Longrightarrow> \<lbrace>P\<rbrace>, \<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>, \<lbrace>Q\<rbrace>"
-  by (force simp: validI_def guar_cond_def)
-
 lemma rely_prim[simp]:
   "rely (\<lambda>s. insert (v s) (f s)) R s0 = (\<lambda>s. {x. x = v s \<and> rely_cond R s0 (fst x)} \<union> (rely f R s0 s))"
   "rely (\<lambda>s. {}) R s0 = (\<lambda>_. {})"
@@ -420,7 +468,7 @@ lemma prefix_closed_put_trace[iff]:
 
 lemma put_trace_eq_drop:
   "put_trace xs s
-    = ((\<lambda>n. (drop n xs, if n = 0 then Result ((), s) else Incomplete)) ` {.. length xs})"
+   = ((\<lambda>n. (drop n xs, if n = 0 then Result ((), s) else Incomplete)) ` {.. length xs})"
   apply (induct xs)
    apply (clarsimp simp: return_def)
   apply (clarsimp simp: put_trace_elem_def bind_def)
@@ -434,15 +482,17 @@ lemma put_trace_eq_drop:
 
 lemma put_trace_res:
   "(tr, res) \<in> put_trace xs s
-    \<Longrightarrow> \<exists>n. tr = drop n xs \<and> n \<le> length xs
-        \<and> res = (case n of 0 \<Rightarrow> Result ((), s) | _ \<Rightarrow> Incomplete)"
+   \<Longrightarrow> \<exists>n. tr = drop n xs \<and> n \<le> length xs
+         \<and> res = (case n of 0 \<Rightarrow> Result ((), s) | _ \<Rightarrow> Incomplete)"
   apply (clarsimp simp: put_trace_eq_drop)
   apply (case_tac n; auto intro: exI[where x=0])
   done
 
 lemma put_trace_twp[wp]:
   "\<lbrace>\<lambda>s0 s. (\<forall>n. rely_cond R s0 (drop n xs) \<longrightarrow> guar_cond G s0 (drop n xs))
-    \<and> (rely_cond R s0 xs \<longrightarrow> Q () (last_st_tr xs s0) s)\<rbrace>,\<lbrace>R\<rbrace> put_trace xs \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+     \<and> (rely_cond R s0 xs \<longrightarrow> Q () (last_st_tr xs s0) s)\<rbrace>,\<lbrace>R\<rbrace>
+   put_trace xs
+   \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
   apply (clarsimp simp: validI_def rely_def)
   apply (drule put_trace_res)
   apply (clarsimp; clarsimp split: nat.split_asm)
@@ -464,31 +514,31 @@ lemma rely_cond_rtranclp:
   done
 
 
+subsection \<open>Setting up the @{method wp} method\<close>
 
 (* Attempt to define triple_judgement to use valid_validI_wp as wp_comb rule.
    It doesn't work. It seems that wp_comb rules cannot take more than 1 assumption *)
-lemma validI_is_triple:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace> =
-     triple_judgement (\<lambda>(s0, s). prefix_closed f \<longrightarrow> P s0 s) f
+lemma validI_is_triple[wp_trip]:
+  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>
+   = triple_judgement (\<lambda>(s0, s). prefix_closed f \<longrightarrow> P s0 s) f
                       (\<lambda>(s0,s) f. prefix_closed f \<and> (\<forall>tr res. (tr, res) \<in> rely f R s0 s
                           \<longrightarrow> guar_cond G s0 tr
                               \<and> (\<forall>rv s'. res = Result (rv, s') \<longrightarrow> Q rv (last_st_tr tr s0) s')))"
   apply (simp add: triple_judgement_def validI_def )
-  apply (cases "prefix_closed f"; simp)
+  apply (cases "prefix_closed f"; fastforce)
   done
 
-lemmas [wp_trip] = validI_is_triple
-
 lemma no_trace_prefix_closed:
   "no_trace f \<Longrightarrow> prefix_closed f"
   by (auto simp add: prefix_closed_def dest: no_trace_emp)
 
 lemma valid_validI_wp[wp_comb]:
-  "no_trace f \<Longrightarrow> (\<And>s0. \<lbrace>P s0\<rbrace> f \<lbrace>\<lambda>v. Q v s0 \<rbrace>)
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  "\<lbrakk>no_trace f; \<And>s0. \<lbrace>P s0\<rbrace> f \<lbrace>\<lambda>v. Q v s0 \<rbrace>\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
   by (fastforce simp: rely_def validI_def valid_def mres_def no_trace_prefix_closed dest: no_trace_emp
     elim: image_eqI[rotated])
 
+
 lemma env_steps_twp[wp]:
   "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s0 s' \<longrightarrow> Q () s' s') \<and> Q () s0 s\<rbrace>,\<lbrace>R\<rbrace> env_steps \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
   apply (simp add: interference_def env_steps_def)
@@ -499,7 +549,7 @@ lemma env_steps_twp[wp]:
   done
 
 lemma interference_twp[wp]:
-  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s s' \<longrightarrow> Q () s' s') \<and> G s0 s\<rbrace>,\<lbrace>R\<rbrace>  interference \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  "\<lbrace>\<lambda>s0 s. (\<forall>s'. R\<^sup>*\<^sup>* s s' \<longrightarrow> Q () s' s') \<and> G s0 s\<rbrace>,\<lbrace>R\<rbrace> interference \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
   apply (simp add: interference_def commit_step_def del: put_trace.simps)
   apply wp
   apply clarsimp
@@ -520,15 +570,8 @@ lemma Await_sync_twp:
   apply (simp add: o_def)
   done
 
-(* FIXME: this needs adjustment, case_prod Q is unlikely to unify *)
-lemma wpc_helper_validI:
-  "(\<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>) \<Longrightarrow> wpc_helper (P, P', P'') (case_prod Q, Q', Q'') (\<lbrace>curry P\<rbrace>,\<lbrace>R\<rbrace> g \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>)"
-  by (clarsimp simp: wpc_helper_def elim!: validI_weaken_pre)
-
-wpc_setup "\<lambda>m. \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> m \<lbrace>G\<rbrace>,\<lbrace>S\<rbrace>" wpc_helper_validI
-
 lemma mres_union:
- "mres (a \<union> b) = mres a \<union> mres b"
+  "mres (a \<union> b) = mres a \<union> mres b"
   by (simp add: mres_def image_Un)
 
 lemma mres_Failed_empty:
@@ -554,21 +597,16 @@ lemma validI_name_pre:
   by metis
 
 lemma validI_well_behaved':
-  "prefix_closed f
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G'\<rbrace>,\<lbrace>Q\<rbrace>
-    \<Longrightarrow> R \<le> R'
-    \<Longrightarrow> G' \<le> G
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
+  "\<lbrakk>prefix_closed f; \<lbrace>P\<rbrace>,\<lbrace>R'\<rbrace> f \<lbrace>G'\<rbrace>,\<lbrace>Q\<rbrace>; R \<le> R'; G' \<le> G\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G\<rbrace>,\<lbrace>Q\<rbrace>"
   apply (subst validI_def, clarsimp)
   apply (clarsimp simp add: rely_def)
   apply (drule (2)  validI_D)
-  apply (fastforce simp: rely_cond_def guar_cond_def)+
+   apply (fastforce simp: rely_cond_def guar_cond_def)+
   done
 
 lemmas validI_well_behaved = validI_well_behaved'[unfolded le_fun_def, simplified]
 
-
-
 lemma prefix_closed_mapM[rule_format, wp_split]:
   "(\<forall>x \<in> set xs. prefix_closed (f x)) \<Longrightarrow> prefix_closed (mapM f xs)"
   apply (induct xs)
@@ -577,36 +615,36 @@ lemma prefix_closed_mapM[rule_format, wp_split]:
   apply (intro prefix_closed_bind allI; clarsimp)
   done
 
-lemmas bind_promote_If
-    = if_distrib[where f="\<lambda>f. bind f g" for g]
-      if_distrib[where f="\<lambda>g. bind f g" for f]
+lemmas bind_promote_If =
+  if_distrib[where f="\<lambda>f. bind f g" for g]
+  if_distrib[where f="\<lambda>g. bind f g" for f]
 
 lemma bind_promote_If2:
   "do x \<leftarrow> f; if P then g x else h x od
-    = (if P then bind f g else bind f h)"
+   = (if P then bind f g else bind f h)"
   by simp
 
 lemma exec_put_trace[unfolded K_bind_def]:
   "(do put_trace xs; f od) s
-    = (\<Union>n \<in> {n. 0 < n \<and> n \<le> length xs}. {(drop n xs, Incomplete)})
-        \<union> ((\<lambda>(a, b). (a @ xs, b)) ` f s)"
+   = (\<Union>n \<in> {n. 0 < n \<and> n \<le> length xs}. {(drop n xs, Incomplete)})
+     \<union> ((\<lambda>(a, b). (a @ xs, b)) ` f s)"
   apply (simp add: put_trace_eq_drop bind_def)
   apply (safe; (clarsimp split: if_split_asm)?;
-      fastforce intro: bexI[where x=0] rev_bexI)
+         fastforce intro: bexI[where x=0] rev_bexI)
   done
 
 lemma UN_If_distrib:
   "(\<Union>x \<in> S. if P x then A x else B x)
-    = ((\<Union>x \<in> S \<inter> {x. P x}. A x) \<union> (\<Union>x \<in> S \<inter> {x. \<not> P x}. B x))"
+   = ((\<Union>x \<in> S \<inter> {x. P x}. A x) \<union> (\<Union>x \<in> S \<inter> {x. \<not> P x}. B x))"
   by (fastforce split: if_split_asm)
 
 lemma Await_redef:
   "Await P = do
-    s1 \<leftarrow> select {s. P s};
-    env_steps;
-    s \<leftarrow> get;
-    select (if P s then {()} else {})
-  od"
+     s1 \<leftarrow> select {s. P s};
+     env_steps;
+     s \<leftarrow> get;
+     select (if P s then {()} else {})
+   od"
   apply (simp add: Await_def env_steps_def bind_assoc)
   apply (cases "{s. P s} = {}")
    apply (simp add: select_def bind_def get_def)
@@ -635,22 +673,22 @@ lemma validI_invariant_imp:
   shows "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. I s0 \<and> I s \<and> G s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. I s0 \<and> Q rv s0 s\<rbrace>"
 proof -
   { fix tr s0 i
-  assume r: "rely_cond R s0 tr" and g: "guar_cond G s0 tr"
-    and I: "I s0"
-  hence imp: "\<forall>(_, s, s') \<in> trace_steps (rev tr) s0. I s \<longrightarrow> I s'"
-    apply (clarsimp simp: guar_cond_def rely_cond_def)
-    apply (drule(1) bspec)+
-    apply (clarsimp simp: eq_Me_neq_Env)
-    apply (metis R G)
-    done
-  hence "i < length tr \<longrightarrow> I (snd (rev tr ! i))"
-    using I
-    apply (induct i)
-     apply (clarsimp simp: neq_Nil_conv[where xs="rev tr" for tr, simplified])
-    apply clarsimp
-    apply (drule bspec, fastforce simp add: trace_steps_nth)
-    apply simp
-    done
+    assume r: "rely_cond R s0 tr" and g: "guar_cond G s0 tr"
+      and I: "I s0"
+    hence imp: "\<forall>(_, s, s') \<in> trace_steps (rev tr) s0. I s \<longrightarrow> I s'"
+      apply (clarsimp simp: guar_cond_def rely_cond_def)
+      apply (drule(1) bspec)+
+      apply (clarsimp simp: eq_Me_neq_Env)
+      apply (metis R G)
+      done
+    hence "i < length tr \<longrightarrow> I (snd (rev tr ! i))"
+      using I
+      apply (induct i)
+       apply (clarsimp simp: neq_Nil_conv[where xs="rev tr" for tr, simplified])
+      apply clarsimp
+      apply (drule bspec, fastforce simp add: trace_steps_nth)
+      apply simp
+      done
   }
   note I = this
   show ?thesis
@@ -666,9 +704,8 @@ proof -
 qed
 
 lemma validI_guar_post_conj_lift:
-  "\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G1\<rbrace>,\<lbrace>Q1\<rbrace>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G2\<rbrace>,\<lbrace>Q2\<rbrace>
-    \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. G1 s0 s \<and> G2 s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. Q1 rv s0 s \<and> Q2 rv s0 s\<rbrace>"
+  "\<lbrakk>\<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G1\<rbrace>,\<lbrace>Q1\<rbrace>; \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>G2\<rbrace>,\<lbrace>Q2\<rbrace>\<rbrakk>
+   \<Longrightarrow> \<lbrace>P\<rbrace>,\<lbrace>R\<rbrace> f \<lbrace>\<lambda>s0 s. G1 s0 s \<and> G2 s0 s\<rbrace>,\<lbrace>\<lambda>rv s0 s. Q1 rv s0 s \<and> Q2 rv s0 s\<rbrace>"
   apply (frule validI_prefix_closed)
   apply (subst validI_def, clarsimp simp: rely_def)
   apply (drule(3) validI_D)+
diff --git a/lib/Monads/trace/Trace_VCG.thy b/lib/Monads/trace/Trace_VCG.thy
index 12e2576aa0..c20265ebd4 100644
--- a/lib/Monads/trace/Trace_VCG.thy
+++ b/lib/Monads/trace/Trace_VCG.thy
@@ -19,7 +19,7 @@ text \<open>
   This section defines a Hoare logic for partial correctness for
   the interference trace monad as well as the exception monad.
   The logic talks only about the behaviour part of the monad and ignores
-  the failure flag.
+  failures and the trace.
 
   The logic is defined semantically. Rules work directly on the
   validity predicate.
@@ -29,12 +29,11 @@ text \<open>
   bool (a state predicate), the postcondition is a function from return value
   to state to bool. A triple is valid if for all states that satisfy the
   precondition, all result values and result states that are returned by
-  the monad satisfy the postcondition. Note that if the computation returns
-  the empty set, the triple is trivially valid. This means @{term "assert P"}
-  does not require us to prove that @{term P} holds, but rather allows us
-  to assume @{term P}! Proving non-failure is done via a separate predicate and
-  calculus (see Trace_No_Fail).\<close>
-
+  the monad satisfy the postcondition. Note that if the result of the
+  computation is the empty set then the triple is trivially valid. This means
+  @{term "assert P"} does not require us to prove that @{term P} holds, but
+  rather allows us to assume @{term P}! Proving non-failure is done via a
+  separate predicate and calculus (see Trace_No_Fail).\<close>
 definition valid :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) tmonad \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
   ("\<lbrace>_\<rbrace>/ _ /\<lbrace>_\<rbrace>") where
   "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<equiv> \<forall>s. P s \<longrightarrow> (\<forall>(r,s') \<in> mres (f s). Q r s')"

From 31b2a30d0afc27bd58c5a2514ccdbc9ce3e971c6 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Mon, 14 Aug 2023 17:33:28 +1000
Subject: [PATCH 5/5] lib: update for trace monad refactor

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 lib/Crunch_Instances_Trace.thy        | 3 ++-
 lib/concurrency/Atomicity_Lib.thy     | 7 ++++---
 lib/concurrency/Prefix_Refinement.thy | 4 +---
 lib/concurrency/Triv_Refinement.thy   | 4 ++--
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/lib/Crunch_Instances_Trace.thy b/lib/Crunch_Instances_Trace.thy
index e7966c63b8..bf8acb44b1 100644
--- a/lib/Crunch_Instances_Trace.thy
+++ b/lib/Crunch_Instances_Trace.thy
@@ -7,7 +7,8 @@
 theory Crunch_Instances_Trace
 imports
   Crunch
-  Monads.Trace_VCG
+  Monads.Trace_No_Fail
+  Monads.Trace_RG
 begin
 
 lemmas [crunch_param_rules] = Let_def return_bind returnOk_bindE
diff --git a/lib/concurrency/Atomicity_Lib.thy b/lib/concurrency/Atomicity_Lib.thy
index 728dbdac88..8f50ac0e02 100644
--- a/lib/concurrency/Atomicity_Lib.thy
+++ b/lib/concurrency/Atomicity_Lib.thy
@@ -5,8 +5,9 @@
  *)
 theory Atomicity_Lib
 
-imports "Prefix_Refinement"
-
+imports
+  Prefix_Refinement
+  Monads.Trace_Det
 begin
 
 text \<open>This library introduces a number of proofs about the question of
@@ -186,7 +187,7 @@ lemma repeat_n_nothing:
 lemma repeat_nothing:
   "repeat (\<lambda>_. {}) = return ()"
   by (simp add: repeat_def bind_def select_def repeat_n_nothing
-                Sigma_def if_fun_lift UN_If_distrib return_def
+                Sigma_def if_distribR UN_If_distrib return_def
            cong del: image_cong_simp)
 
 lemma detrace_env_steps:
diff --git a/lib/concurrency/Prefix_Refinement.thy b/lib/concurrency/Prefix_Refinement.thy
index 774d3360f6..20f0e5bf9b 100644
--- a/lib/concurrency/Prefix_Refinement.thy
+++ b/lib/concurrency/Prefix_Refinement.thy
@@ -7,8 +7,6 @@ theory Prefix_Refinement
 
 imports
   Triv_Refinement
-  "Monads.Trace_Lemmas"
-
 begin
 
 section \<open>Definition of prefix fragment refinement.\<close>
@@ -1242,7 +1240,7 @@ lemma prefix_refinement_repeat:
       apply simp
       apply (rule prefix_refinement_repeat_n, assumption+)
       apply (rule validI_weaken_pre, assumption, simp)
-     apply (wp select_wp)
+     apply wp
     apply wp
    apply clarsimp
   apply clarsimp
diff --git a/lib/concurrency/Triv_Refinement.thy b/lib/concurrency/Triv_Refinement.thy
index caefd59834..b31995381f 100644
--- a/lib/concurrency/Triv_Refinement.thy
+++ b/lib/concurrency/Triv_Refinement.thy
@@ -6,8 +6,8 @@
 theory Triv_Refinement
 
 imports
-  "Monads.Trace_VCG"
-  "Monads.Strengthen"
+  "Monads.Trace_RG"
+  "Monads.Trace_Strengthen_Setup"
 
 begin