(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

(*
* Zhe Hou: I modified this file to model a deterministic monad instead of
* a non-deterministic monad. Features that are irrelevant to deterministic
* moands are removed. I also removed the section for loops, which are not
* used in the modelling of the SPARC architecture.
*)

(*
   Deterministic state and error monads with failure in Isabelle.
*)

(*chapter "Deterministic State Monad with Failure"*)

theory DetMonad
imports "../Lib"
begin

text \<open>
  \label{c:monads}

  State monads are used extensively in the seL4 specification. They are
  defined below.
\<close>

section "The Monad"

text \<open>
  The basic type of the deterministic state monad with failure is
  very similar to the normal state monad. Instead of a pair consisting
  of result and new state, we return a pair coupled with
  a failure flag. The flag is @{const True} if the computation have failed.
  Conversely, if the flag is @{const False}, the computation resulting in
  the returned result have succeeded.\<close>
type_synonym ('s,'a) det_monad = "'s \<Rightarrow> ('a \<times> 's) \<times> bool"

text \<open>
  The definition of fundamental monad functions \<open>return\<close> and
  \<open>bind\<close>. The monad function \<open>return x\<close> does not change
  the  state, does not fail, and returns \<open>x\<close>.
\<close>
definition
  return :: "'a \<Rightarrow> ('s,'a) det_monad" where
  "return a \<equiv> \<lambda>s. ((a,s),False)"

text \<open>
  The monad function \<open>bind f g\<close>, also written \<open>f >>= g\<close>,
  is the execution of @{term f} followed by the execution of \<open>g\<close>.
  The function \<open>g\<close> takes the result value \emph{and} the result
  state of \<open>f\<close> as parameter. The definition says that the result of
  the combined operation is the result which is created
  by \<open>g\<close> applied to the result of \<open>f\<close>. The combined
  operation may have failed, if \<open>f\<close> may have failed or \<open>g\<close> may
  have failed on the result of \<open>f\<close>.
\<close>

text \<open>
 David Sanan and Zhe Hou: The original definition of bind is very inefficient
 when converted to executable code. Here we change it to a more efficient
 version for execution. The idea remains the same.
\<close>

definition "h1 f s = f s"
definition "h2 g fs = (let (a,b) = fst (fs) in g a b)"
definition bind:: "('s, 'a) det_monad \<Rightarrow> ('a \<Rightarrow> ('s, 'b) det_monad) \<Rightarrow>
           ('s, 'b) det_monad" (infixl ">>=" 60)
where
"bind f g \<equiv> \<lambda>s. (
  let fs = h1 f s;
      v = h2 g fs
  in
  (fst v, (snd v \<or> snd fs)))"

text \<open>
  Sometimes it is convenient to write \<open>bind\<close> in reverse order.
\<close>
abbreviation(input)
  bind_rev :: "('c \<Rightarrow> ('a, 'b) det_monad) \<Rightarrow> ('a, 'c) det_monad \<Rightarrow>
               ('a, 'b) det_monad" (infixl "=<<" 60) where
  "g =<< f \<equiv> f >>= g"

text \<open>
  The basic accessor functions of the state monad. \<open>get\<close> returns
  the current state as result, does not fail, and does not change the state.
  \<open>put s\<close> returns nothing (@{typ unit}), changes the current state
  to \<open>s\<close> and does not fail.
\<close>
definition
  get :: "('s,'s) det_monad" where
  "get \<equiv> \<lambda>s. ((s,s), False)"

definition
  put :: "'s \<Rightarrow> ('s, unit) det_monad" where
  "put s \<equiv> \<lambda>_. (((),s), False)"

subsection "Failure"

text \<open>The monad function that always fails. Returns the current
  state and sets the failure flag.\<close>
definition
  fail :: "'a \<Rightarrow> ('s, 'a) det_monad" where
 "fail a \<equiv> \<lambda>s. ((a,s), True)"

text \<open>Assertions: fail if the property \<open>P\<close> is not true\<close>
definition
  assert :: "bool \<Rightarrow> ('a, unit) det_monad" where
 "assert P \<equiv> if P then return () else fail ()"

text \<open>An assertion that also can introspect the current state.\<close>

definition
  state_assert :: "('s \<Rightarrow> bool) \<Rightarrow> ('s, unit) det_monad"
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) det_monad" 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) det_monad" where
 "modify f \<equiv> get >>= (\<lambda>s. put (f s))"

lemma simpler_gets_def: "gets f = (\<lambda>s. ((f s, s), False))"
  apply (simp add: gets_def return_def bind_def h1_def h2_def get_def)
  done

lemma simpler_modify_def:
  "modify f = (\<lambda>s. (((), f s), False))"
  by (simp add: modify_def bind_def h1_def h2_def get_def put_def)

text \<open>Execute the given monad when the condition is true,
  return \<open>()\<close> otherwise.\<close>
definition
  when1 :: "bool \<Rightarrow> ('s, unit) det_monad \<Rightarrow>
           ('s, unit) det_monad" where
  "when1 P m \<equiv> if P then m else return ()"

text \<open>Execute the given monad unless the condition is true,
  return \<open>()\<close> otherwise.\<close>
definition
  unless :: "bool \<Rightarrow> ('s, unit) det_monad \<Rightarrow>
            ('s, unit) det_monad" where
  "unless P m \<equiv> when1 (\<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) det_monad \<Rightarrow> ('s, 'r) det_monad \<Rightarrow> ('s, 'r) det_monad"
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)

subsection \<open>The Monad Laws\<close>

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>
lemma return_bind [simp]: "(return x >>= f) = f x"
  by (simp add: return_def bind_def h1_def h2_def)

text \<open>@{term return} is absorbed on the right of a @{term bind}\<close>
lemma bind_return [simp]: "(m >>= return) = m"
  apply (rule ext)
  apply (simp add: bind_def h1_def h2_def return_def split_def)
  done

text \<open>@{term bind} is associative\<close>
lemma bind_assoc:
  fixes m :: "('a,'b) det_monad"
  fixes f :: "'b \<Rightarrow> ('a,'c) det_monad"
  fixes g :: "'c \<Rightarrow> ('a,'d) det_monad"
  shows "(m >>= f) >>= g  =  m >>= (\<lambda>x. f x >>= g)"
  apply (unfold bind_def h1_def h2_def Let_def split_def)
  apply (rule ext)
  apply clarsimp
  done

section \<open>Adding Exceptions\<close>

text \<open>
  The type @{typ "('s,'a) det_monad"} gives us determinism and
  failure. We now extend this monad with exceptional return values
  that abort normal execution, but can be handled explicitly.
  We use the sum type to indicate exceptions.

  In @{typ "('s, 'e + 'a) det_monad"}, @{typ "'s"} is the state,
  @{typ 'e} is an exception, and @{typ 'a} is a normal return value.

  This new type itself forms a monad again. Since type classes in
  Isabelle are not powerful enough to express the class of monads,
  we provide new names for the @{term return} and @{term bind} functions
  in this monad. We call them \<open>returnOk\<close> (for normal return values)
  and \<open>bindE\<close> (for composition). We also define \<open>throwError\<close>
  to return an exceptional value.
\<close>
definition
  returnOk :: "'a \<Rightarrow> ('s, 'e + 'a) det_monad" where
  "returnOk \<equiv> return o Inr"

definition
  throwError :: "'e \<Rightarrow> ('s, 'e + 'a) det_monad" 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) det_monad) \<Rightarrow>
           'e +'a \<Rightarrow> ('s, 'e + 'b) det_monad"
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 \<open>bindE\<close>): 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) det_monad \<Rightarrow>
            ('a \<Rightarrow> ('s, 'e + 'b) det_monad) \<Rightarrow>
            ('s, 'e + 'b) det_monad"  (infixl ">>=E" 60)
where
  "bindE f g \<equiv> bind f (lift g)"

text \<open>
  Lifting a normal deterministic 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) det_monad \<Rightarrow> ('s, 'e+'a) det_monad"
where
  "liftE f \<equiv> f >>= (\<lambda>r. return (Inr r))"

text \<open>
  Since the underlying type and \<open>return\<close> function changed,
  we need new definitions for when and unless:
\<close>
definition
  whenE :: "bool \<Rightarrow> ('s, 'e + unit) det_monad \<Rightarrow>
            ('s, 'e + unit) det_monad"
  where
  "whenE P f \<equiv> if P then f else returnOk ()"

definition
  unlessE :: "bool \<Rightarrow> ('s, 'e + unit) det_monad \<Rightarrow>
            ('s, 'e + unit) det_monad"
  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) det_monad" where
  "throw_opt ex x \<equiv>
  case x of None \<Rightarrow> throwError ex | Some v \<Rightarrow> returnOk v"

subsection "Monad Laws for the Exception Monad"

text \<open>More direct definition of @{const liftE}:\<close>
lemma liftE_def2:
  "liftE f = (\<lambda>s. ((\<lambda>(v,s'). (Inr v, s'))  (fst (f s)), snd (f s)))"
  by (auto simp: Let_def liftE_def return_def split_def bind_def h1_def h2_def)

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

lemma lift_return [simp]:
  "lift (return \<circ> Inr) = return"
  by (rule ext)
     (simp add: 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"
  by (simp add: bindE_def returnOk_def)

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

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]:
  "(throwError E >>=E f) = throwError E"
  by (simp add: bindE_def bind_def h1_def h2_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>

subsection "Syntax for the Nondeterministic State Monad"

text \<open>We use \<open>K_bind\<close> 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"

nonterminal
  dobinds and dobind and nobind

syntax
  "_dobind"    :: "[pttrn, 'a] => dobind"             ("(_ \<leftarrow>/ _)" 10)
  ""           :: "dobind => dobinds"                 ("_")
  "_nobind"    :: "'a => dobind"                      ("_")
  "_dobinds"   :: "[dobind, dobinds] => dobinds"      ("(_);//(_)")

  "_do"        :: "[dobinds, 'a] => 'a"               ("(do ((_);//(_))//od)" 100)
translations
  "_do (_dobinds b bs) e"  == "_do b (_do bs e)"
  "_do (_nobind b) e"      == "b >>= (CONST K_bind e)"
  "do x \<leftarrow> a; e od"        == "a >>= (\<lambda>x. e)"

text \<open>Syntax examples:\<close>
lemma "do x \<leftarrow> return 1;
          return (2::nat);
          return x
       od =
       return 1 >>=
       (\<lambda>x. return (2::nat) >>=
            K_bind (return x))"
  by (rule refl)

lemma "do x \<leftarrow> return 1;
          return 2;
          return x
       od = return 1"
  by simp

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 \<open>doE\<close>/\<open>odE\<close> for this, but can re-use
  most of the productions from \<open>do\<close>/\<open>od\<close>
  above.
\<close>

syntax
  "_doE" :: "[dobinds, 'a] => 'a"  ("(doE ((_);//(_))//odE)" 100)

translations
  "_doE (_dobinds b bs) e"  == "_doE b (_doE bs e)"
  "_doE (_nobind b) e"      == "b >>=E (CONST K_bind e)"
  "doE x \<leftarrow> a; e odE"       == "a >>=E (\<lambda>x. e)"

text \<open>Syntax examples:\<close>
lemma "doE x \<leftarrow> returnOk 1;
           returnOk (2::nat);
           returnOk x
       odE =
       returnOk 1 >>=E
       (\<lambda>x. returnOk (2::nat) >>=E
            K_bind (returnOk x))"
  by (rule refl)

lemma "doE x \<leftarrow> returnOk 1;
           returnOk 2;
           returnOk x
       odE = returnOk 1"
  by simp

section "Library of Monadic Functions and Combinators"

text \<open>Lifting a normal function into the monad type:\<close>
definition
  liftM :: "('a \<Rightarrow> 'b) \<Rightarrow> ('s,'a) det_monad \<Rightarrow> ('s, 'b) det_monad"
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) det_monad \<Rightarrow> ('s,'e+'b) det_monad"
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) det_monad list \<Rightarrow> ('s, unit) det_monad"
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) det_monad) \<Rightarrow> 'a list \<Rightarrow> ('s, unit) det_monad"
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) det_monad) \<Rightarrow>
                 'a list \<Rightarrow> 'b list \<Rightarrow> ('s, unit) det_monad"
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 \<open>unit\<close>\<close>
definition
  sequence :: "('s, 'a) det_monad list \<Rightarrow> ('s, 'a list) det_monad"
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) det_monad) \<Rightarrow> 'a list \<Rightarrow> ('s, 'b list) det_monad"
where
  "mapM f xs \<equiv> sequence (map f xs)"

definition
  zipWithM :: "('a \<Rightarrow> 'b \<Rightarrow> ('s,'c) det_monad) \<Rightarrow>
                 'a list \<Rightarrow> 'b list \<Rightarrow> ('s, 'c list) det_monad"
where
  "zipWithM f xs ys \<equiv> sequence (zipWith f xs ys)"

definition
  foldM :: "('b \<Rightarrow> 'a \<Rightarrow> ('s, 'a) det_monad) \<Rightarrow> 'b list \<Rightarrow> 'a \<Rightarrow> ('s, 'a) det_monad"
where
  "foldM m xs a \<equiv> foldr (\<lambda>p q. q >>= m p) xs (return 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) det_monad list \<Rightarrow> ('s, 'e+unit) det_monad"
where
  "sequenceE_x xs \<equiv> foldr (\<lambda>x y. doE _ \<leftarrow> x; y odE) xs (returnOk ())"

definition
  mapME_x :: "('a \<Rightarrow> ('s,'e+'b) det_monad) \<Rightarrow> 'a list \<Rightarrow>
              ('s,'e+unit) det_monad"
where
  "mapME_x f xs \<equiv> sequenceE_x (map f xs)"

definition
  sequenceE :: "('s, 'e+'a) det_monad list \<Rightarrow> ('s, 'e+'a list) det_monad"
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 [])"

definition
  mapME :: "('a \<Rightarrow> ('s,'e+'b) det_monad) \<Rightarrow> 'a list \<Rightarrow>
              ('s,'e+'b list) det_monad"
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) det_monad) \<Rightarrow> 'a list \<Rightarrow> ('s, 'a list) det_monad"
where
  "filterM P []       = return []"
| "filterM P (x # xs) = do
     b  \<leftarrow> P x;
     ys \<leftarrow> filterM P xs;
     return (if b then (x # ys) else ys)
   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) det_monad \<Rightarrow>
            ('e \<Rightarrow> ('s, 'a) det_monad) \<Rightarrow>
            ('s, 'a) det_monad" (infix "<catch>" 10)
where
  "f <catch> handler \<equiv>
     do x \<leftarrow> f;
        case x of
          Inr b \<Rightarrow> return b
        | Inl e \<Rightarrow> handler e
     od"

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) det_monad \<Rightarrow>
               ('e1 \<Rightarrow> ('s, 'e2 + 'a) det_monad) \<Rightarrow>
               ('s, 'e2 + 'a) det_monad" (infix "<handle2>" 10)
where
  "f <handle2> handler \<equiv>
   do
      v \<leftarrow> f;
      case v of
        Inl e \<Rightarrow> handler e
      | Inr v' \<Rightarrow> return (Inr v')
   od"

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) det_monad \<Rightarrow>
              ('x \<Rightarrow> ('s, 'x + 'a) det_monad) \<Rightarrow>
              ('s, 'x + 'a) det_monad" (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) det_monad \<Rightarrow>
                   ('e \<Rightarrow> ('s, 'ee + 'b) det_monad) \<Rightarrow>
                   ('a \<Rightarrow> ('s, 'ee + 'b) det_monad) \<Rightarrow>
                   ('s, 'ee + 'b) det_monad"
  ("_ <handle> _ <else> _" 10)
where
  "f <handle> handler <else> continue \<equiv>
   do v \<leftarrow> f;
   case v of Inl e  \<Rightarrow> handler e
           | Inr v' \<Rightarrow> continue v'
   od"

section "Hoare Logic"

subsection "Validity"

text \<open>This section defines a Hoare logic for partial correctness for
  the deterministic state 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 deterministic state 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) det_monad \<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'. ((r,s') = fst (f s) \<longrightarrow> Q r s'))"

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) det_monad \<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>"

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) det_monad \<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) det_monad \<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 preconditions:\<close>
abbreviation(input)
  top :: "'a \<Rightarrow> bool" ("\<top>")
where
  "\<top> \<equiv> \<lambda>_. True"

abbreviation(input)
  bottom :: "'a \<Rightarrow> bool" ("\<bottom>")
where
  "\<bottom> \<equiv> \<lambda>_. False"

text \<open>Abbreviations for trivial postconditions (taking two arguments):\<close>
abbreviation(input)
  toptop :: "'a \<Rightarrow> 'b \<Rightarrow> bool" ("\<top>\<top>")
where
 "\<top>\<top> \<equiv> \<lambda>_ _. True"

abbreviation(input)
  botbot :: "'a \<Rightarrow> 'b \<Rightarrow> bool" ("\<bottom>\<bottom>")
where
 "\<bottom>\<bottom> \<equiv> \<lambda>_ _. False"

text \<open>
  Lifting \<open>\<and>\<close> and \<open>\<or>\<close> over two arguments.
  Lifting \<open>\<and>\<close> and \<open>\<or>\<close> over one argument is already
  defined (written \<open>and\<close> and \<open>or\<close>).
\<close>
definition
  bipred_conj :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool)"
  (infixl "And" 96)
where
  "bipred_conj P Q \<equiv> \<lambda>x y. P x y \<and> Q x y"

definition
  bipred_disj :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool)"
  (infixl "Or" 91)
where
  "bipred_disj P Q \<equiv> \<lambda>x y. P x y \<or> Q x y"

subsection "Determinism"

text \<open>A monad of type \<open>det_monad\<close> is deterministic iff it
returns exactly one state and result and does not fail\<close>
definition
  det :: "('a,'s) det_monad \<Rightarrow> bool"
where
  "det f \<equiv> \<forall>s. \<exists>r. f s = (r,False)"

text \<open>A deterministic \<open>det_monad\<close> can be turned
  into a normal state monad:\<close>
definition
  the_run_state :: "('s,'a) det_monad \<Rightarrow> 's \<Rightarrow> 'a \<times> 's"
where
  "the_run_state M \<equiv> \<lambda>s. THE s'. fst (M s) = s'"

subsection "Non-Failure"

text \<open>
  With the failure flag, we can formulate non-failure separately
  from validity. A monad \<open>m\<close> does not fail under precondition
  \<open>P\<close>, if for no start state in that precondition it sets
  the failure flag.
\<close>
definition
  no_fail :: "('s \<Rightarrow> bool) \<Rightarrow> ('s,'a) det_monad \<Rightarrow> bool"
where
  "no_fail P m \<equiv> \<forall>s. P s \<longrightarrow> \<not> (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) det_monad \<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) det_monad \<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)

section "Basic exception reasoning"

text \<open>
  The following predicates \<open>no_throw\<close> and \<open>no_return\<close> allow
  reasoning that functions in the exception monad either do
  no 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_return P A \<equiv> \<lbrace> P \<rbrace> A \<lbrace>\<lambda>_ _. False\<rbrace>,\<lbrace>\<lambda>_ _. True \<rbrace>"

end


(*

 Licensed under the Apache License, Version 2.0 (the "License");
 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

 Unless required by applicable law or agreed to in writing, software
 distributed under the License is distributed on an "AS IS" BASIS,
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.

 *)

theory AbstractFloat
  imports artifact_machine.Machine
begin

definition signed_greater_than :: "'a :: len word \<Rightarrow> 'a :: len word \<Rightarrow> bool" ("(_/ >s _)" [50, 51] 50)
  where "a >s b \<equiv> a \<noteq> b \<and> \<not>(a <s b)"
declare signed_greater_than_def[symmetric,simp add]

(* Technically already exists as word_sle (<=s) *)
definition signed_le :: "'a :: len word \<Rightarrow> 'a :: len word \<Rightarrow> bool" ("(_/ \<le>s _)" [50, 51] 50)
  where "a \<le>s b \<equiv> a = b \<or> a <s b"
declare signed_le_def[symmetric,simp add]

definition signed_ge :: "'a :: len word \<Rightarrow> 'a :: len word \<Rightarrow> bool" ("(_/ \<ge>s _)" [50, 51] 50)
  where "a \<ge>s b \<equiv> a = b \<or> a >s b"
declare signed_le_def[symmetric,simp add]

lemma signed_not_le[simp]:
  shows "\<not> a \<le>s b \<longleftrightarrow> a >s b"
  unfolding signed_le_def signed_greater_than_def
  by metis

subsection "Making a float"

text \<open> Make a float from a sign-bit, an exponent and a mantissa. \<close>
fun mk_float :: "bool \<times> nat \<times> nat \<Rightarrow> 64 word"
  where "mk_float (s,e,m) = ((if s then 1 else 0) << 63) OR (of_nat e AND mask 11 << 52) OR (of_nat m AND mask 52)"

text \<open> Simplify @{term mk_float} only when it is given concrete values. \<close>
lemmas mk_float_simps_numeral[simp] =
  mk_float.simps[of True 0 0]
  mk_float.simps[of True 0 1]
  mk_float.simps[of True 0 "numeral m"]
  mk_float.simps[of True 1 0]
  mk_float.simps[of True 1 1]
  mk_float.simps[of True 1 "numeral m"]
  mk_float.simps[of True "numeral n" 0]
  mk_float.simps[of True "numeral n" 1]
  mk_float.simps[of True "numeral n" "numeral m"]
  mk_float.simps[of False 0 0]
  mk_float.simps[of False 0 1]
  mk_float.simps[of False 0 "numeral m"]
  mk_float.simps[of False 1 0]
  mk_float.simps[of False 1 1]
  mk_float.simps[of False 1 "numeral m"]
  mk_float.simps[of False "numeral n" 0]
  mk_float.simps[of False "numeral n" 1]
  mk_float.simps[of False "numeral n" "numeral m"]
  for n m
declare mk_float.simps[simp del]

text \<open>Constants and Accessor Functions\<close>

definition plus_zero :: "64 word" ("0\<^sup>+")
  where "plus_zero \<equiv> mk_float (False,0,0)"

definition minus_zero :: "64 word" ("0\<^sup>-")
  where "minus_zero \<equiv> mk_float (True,0,0)"

definition plus_infty :: "64 word" ("\<infinity>\<^sup>+")
  where "plus_infty \<equiv> mk_float (False,2^11 - 1,0)"

definition minus_infty :: "64 word" ("\<infinity>\<^sup>-")
  where "minus_infty \<equiv> mk_float (True,2^11 - 1,0)"

definition exp :: "64 word \<Rightarrow> 64 word"
  where "exp w \<equiv> \<langle>62,52\<rangle>w"

definition mant :: "64 word \<Rightarrow> 64 word"
  where "mant w \<equiv> \<langle>51,0\<rangle>w"

definition sign :: "64 word \<Rightarrow> bool"
  where "sign \<equiv> msb"

definition isNaN :: "64 word \<Rightarrow> bool"
  where "isNaN w \<equiv> exp w = 2^11-1"

definition float_abs :: "'a::len0 word \<Rightarrow> 'a::len0 word" ("\<bar>_\<bar>\<^sup>f")
  where "\<bar>w\<bar>\<^sup>f \<equiv> set_bit w (LENGTH('a) - 1)  False"

(*
lemma sign_mk_float:
  shows "sign (mk_float (s,e,m)) = s"
  unfolding sign_def
  by (auto simp add: msb_nth mk_float.simps test_bit_of_take_bits word_ao_nth nth_shiftl)

lemma exp_mk_float:
  shows "exp (mk_float (s,e,m)) = ((of_nat e)::64 word) AND mask 11"
  unfolding exp_def
  apply word_bitwise
  by (auto simp add: mk_float.simps test_bit_of_take_bits word_ao_nth nth_shiftl)

lemma mant_mk_float:
  shows "mant (mk_float (s,e,m)) = ((of_nat m)::64 word) AND mask 52"
  unfolding mant_def
  apply word_bitwise
  apply (auto simp add: mk_float.simps test_bit_of_take_bits word_ao_nth nth_shiftl simp del: take_bits_bitAND)
  by (simp only: numeral_2_eq_2)+
*)

datatype float_cmp = Unordered | GT | LT | EQ

text \<open>
  For the following functions, we do not yet have an implementation.
  We constraint them according the IEEE 754 standard.
\<close>

locale abstract_float =
  fixes float_plus :: "64 word \<Rightarrow> 64 word \<Rightarrow> 64 word" (infixl "+\<^sup>f" 65)
    and float_minus :: "64 word \<Rightarrow> 64 word \<Rightarrow> 64 word" (infixl "-\<^sup>f" 65)
    and float_times:: "64 word \<Rightarrow> 64 word \<Rightarrow> 64 word" (infixl "*\<^sup>f" 65)
    and float_div :: "64 word \<Rightarrow> 64 word \<Rightarrow> 64 word" (infixl "div\<^sup>f" 65)
    and float_mod :: "64 word \<Rightarrow> 64 word \<Rightarrow> 64 word" (infixl "mod\<^sup>f" 70)
    and float_ucmp :: "64 word \<Rightarrow> 64 word \<Rightarrow> float_cmp"
    and cvttsd2si :: "64 word \<Rightarrow> 32 word"
    and cvtsi2sd :: "32 word \<Rightarrow> 64 word"
assumes plus_plus_zero [simp]: "x +\<^sup>f 0\<^sup>+ = x"
    and plus_minus_zero[simp]: "x +\<^sup>f 0\<^sup>- = x"
    and isNan_div_0_0: "x \<in> {0\<^sup>-,0\<^sup>+} \<Longrightarrow> y \<in> {0\<^sup>-,0\<^sup>+} \<Longrightarrow> isNaN (x div\<^sup>f y)"
    and div_by_plus_zero:  "x \<notin> {0\<^sup>-,0\<^sup>+} \<Longrightarrow> x div\<^sup>f 0\<^sup>+ = (if sign x then \<infinity>\<^sup>- else \<infinity>\<^sup>+)"
    and div_by_minus_zero: "x \<notin> {0\<^sup>-,0\<^sup>+} \<Longrightarrow> x div\<^sup>f 0\<^sup>- = (if sign x then \<infinity>\<^sup>+ else \<infinity>\<^sup>-)"
    and times_by_plus_zero [simp]: "x *\<^sup>f 0\<^sup>+ = (if sign x then 0\<^sup>- else 0\<^sup>+)"
    and time_by_neg_zero [simp]: "x *\<^sup>f 0\<^sup>- = (if sign x then 0\<^sup>+ else 0\<^sup>-)"
    and times_plus_zero: "0\<^sup>+ *\<^sup>f x = (if sign x then 0\<^sup>- else 0\<^sup>+)"
    and times_neg_zero: "0\<^sup>- *\<^sup>f x = (if sign x then 0\<^sup>+ else 0\<^sup>-)"
begin

end

interpretation abstract_float
  "\<lambda> x y . x"
  "\<lambda> x y . x"
  "\<lambda> x y . if y = 0\<^sup>+ then (if sign x then 0\<^sup>- else 0\<^sup>+) else if y = 0\<^sup>- then (if sign x then 0\<^sup>+ else 0\<^sup>-) else
           if x = 0\<^sup>+ then (if sign y then 0\<^sup>- else 0\<^sup>+) else if x = 0\<^sup>- then (if sign y then 0\<^sup>+ else 0\<^sup>-)
           else x"
  "\<lambda> x y . if x \<in> {0\<^sup>-,0\<^sup>+} then mk_float(False,2^11-1,0)
           else if x = 0\<^sup>- then 0\<^sup>-
           else if y = 0\<^sup>+ then (if sign x then \<infinity>\<^sup>- else \<infinity>\<^sup>+)
           else if y = 0\<^sup>- then (if sign x then \<infinity>\<^sup>+ else \<infinity>\<^sup>-)
           else 0\<^sup>-"
  apply (unfold_locales)
  by (auto simp add: isNaN_def exp_def take_bits_def plus_zero_def minus_zero_def sign_def)

lemma bit_AND_bit_pattern_is_float_abs_bit32[simp]:
  fixes w :: "32 word"
  shows "w AND 2147483647 = \<bar>w\<bar>\<^sup>f"
  apply (word_bitwise)
  by (auto simp add: word_ao_nth float_abs_def test_bit_set_gen)
lemma bit_AND_bit_pattern_is_float_abs_bit64[simp]:
  fixes a :: "64 word"
  shows "a AND 9223372036854775807 = \<bar>a\<bar>\<^sup>f"
  unfolding float_abs_def
  apply word_bitwise
  by (auto simp add: test_bit_set_gen del: )

end


(*  Title:      statecharts/HA/HAKripke.thy

    Author:     Steffen Helke, Software Engineering Group
    Copyright   2010 Technische Universitaet Berlin
*)

header {* Kripke Structures as Hierarchical Automata*}
theory HAKripke
imports HASem "Kripke"
begin

type_synonym ('s,'e,'d)hakripke = "(('s,'e,'d)status,('s,'e,'d)atomar)kripke"
type_synonym ('s,'e,'d)hactl    = "(('s,'e,'d)status,('s,'e,'d)atomar)ctl"

definition
  LabelFunSem :: "('s,'e,'d)hierauto
              => (('s,'e,'d)status ~=> ((('s,'e,'d) atomar) set))" where
  "LabelFunSem a = (\<lambda> ST.
         (if (HA ST = a) then
              (let
                  In_preds = (\<lambda> s. (IN s)) ` (Conf ST);
                  En_preds = (\<lambda> e. (EN e)) ` (Events ST);
                  Val_preds = { x . (\<exists> P. (x = (VAL P)) \<and> P (Value ST)) }
               in
                  Some (In_preds \<union> En_preds \<union> Val_preds \<union> {atomar.TRUE}))
            else
               None))"

definition
  HA2Kripke :: "('s,'e,'d)hierauto => ('s,'e,'d)hakripke" where
  "HA2Kripke a =
         Abs_kripke ({ST. HA ST = a},
                     {InitStatus a},
                     StepRelSem a,
                     LabelFunSem a)"

definition
   eval_ctl_HA :: "[('s,'e,'d)hierauto, ('s,'e,'d)hactl]
                   => bool"  ("_ |=H= _" [92,91]90) where

   "eval_ctl_HA a f = ((HA2Kripke a), (InitStatus a) |=c= f)"

lemma Kripke_HA [simp]:
  "Kripke {ST. HA ST = a} {InitStatus a} (StepRelSem a) (LabelFunSem a)"
apply (unfold Kripke_def)
apply auto
apply (unfold StepRelSem_def)
apply auto
apply (unfold LabelFunSem_def Let_def If_def dom_def)
apply auto
prefer 2
apply (rename_tac ST S)
apply (case_tac "HA ST = a")
apply auto
apply (rename_tac ST)
apply (case_tac "HPT ST = {}")
apply auto
apply (rename_tac TSS)
apply (erule_tac x="StepStatus ST TSS (@ u. u : ResolveRacing TSS)" in allE)
apply (erule_tac x=TSS in ballE)
apply auto
done

lemma LabelFun_LabelFunSem [simp]:
  "(LabelFun (HA2Kripke a)) = (LabelFunSem a)"
apply (unfold HA2Kripke_def LabelFun_def)
apply auto
apply (subst Abs_kripke_inverse)
apply auto
apply (unfold kripke_def)
apply auto
done

lemma InitStatuses_InitStatus [simp]:
   "(InitStatuses (HA2Kripke a)) = {(InitStatus a)}"
apply (unfold HA2Kripke_def InitStatuses_def)
apply simp
apply (subst Abs_kripke_inverse)
apply (unfold kripke_def)
apply auto
done

lemma Statuses_StatusesOfHA [simp]:
   "(Statuses (HA2Kripke a)) = {ST. HA ST = a}"
apply (unfold HA2Kripke_def Statuses_def)
apply simp
apply (subst Abs_kripke_inverse)
apply (unfold kripke_def)
apply auto
done

lemma StepRel_StepRelSem [simp]:
  "(StepRel (HA2Kripke a)) = (StepRelSem a)"
apply (unfold HA2Kripke_def StepRel_def)
apply simp
apply (subst Abs_kripke_inverse)
apply (unfold kripke_def)
apply auto
done

lemma TRUE_LabelFunSem [simp]:
   "atomar.TRUE \<in> the (LabelFunSem (HA ST) ST)"
apply (unfold LabelFunSem_def Let_def)
apply auto
done

lemma FALSE_LabelFunSem [simp]:
   "atomar.FALSE \<notin> the (LabelFunSem (HA ST) ST)"
apply (unfold LabelFunSem_def Let_def)
apply auto
done

lemma Conf_LabelFunSem [simp]:
   "((IN S) \<in> the (LabelFunSem (HA ST) ST)) = (S \<in> (Conf ST))"
apply (unfold LabelFunSem_def Let_def)
apply auto
done

lemma Events_LabelFunSem [simp]:
  "((EN S) \<in> the (LabelFunSem (HA ST) ST)) = (S \<in> (Events ST))"
apply (unfold LabelFunSem_def Let_def)
apply auto
done

lemma Value_LabelFunSem [simp]:
  "((VAL P) \<in> the (LabelFunSem (HA ST) ST)) = (P (Value ST))"
apply (unfold LabelFunSem_def Let_def)
apply auto
done

lemma AtomTRUE_EvalCTLHA [simp]:
  "a |=H= (Atom (atomar.TRUE))"
apply (unfold eval_ctl_HA_def)
apply auto
apply (subst HA_InitStatus [THEN sym])
apply (rule TRUE_LabelFunSem)
done

lemma AtomFalse_EvalCTLHA [simp]:
  "\<not> a |=H= (Atom (atomar.FALSE))"
apply (unfold eval_ctl_HA_def)
apply auto
apply (subst (asm) HA_InitStatus [THEN sym])
apply (simp only: FALSE_LabelFunSem)
done

lemma Events_InitStatus_EvalCTLHA [simp]:
  "(a |=H= (Atom (EN S))) = (S \<in> (Events (InitStatus a)))"
apply (unfold eval_ctl_HA_def)
apply simp
apply (subst HA_InitStatus [THEN sym])
apply (rule Events_LabelFunSem)
done

lemma Conf_InitStatus_EvalCTLHA [simp]:
  "(a |=H= (Atom (IN S))) = (S \<in> (Conf (InitStatus a)))"
apply (unfold eval_ctl_HA_def)
apply simp
apply (subst HA_InitStatus [THEN sym])
apply (subst Conf_LabelFunSem)
apply simp
done

lemma HAInitValue_EvalCTLHA [simp]:
  "(a |=H= (Atom (VAL P))) = (P (HAInitValue a))"
apply (unfold eval_ctl_HA_def)
apply simp
apply (subst HA_InitStatus [THEN sym])
apply (subst Value_LabelFunSem)
apply auto
done

end


theory func_cor_other
  imports rg_cond
begin

section \<open>Functional correctness of Schedule\<close>

lemma Schedule_satRG_h1:
  "\<Gamma> \<turnstile>\<^sub>I Some (IF \<exists>y. \<acute>cur = Some y THEN \<acute>thd_state := \<acute>thd_state(the \<acute>cur := READY);; Basic (cur_update Map.empty) FI;;
           Basic (cur_update (\<lambda>_. Some t));;
           \<acute>thd_state := \<acute>thd_state
           (t := RUNNING)) sat\<^sub>p [\<lbrace>\<acute>inv\<rbrace> \<inter> \<lbrace>\<acute>thd_state t = READY\<rbrace> \<inter>
                                 {V}, {(s, t). s = t}, UNIV, \<lbrace>\<acute>(Pair V) \<in> Schedule_guar\<rbrace> \<inter> \<lbrace>\<acute>inv\<rbrace>]"
  apply(case_tac "\<lbrace>\<acute>inv \<rbrace> \<inter> \<lbrace> \<acute>thd_state t = READY\<rbrace> \<inter> {V} = {}")
    using Emptyprecond apply auto[1]
    apply simp
    apply(case_tac "\<exists>y. cur V = Some y")
    apply(rule Seq[where mid = "{V\<lparr>thd_state := (thd_state V)(the (cur V) := READY)\<rparr>\<lparr>cur := None\<rparr>\<lparr>cur := Some t\<rparr>}"])
      apply(rule Seq[where mid = "{V\<lparr>thd_state := (thd_state V)(the (cur V) := READY)\<rparr>\<lparr>cur := None\<rparr>}"])
        apply(rule Cond)
          apply(simp add:stable_def)
          apply(rule Seq[where mid = "{V\<lparr>thd_state := (thd_state V)(the (cur V) := READY)\<rparr>}"])
          apply(rule Basic)
            apply auto[1]
            apply(simp add:stable_def)+
          apply(rule Basic)
            apply auto[1]
            apply(simp add:stable_def)+
          apply(simp add:Skip_def) apply(rule Basic) apply(simp add:stable_def)+
        apply(rule Basic)
         apply auto[1]
          apply(simp add:stable_def)+
        apply(rule Basic)
        apply(simp add:Schedule_guar_def)
        apply(subgoal_tac "inv (V\<lparr>cur := Some t, thd_state := (thd_state V)(the (cur V) := READY, t := RUNNING)\<rparr>) \<and>
               (\<forall>x. (V, V\<lparr>cur := Some t, thd_state := (thd_state V)(the (cur V) := READY, t := RUNNING)\<rparr>) \<in> lvars_nochange_rel x)")
         apply simp
        apply(rule conjI) apply(simp add: inv_def) apply clarify
         apply(rule conjI) apply(simp add: inv_cur_def) apply force
         apply (simp add: inv_OS_Mem_info_def inv_OS_Mem_info_mp_def inv_thd_waitq_def inv_thd_waitq_def)
         apply auto[1] using lvars_nochange_rel_def lvars_nochange_def apply simp
         apply (metis Thread_State_Type.distinct(5) inv_cur_def)
    apply (simp add: lvars_nochange_rel_def lvars_nochange_def, clarify)
       apply(simp add: stable_def)+
    apply(rule Seq[where mid = "{V\<lparr>cur := Some t\<rparr>}"])
      apply(rule Seq[where mid = "{V}"])
        apply(rule Cond)
          apply(simp add:stable_def)
          apply(rule Seq[where mid = "{}"])
          apply(rule Basic)
            apply auto[1]
            apply(simp add:stable_def)+
          apply(rule Basic)
            apply auto[1]
            apply(simp add:stable_def)+
          apply(simp add:Skip_def) apply(rule Basic) apply(simp add:stable_def)+
        apply(rule Basic)
         apply auto[1]
          apply(simp add:stable_def)+
         apply(rule Basic)
           apply(simp add:Schedule_guar_def)
           apply(subgoal_tac "inv (V\<lparr>cur := Some t, thd_state := (thd_state V)(t := RUNNING)\<rparr>) \<and>
              (\<forall>x. (V, V\<lparr>cur := Some t, thd_state := (thd_state V)(t := RUNNING)\<rparr>) \<in> lvars_nochange_rel x)")
        apply simp
        apply(rule conjI, simp add:inv_def) apply clarify
        apply(rule conjI, simp add:inv_cur_def)
        apply (rule conjI, simp add: inv_OS_Mem_info_def inv_OS_Mem_info_mp_def)
    apply (simp add: inv_thd_waitq_def)
    apply auto[1]
       apply auto[1] using lvars_nochange_rel_def lvars_nochange_def apply simp
      apply(simp add:stable_def)+
    done

lemma Schedule_satRG: "\<Gamma> (Schedule t) \<turnstile> Schedule_RGCond t"
  apply(simp add:Evt_sat_RG_def)
  apply (simp add: Schedule_def Schedule_RGCond_def)
  apply(rule BasicEvt)
    apply(simp add:body_def Pre\<^sub>f_def Post\<^sub>f_def guard_def
                  Rely\<^sub>f_def Guar\<^sub>f_def getrgformula_def)
    apply(rule Await)
  using stable_inv_sched_rely1 apply simp using stable_inv_sched_rely1 apply simp
      using Schedule_satRG_h1 apply simp
    apply(simp add:Pre\<^sub>f_def Rely\<^sub>f_def getrgformula_def)
    using stable_inv_sched_rely1 apply simp
    by(simp add:Guar\<^sub>f_def getrgformula_def Schedule_guar_def)

section \<open>Functional correctness of Tick\<close>
lemma Tick_satRG: "\<Gamma> Tick \<turnstile> Tick_RGCond"
  apply(simp add:Evt_sat_RG_def)
  apply (simp add: Tick_def Tick_RGCond_def Tick_rely_def Tick_guar_def)
  apply(rule BasicEvt)
    apply(simp add:body_def Pre\<^sub>f_def Post\<^sub>f_def guard_def
                  Rely\<^sub>f_def Guar\<^sub>f_def getrgformula_def)
    apply(rule Basic)
      apply simp
      using lvars_nochange_rel_def lvars_nochange_def apply simp apply auto[1]
      apply(simp add:stable_def)+
    apply(simp add: stable_def Pre\<^sub>f_def getrgformula_def Rely\<^sub>f_def) apply auto[1]
      by (simp add: Guar\<^sub>f_def getrgformula_def)

end


theory Prelude_List_E3
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"ga_selector_pre\", \"ga_injective_suc\", \"ga_disjoint_0_suc\",
     \"ga_selector_undef_pre_0\", \"X1_def_Nat\", \"X2_def_Nat\",
     \"X3_def_Nat\", \"X4_def_Nat\", \"X5_def_Nat\", \"X6_def_Nat\",
     \"X7_def_Nat\", \"X8_def_Nat\", \"X9_def_Nat\", \"decimal_def\",
     \"ga_comm___XPlus__\", \"ga_assoc___XPlus__\",
     \"ga_right_unit___XPlus__\", \"ga_left_unit___XPlus__\",
     \"ga_left_comm___XPlus__\", \"ga_comm___Xx__\",
     \"ga_assoc___Xx__\", \"ga_right_unit___Xx__\",
     \"ga_left_unit___Xx__\", \"ga_left_comm___Xx__\", \"ga_comm_min\",
     \"ga_assoc_min\", \"ga_left_comm_min\", \"ga_comm_max\",
     \"ga_assoc_max\", \"ga_right_unit_max\", \"ga_left_unit_max\",
     \"ga_left_comm_max\", \"leq_def1_Nat\", \"leq_def2_Nat\",
     \"leq_def3_Nat\", \"geq_def_Nat\", \"less_def_Nat\",
     \"greater_def_Nat\", \"even_0_Nat\", \"even_suc_Nat\",
     \"odd_def_Nat\", \"factorial_0\", \"factorial_suc\", \"add_0_Nat\",
     \"add_suc_Nat\", \"mult_0_Nat\", \"mult_suc_Nat\", \"power_0_Nat\",
     \"power_suc_Nat\", \"min_def_Nat\", \"max_def_Nat\",
     \"subTotal_def1_Nat\", \"subTotal_def2_Nat\", \"sub_dom_Nat\",
     \"sub_def_Nat\", \"divide_dom_Nat\", \"divide_0_Nat\",
     \"divide_Pos_Nat\", \"div_dom_Nat\", \"div_Nat\", \"mod_dom_Nat\",
     \"mod_Nat\", \"distr1_Nat\", \"distr2_Nat\", \"min_0\",
     \"div_mod_Nat\", \"power_Nat\", \"Comp1\", \"IdDef\", \"FlipDef\",
     \"FstDef\", \"SndDef\", \"CurryDef\", \"UncurryDef\", \"NotFalse\",
     \"NotTrue\", \"AndFalse\", \"AndTrue\", \"AndSym\", \"OrDef\",
     \"OtherwiseDef\", \"AndPrefixDef\", \"OrPrefixDef\", \"NotFalse1\",
     \"NotTrue1\", \"notNot1\", \"notNot2\", \"EqualTDef\",
     \"EqualSymDef\", \"EqualReflex\", \"EqualTransT\", \"DiffDef\",
     \"DiffSymDef\", \"DiffTDef\", \"DiffFDef\", \"TE1\", \"TE2\",
     \"TE3\", \"TE4\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\", \"IBE5\",
     \"IBE6\", \"IBE7\", \"IBE8\", \"IUE1\", \"IUE2\", \"IOE01\",
     \"IOE02\", \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\", \"IOE07\",
     \"IOE08\", \"IOE09\", \"LeIrreflexivity\", \"LeTAsymmetry\",
     \"LeTTransitive\", \"LeTTotal\", \"GeDef\", \"GeIrreflexivity\",
     \"GeTAsymmetry\", \"GeTTransitive\", \"GeTTotal\", \"LeqDef\",
     \"LeqReflexivity\", \"LeqTTransitive\", \"LeqTTotal\", \"GeqDef\",
     \"GeqReflexivity\", \"GeqTTransitive\", \"GeqTTotal\",
     \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\", \"EqFOrdRel\",
     \"EqTOrdTSubstE\", \"EqTOrdFSubstE\", \"EqTOrdTSubstD\",
     \"EqTOrdFSubstD\", \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\",
     \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\",
     \"GeqFLeqFRel\", \"LeTGeFEqFRel\", \"LeFGeTEqTRel\",
     \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\", \"GeFLeTEqTRel\",
     \"GeqTLeFRel\", \"GeqFLeTRel\", \"LeqTLeTEqTRel\",
     \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\", \"GeqFGeFEqFRel\",
     \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\", \"CmpLTDef\",
     \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\", \"MinXDef\",
     \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\", \"TO3\",
     \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IOO13\", \"IOO14\",
     \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\", \"IOO20\",
     \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\", \"IOO26\",
     \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\", \"IOO32\",
     \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\", \"IBO9\",
     \"IBO10\", \"IBO11\", \"IBO12\", \"IUO01\", \"IUO02\", \"IUO03\",
     \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"LengthNil\",
     \"LengthCons\", \"NotDefHead\", \"HeadDef\", \"NotDefTail\",
     \"TailDef\", \"FoldrNil\", \"FoldrCons\", \"FoldlNil\",
     \"FoldlCons\", \"MapNil\", \"MapCons\", \"XPlusXPlusNil\",
     \"XPlusXPlusCons\", \"XPlusXPlusPrefixDef\", \"FilterNil\",
     \"FilterConsT\", \"FilterConsF\", \"ZipNil\", \"ZipConsNil\",
     \"ZipConsCons\", \"UnzipNil\", \"UnzipCons\", \"EqualListNilDef\",
     \"EqualListDef\", \"LeListDef\", \"LeListNilFalse\",
     \"FoldlDecomp\", \"MapDecomp\", \"MapFunctor\", \"FilterProm\",
     \"LengthNil1\", \"LengthEqualNil\", \"LengthEqualCons\",
     \"ZipSpec\"]"

typedecl Unit

datatype Nat = X0 ("0''") | X_suc "Nat" ("suc/'(_')" [3] 999)
datatype Bool = X_False ("False''") | X_True ("True''")
datatype Ordering = EQ | GT | LT
datatype 'a List = X_Cons 'a "'a List" | X_Nil ("Nil''")

consts
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X1 :: "Nat" ("1''")
X2 :: "Nat" ("2''")
X3 :: "Nat" ("3''")
X4 :: "Nat" ("4''")
X5 :: "Nat" ("5''")
X6 :: "Nat" ("6''")
X7 :: "Nat" ("7''")
X8 :: "Nat" ("8''")
X9 :: "Nat" ("9''")
XLtXAmpXAmpXGt :: "Bool => Bool => Bool"
XLtXPlusXPlusXGt :: "'a List => 'a List => 'a List"
XLtXVBarXVBarXGt :: "Bool => Bool => Bool"
X__XAmpXAmp__X :: "Bool => Bool => Bool" ("(_/ &&/ _)" [54,54] 52)
X__XAtXAt__X :: "Nat => Nat => Nat" ("(_/ @@/ _)" [54,54] 52)
X__XCaret__X :: "Nat => Nat => Nat" ("(_/ ^''/ _)" [54,54] 52)
X__XEqXEq__X :: "'a => 'a => Bool" ("(_/ ==''/ _)" [54,54] 52)
X__XExclam :: "Nat => Nat" ("(_/ !'')" [58] 58)
X__XGtXEq__XX1 :: "Nat => Nat => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGtXEq__XX2 :: "'a => 'a => Bool" ("(_/ >=''''/ _)" [54,54] 52)
X__XGt__XX1 :: "Nat => Nat => bool" ("(_/ >''/ _)" [44,44] 42)
X__XGt__XX2 :: "'a => 'a => Bool" ("(_/ >''''/ _)" [54,54] 52)
X__XLtXEq__XX1 :: "Nat => Nat => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLtXEq__XX2 :: "'a => 'a => Bool" ("(_/ <=''''/ _)" [54,54] 52)
X__XLt__XX1 :: "Nat => Nat => bool" ("(_/ <''/ _)" [44,44] 42)
X__XLt__XX2 :: "'a => 'a => Bool" ("(_/ <''''/ _)" [54,54] 52)
X__XMinusXExclam__X :: "Nat => Nat => Nat" ("(_/ -!/ _)" [54,54] 52)
X__XMinusXQuest__X :: "Nat => Nat => Nat partial" ("(_/ -?/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List => 'a List => 'a List" ("(_/ ++''/ _)" [54,54] 52)
X__XPlus__X :: "Nat => Nat => Nat" ("(_/ +''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a => 'a => Bool" ("(_/ '/=/ _)" [54,54] 52)
X__XSlashXQuest__X :: "Nat => Nat => Nat partial" ("(_/ '/?/ _)" [54,54] 52)
X__XVBarXVBar__X :: "Bool => Bool => Bool" ("(_/ ||/ _)" [54,54] 52)
X__Xx__X :: "Nat => Nat => Nat" ("(_/ *''/ _)" [54,54] 52)
X__div__X :: "Nat => Nat => Nat partial" ("(_/ div''/ _)" [54,54] 52)
X__mod__X :: "Nat => Nat => Nat partial" ("(_/ mod''/ _)" [54,54] 52)
X__o__X :: "('b => 'c) * ('a => 'b) => 'a => 'c"
X_curry :: "('a * 'b => 'c) => 'a => 'b => 'c"
X_even :: "Nat => bool" ("even''/'(_')" [3] 999)
X_filter :: "('a => Bool) => 'a List => 'a List"
X_flip :: "('a => 'b => 'c) => 'b => 'a => 'c"
X_foldl :: "('a => 'b => 'a) => 'a => 'b List => 'a"
X_foldr :: "('a => 'b => 'b) => 'b => 'a List => 'b"
X_fst :: "'a => 'b => 'a" ("fst''/'(_,/ _')" [3,3] 999)
X_head :: "'a List => 'a partial" ("head/'(_')" [3] 999)
X_id :: "'a => 'a" ("id''/'(_')" [3] 999)
X_length :: "'a List => Nat" ("length''/'(_')" [3] 999)
X_map :: "('a => 'b) => 'a List => 'b List"
X_maxX1 :: "Nat => Nat => Nat" ("max''/'(_,/ _')" [3,3] 999)
X_maxX2 :: "'a => 'a => 'a"
X_minX1 :: "Nat => Nat => Nat" ("min''/'(_,/ _')" [3,3] 999)
X_minX2 :: "'a => 'a => 'a"
X_odd :: "Nat => bool" ("odd''/'(_')" [3] 999)
X_pre :: "Nat => Nat partial" ("pre/'(_')" [3] 999)
X_snd :: "'a => 'b => 'b" ("snd''/'(_,/ _')" [3,3] 999)
X_tail :: "'a List => 'a List partial" ("tail/'(_')" [3] 999)
X_unzip :: "('a * 'b) List => 'a List * 'b List" ("unzip/'(_')" [3] 999)
X_zip :: "'a List => 'b List => ('a * 'b) List"
compare :: "'a => 'a => Ordering"
otherwiseH :: "Bool"
uncurry :: "('a => 'b => 'c) => 'a * 'b => 'c"

axioms
ga_selector_pre [rule_format] :
"ALL XX1. pre(suc(XX1)) = makePartial XX1"

ga_injective_suc [rule_format] :
"ALL XX1. ALL Y1. suc(XX1) = suc(Y1) = (XX1 = Y1)"

ga_disjoint_0_suc [rule_format] : "ALL Y1. ~ 0' = suc(Y1)"

ga_selector_undef_pre_0 [rule_format] : "~ defOp (pre(0'))"

X1_def_Nat [rule_format] : "1' = suc(0')"

X2_def_Nat [rule_format] : "2' = suc(1')"

X3_def_Nat [rule_format] : "3' = suc(2')"

X4_def_Nat [rule_format] : "4' = suc(3')"

X5_def_Nat [rule_format] : "5' = suc(4')"

X6_def_Nat [rule_format] : "6' = suc(5')"

X7_def_Nat [rule_format] : "7' = suc(6')"

X8_def_Nat [rule_format] : "8' = suc(7')"

X9_def_Nat [rule_format] : "9' = suc(8')"

decimal_def [rule_format] :
"ALL m. ALL X_n. m @@ X_n = (m *' suc(9')) +' X_n"

ga_comm___XPlus__ [rule_format] : "ALL x. ALL y. x +' y = y +' x"

ga_assoc___XPlus__ [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) +' z = x +' (y +' z)"

ga_right_unit___XPlus__ [rule_format] : "ALL x. x +' 0' = x"

ga_left_unit___XPlus__ [rule_format] : "ALL x. 0' +' x = x"

ga_left_comm___XPlus__ [rule_format] :
"ALL x. ALL y. ALL z. x +' (y +' z) = y +' (x +' z)"

ga_comm___Xx__ [rule_format] : "ALL x. ALL y. x *' y = y *' x"

ga_assoc___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. (x *' y) *' z = x *' (y *' z)"

ga_right_unit___Xx__ [rule_format] : "ALL x. x *' 1' = x"

ga_left_unit___Xx__ [rule_format] : "ALL x. 1' *' x = x"

ga_left_comm___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. x *' (y *' z) = y *' (x *' z)"

ga_comm_min [rule_format] : "ALL x. ALL y. min'(x, y) = min'(y, x)"

ga_assoc_min [rule_format] :
"ALL x. ALL y. ALL z. min'(min'(x, y), z) = min'(x, min'(y, z))"

ga_left_comm_min [rule_format] :
"ALL x. ALL y. ALL z. min'(x, min'(y, z)) = min'(y, min'(x, z))"

ga_comm_max [rule_format] : "ALL x. ALL y. max'(x, y) = max'(y, x)"

ga_assoc_max [rule_format] :
"ALL x. ALL y. ALL z. max'(max'(x, y), z) = max'(x, max'(y, z))"

ga_right_unit_max [rule_format] : "ALL x. max'(x, 0') = x"

ga_left_unit_max [rule_format] : "ALL x. max'(0', x) = x"

ga_left_comm_max [rule_format] :
"ALL x. ALL y. ALL z. max'(x, max'(y, z)) = max'(y, max'(x, z))"

leq_def1_Nat [rule_format] : "ALL X_n. 0' <=' X_n"

leq_def2_Nat [rule_format] : "ALL X_n. ~ suc(X_n) <=' 0'"

leq_def3_Nat [rule_format] :
"ALL m. ALL X_n. (suc(m) <=' suc(X_n)) = (m <=' X_n)"

geq_def_Nat [rule_format] :
"ALL m. ALL X_n. (m >=' X_n) = (X_n <=' m)"

less_def_Nat [rule_format] :
"ALL m. ALL X_n. (m <' X_n) = (m <=' X_n & ~ m = X_n)"

greater_def_Nat [rule_format] :
"ALL m. ALL X_n. (m >' X_n) = (X_n <' m)"

even_0_Nat [rule_format] : "even'(0')"

even_suc_Nat [rule_format] : "ALL m. even'(suc(m)) = odd'(m)"

odd_def_Nat [rule_format] : "ALL m. odd'(m) = (~ even'(m))"

factorial_0 [rule_format] : "0' !' = 1'"

factorial_suc [rule_format] :
"ALL X_n. suc(X_n) !' = suc(X_n) *' X_n !'"

add_0_Nat [rule_format] : "ALL m. 0' +' m = m"

add_suc_Nat [rule_format] :
"ALL m. ALL X_n. suc(X_n) +' m = suc(X_n +' m)"

mult_0_Nat [rule_format] : "ALL m. 0' *' m = 0'"

mult_suc_Nat [rule_format] :
"ALL m. ALL X_n. suc(X_n) *' m = (X_n *' m) +' m"

power_0_Nat [rule_format] : "ALL m. m ^' 0' = 1'"

power_suc_Nat [rule_format] :
"ALL m. ALL X_n. m ^' suc(X_n) = m *' (m ^' X_n)"

min_def_Nat [rule_format] :
"ALL m. ALL X_n. min'(m, X_n) = (if m <=' X_n then m else X_n)"

max_def_Nat [rule_format] :
"ALL m. ALL X_n. max'(m, X_n) = (if m <=' X_n then X_n else m)"

subTotal_def1_Nat [rule_format] :
"ALL m. ALL X_n. m >' X_n --> X_n -! m = 0'"

subTotal_def2_Nat [rule_format] :
"ALL m. ALL X_n. m <=' X_n --> makePartial (X_n -! m) = X_n -? m"

sub_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m -? X_n) = (m >=' X_n)"

sub_def_Nat [rule_format] :
"ALL m. ALL X_n. ALL r. m -? X_n = makePartial r = (m = r +' X_n)"

divide_dom_Nat [rule_format] :
"ALL m.
 ALL X_n.
 defOp (m /? X_n) = (~ X_n = 0' & m mod' X_n = makePartial 0')"

divide_0_Nat [rule_format] : "ALL m. ~ defOp (m /? 0')"

divide_Pos_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r. X_n >' 0' --> m /? X_n = makePartial r = (m = r *' X_n)"

div_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m div' X_n) = (~ X_n = 0')"

div_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m div' X_n = makePartial r =
 (EX s. m = (X_n *' r) +' s & s <' X_n)"

mod_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m mod' X_n) = (~ X_n = 0')"

mod_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m mod' X_n = makePartial s =
 (EX r. m = (X_n *' r) +' s & s <' X_n)"

distr1_Nat [rule_format] :
"ALL r. ALL s. ALL t. (r +' s) *' t = (r *' t) +' (s *' t)"

distr2_Nat [rule_format] :
"ALL r. ALL s. ALL t. t *' (r +' s) = (t *' r) +' (t *' s)"

min_0 [rule_format] : "ALL m. min'(m, 0') = 0'"

div_mod_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0' -->
 makePartial m =
 (let (Xb5, Xc0) =
      let (Xb4, Xc3) = m div' X_n
      in if Xb4 then makePartial (Xc3 *' X_n) else noneOp
  in if Xb5
        then let (Xb2, Xc1) = m mod' X_n
             in if Xb2 then makePartial (Xc0 +' Xc1) else noneOp
        else noneOp)"

power_Nat [rule_format] :
"ALL m. ALL r. ALL s. m ^' (r +' s) = (m ^' r) *' (m ^' s)"

Comp1 [rule_format] :
"ALL f. ALL g. ALL y. X__o__X (f, g) y = f (g y)"

IdDef [rule_format] : "ALL x. id'(x) = x"

FlipDef [rule_format] : "ALL f. ALL x. ALL y. X_flip f y x = f x y"

FstDef [rule_format] : "ALL x. ALL y. fst'(x, y) = x"

SndDef [rule_format] : "ALL x. ALL y. snd'(x, y) = y"

CurryDef [rule_format] :
"ALL g. ALL x. ALL y. X_curry g x y = g (x, y)"

UncurryDef [rule_format] :
"ALL f. ALL x. ALL y. uncurry f (x, y) = f x y"

NotFalse [rule_format] : "Not' False' = True'"

NotTrue [rule_format] : "Not' True' = False'"

AndFalse [rule_format] : "ALL x. False' && x = False'"

AndTrue [rule_format] : "ALL x. True' && x = x"

AndSym [rule_format] : "ALL x. ALL y. x && y = y && x"

OrDef [rule_format] :
"ALL x. ALL y. x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH = True'"

AndPrefixDef [rule_format] :
"ALL x. ALL y. XLtXAmpXAmpXGt x y = x && y"

OrPrefixDef [rule_format] :
"ALL x. ALL y. XLtXVBarXVBarXGt x y = x || y"

NotFalse1 [rule_format] : "ALL x. Not' x = True' = (x = False')"

NotTrue1 [rule_format] : "ALL x. Not' x = False' = (x = True')"

notNot1 [rule_format] : "ALL x. (~ x = True') = (Not' x = True')"

notNot2 [rule_format] : "ALL x. (~ x = False') = (Not' x = False')"

EqualTDef [rule_format] : "ALL x. ALL y. x = y --> x ==' y = True'"

EqualSymDef [rule_format] : "ALL x. ALL y. x ==' y = y ==' x"

EqualReflex [rule_format] : "ALL x. x ==' x = True'"

EqualTransT [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y ==' z = True' --> x ==' z = True'"

DiffDef [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

DiffSymDef [rule_format] : "ALL x. ALL y. x /= y = y /= x"

DiffTDef [rule_format] :
"ALL x. ALL y. x /= y = True' = (Not' (x ==' y) = True')"

DiffFDef [rule_format] :
"ALL x. ALL y. x /= y = False' = (x ==' y = True')"

TE1 [rule_format] : "ALL x. ALL y. x ==' y = False' --> ~ x = y"

TE2 [rule_format] :
"ALL x. ALL y. Not' (x ==' y) = True' = (x ==' y = False')"

TE3 [rule_format] :
"ALL x. ALL y. Not' (x ==' y) = False' = (x ==' y = True')"

TE4 [rule_format] :
"ALL x. ALL y. (~ x ==' y = True') = (x ==' y = False')"

IBE1 [rule_format] : "True' ==' True' = True'"

IBE2 [rule_format] : "False' ==' False' = True'"

IBE3 [rule_format] : "False' ==' True' = False'"

IBE4 [rule_format] : "True' ==' False' = False'"

IBE5 [rule_format] : "True' /= False' = True'"

IBE6 [rule_format] : "False' /= True' = True'"

IBE7 [rule_format] : "Not' (True' ==' False') = True'"

IBE8 [rule_format] : "Not' Not' (True' ==' False') = False'"

IUE1 [rule_format] : "() ==' () = True'"

IUE2 [rule_format] : "() /= () = False'"

IOE01 [rule_format] : "LT ==' LT = True'"

IOE02 [rule_format] : "EQ ==' EQ = True'"

IOE03 [rule_format] : "GT ==' GT = True'"

IOE04 [rule_format] : "LT ==' EQ = False'"

IOE05 [rule_format] : "LT ==' GT = False'"

IOE06 [rule_format] : "EQ ==' GT = False'"

IOE07 [rule_format] : "LT /= EQ = True'"

IOE08 [rule_format] : "LT /= GT = True'"

IOE09 [rule_format] : "EQ /= GT = True'"

LeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x <'' y = False'"

LeTAsymmetry [rule_format] :
"ALL x. ALL y. x <'' y = True' --> y <'' x = False'"

LeTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. x <'' y = True' & y <'' z = True' --> x <'' z = True'"

LeTTotal [rule_format] :
"ALL x.
 ALL y. (x <'' y = True' | y <'' x = True') | x ==' y = True'"

GeDef [rule_format] : "ALL x. ALL y. x >'' y = y <'' x"

GeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x >'' y = False'"

GeTAsymmetry [rule_format] :
"ALL x. ALL y. x >'' y = True' --> y >'' x = False'"

GeTTransitive [rule_format] :
"ALL x.
 ALL y. ALL z. (x >'' y) && (y >'' z) = True' --> x >'' z = True'"

GeTTotal [rule_format] :
"ALL x. ALL y. ((x >'' y) || (y >'' x)) || (x ==' y) = True'"

LeqDef [rule_format] :
"ALL x. ALL y. x <='' y = (x <'' y) || (x ==' y)"

LeqReflexivity [rule_format] : "ALL x. x <='' x = True'"

LeqTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. (x <='' y) && (y <='' z) = True' --> x <='' z = True'"

LeqTTotal [rule_format] :
"ALL x. ALL y. (x <='' y) && (y <='' x) = x ==' y"

GeqDef [rule_format] :
"ALL x. ALL y. x >='' y = (x >'' y) || (x ==' y)"

GeqReflexivity [rule_format] : "ALL x. x >='' x = True'"

GeqTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. (x >='' y) && (y >='' z) = True' --> x >='' z = True'"

GeqTTotal [rule_format] :
"ALL x. ALL y. (x >='' y) && (y >='' x) = x ==' y"

EqTSOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = True' = (x <'' y = False' & x >'' y = False')"

EqFSOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = False' = (x <'' y = True' | x >'' y = True')"

EqTOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = True' = (x <='' y = True' & x >='' y = True')"

EqFOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = False' = (x <='' y = True' | x >='' y = True')"

EqTOrdTSubstE [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y <'' z = True' --> x <'' z = True'"

EqTOrdFSubstE [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y <'' z = False' --> x <'' z = False'"

EqTOrdTSubstD [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & z <'' y = True' --> z <'' x = True'"

EqTOrdFSubstD [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & z <'' y = False' --> z <'' x = False'"

LeTGeTRel [rule_format] :
"ALL x. ALL y. x <'' y = True' = (y >'' x = True')"

LeFGeFRel [rule_format] :
"ALL x. ALL y. x <'' y = False' = (y >'' x = False')"

LeqTGetTRel [rule_format] :
"ALL x. ALL y. x <='' y = True' = (y >='' x = True')"

LeqFGetFRel [rule_format] :
"ALL x. ALL y. x <='' y = False' = (y >='' x = False')"

GeTLeTRel [rule_format] :
"ALL x. ALL y. x >'' y = True' = (y <'' x = True')"

GeFLeFRel [rule_format] :
"ALL x. ALL y. x >'' y = False' = (y <'' x = False')"

GeqTLeqTRel [rule_format] :
"ALL x. ALL y. x >='' y = True' = (y <='' x = True')"

GeqFLeqFRel [rule_format] :
"ALL x. ALL y. x >='' y = False' = (y <='' x = False')"

LeTGeFEqFRel [rule_format] :
"ALL x.
 ALL y. x <'' y = True' = (x >'' y = False' & x ==' y = False')"

LeFGeTEqTRel [rule_format] :
"ALL x.
 ALL y. x <'' y = False' = (x >'' y = True' | x ==' y = True')"

LeqTGeFRel [rule_format] :
"ALL x. ALL y. x <='' y = True' = (x >'' y = False')"

LeqFGeTRel [rule_format] :
"ALL x. ALL y. x <='' y = False' = (x >'' y = True')"

GeTLeFEqFRel [rule_format] :
"ALL x.
 ALL y. x >'' y = True' = (x <'' y = False' & x ==' y = False')"

GeFLeTEqTRel [rule_format] :
"ALL x.
 ALL y. x >'' y = False' = (x <'' y = True' | x ==' y = True')"

GeqTLeFRel [rule_format] :
"ALL x. ALL y. x >='' y = True' = (x <'' y = False')"

GeqFLeTRel [rule_format] :
"ALL x. ALL y. x >='' y = False' = (x <'' y = True')"

LeqTLeTEqTRel [rule_format] :
"ALL x.
 ALL y. x <='' y = True' = (x <'' y = True' | x ==' y = True')"

LeqFLeFEqFRel [rule_format] :
"ALL x.
 ALL y. x <='' y = False' = (x <'' y = False' & x ==' y = False')"

GeqTGeTEqTRel [rule_format] :
"ALL x.
 ALL y. x >='' y = True' = (x >'' y = True' | x ==' y = True')"

GeqFGeFEqFRel [rule_format] :
"ALL x.
 ALL y. x >='' y = False' = (x >'' y = False' & x ==' y = False')"

LeTGeqFRel [rule_format] :
"ALL x. ALL y. x <'' y = True' = (x >='' y = False')"

GeTLeqFRel [rule_format] :
"ALL x. ALL y. x >'' y = True' = (x <='' y = False')"

LeLeqDiff [rule_format] :
"ALL x. ALL y. x <'' y = (x <='' y) && (x /= y)"

CmpLTDef [rule_format] :
"ALL x. ALL y. compare x y ==' LT = x <'' y"

CmpEQDef [rule_format] :
"ALL x. ALL y. compare x y ==' EQ = x ==' y"

CmpGTDef [rule_format] :
"ALL x. ALL y. compare x y ==' GT = x >'' y"

MaxYDef [rule_format] :
"ALL x. ALL y. X_maxX2 x y ==' y = x <='' y"

MaxXDef [rule_format] :
"ALL x. ALL y. X_maxX2 x y ==' x = y <='' x"

MinXDef [rule_format] :
"ALL x. ALL y. X_minX2 x y ==' x = x <='' y"

MinYDef [rule_format] :
"ALL x. ALL y. X_minX2 x y ==' y = y <='' x"

MaxSym [rule_format] :
"ALL x. ALL y. X_maxX2 x y ==' y = X_maxX2 y x ==' y"

MinSym [rule_format] :
"ALL x. ALL y. X_minX2 x y ==' y = X_minX2 y x ==' y"

TO1 [rule_format] :
"ALL x.
 ALL y. (x ==' y = True' | x <'' y = True') = (x <='' y = True')"

TO2 [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x <'' y = False'"

TO3 [rule_format] :
"ALL x.
 ALL y. Not' Not' (x <'' y) = True' | Not' (x <'' y) = True'"

TO4 [rule_format] :
"ALL x. ALL y. x <'' y = True' --> Not' (x ==' y) = True'"

TO5 [rule_format] :
"ALL w.
 ALL x.
 ALL y.
 ALL z.
 (x <'' y = True' & y <'' z = True') & z <'' w = True' -->
 x <'' w = True'"

TO6 [rule_format] :
"ALL x. ALL z. z <'' x = True' --> Not' (x <'' z) = True'"

TO7 [rule_format] :
"ALL x. ALL y. x <'' y = True' = (y >'' x = True')"

IOO13 [rule_format] : "LT <'' EQ = True'"

IOO14 [rule_format] : "EQ <'' GT = True'"

IOO15 [rule_format] : "LT <'' GT = True'"

IOO16 [rule_format] : "LT <='' EQ = True'"

IOO17 [rule_format] : "EQ <='' GT = True'"

IOO18 [rule_format] : "LT <='' GT = True'"

IOO19 [rule_format] : "EQ >='' LT = True'"

IOO20 [rule_format] : "GT >='' EQ = True'"

IOO21 [rule_format] : "GT >='' LT = True'"

IOO22 [rule_format] : "EQ >'' LT = True'"

IOO23 [rule_format] : "GT >'' EQ = True'"

IOO24 [rule_format] : "GT >'' LT = True'"

IOO25 [rule_format] : "X_maxX2 LT EQ ==' EQ = True'"

IOO26 [rule_format] : "X_maxX2 EQ GT ==' GT = True'"

IOO27 [rule_format] : "X_maxX2 LT GT ==' GT = True'"

IOO28 [rule_format] : "X_minX2 LT EQ ==' LT = True'"

IOO29 [rule_format] : "X_minX2 EQ GT ==' EQ = True'"

IOO30 [rule_format] : "X_minX2 LT GT ==' LT = True'"

IOO31 [rule_format] : "compare LT LT ==' EQ = True'"

IOO32 [rule_format] : "compare EQ EQ ==' EQ = True'"

IOO33 [rule_format] : "compare GT GT ==' EQ = True'"

IBO5 [rule_format] : "False' <'' True' = True'"

IBO6 [rule_format] : "False' >='' True' = False'"

IBO7 [rule_format] : "True' >='' False' = True'"

IBO8 [rule_format] : "True' <'' False' = False'"

IBO9 [rule_format] : "X_maxX2 False' True' ==' True' = True'"

IBO10 [rule_format] : "X_minX2 False' True' ==' False' = True'"

IBO11 [rule_format] : "compare True' True' ==' EQ = True'"

IBO12 [rule_format] : "compare False' False' ==' EQ = True'"

IUO01 [rule_format] : "() <='' () = True'"

IUO02 [rule_format] : "() <'' () = False'"

IUO03 [rule_format] : "() >='' () = True'"

IUO04 [rule_format] : "() >'' () = False'"

IUO05 [rule_format] : "X_maxX2 () () ==' () = True'"

IUO06 [rule_format] : "X_minX2 () () ==' () = True'"

IUO07 [rule_format] : "compare () () ==' EQ = True'"

LengthNil [rule_format] : "length'(Nil') = 0'"

LengthCons [rule_format] :
"ALL x. ALL xs. length'(X_Cons x xs) = suc(length'(xs))"

NotDefHead [rule_format] : "~ defOp (head(Nil'))"

HeadDef [rule_format] :
"ALL x. ALL xs. head(X_Cons x xs) = makePartial x"

NotDefTail [rule_format] : "~ defOp (tail(Nil'))"

TailDef [rule_format] :
"ALL x. ALL xs. tail(X_Cons x xs) = makePartial xs"

FoldrNil [rule_format] : "ALL f. ALL s. X_foldr f s Nil' = s"

FoldrCons [rule_format] :
"ALL f.
 ALL s.
 ALL x. ALL xs. X_foldr f s (X_Cons x xs) = f x (X_foldr f s xs)"

FoldlNil [rule_format] : "ALL g. ALL t. X_foldl g t Nil' = t"

FoldlCons [rule_format] :
"ALL g.
 ALL t.
 ALL z. ALL zs. X_foldl g t (X_Cons z zs) = X_foldl g (g t z) zs"

MapNil [rule_format] : "ALL h. X_map h Nil' = Nil'"

MapCons [rule_format] :
"ALL h.
 ALL x. ALL xs. X_map h (X_Cons x xs) = X_Cons (h x) (X_map h xs)"

XPlusXPlusNil [rule_format] : "ALL l. Nil' ++' l = l"

XPlusXPlusCons [rule_format] :
"ALL l. ALL x. ALL xs. X_Cons x xs ++' l = X_Cons x (xs ++' l)"

XPlusXPlusPrefixDef [rule_format] :
"ALL xs. ALL ys. XLtXPlusXPlusXGt xs ys = xs ++' ys"

FilterNil [rule_format] : "ALL p. X_filter p Nil' = Nil'"

FilterConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = True' -->
 X_filter p (X_Cons x xs) = X_Cons x (X_filter p xs)"

FilterConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs. p x = False' --> X_filter p (X_Cons x xs) = X_filter p xs"

ZipNil [rule_format] : "ALL l. X_zip Nil' l = Nil'"

ZipConsNil [rule_format] :
"ALL l. ALL x. ALL xs. l = Nil' --> X_zip (X_Cons x xs) l = Nil'"

ZipConsCons [rule_format] :
"ALL l.
 ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 l = X_Cons y ys -->
 X_zip (X_Cons x xs) l = X_Cons (x, y) (X_zip xs ys)"

UnzipNil [rule_format] : "unzip(Nil') = (Nil', Nil')"

UnzipCons [rule_format] :
"ALL ps.
 ALL x.
 ALL z.
 unzip(X_Cons (x, z) ps) =
 (let (ys, zs) = unzip(ps) in (X_Cons x ys, X_Cons z zs))"

EqualListNilDef [rule_format] : "Nil' ==' Nil' = True'"

EqualListDef [rule_format] :
"ALL x.
 ALL xs.
 ALL y.
 ALL ys. X_Cons x xs ==' X_Cons y ys = (x ==' y) && (xs ==' ys)"

LeListDef [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs. X_Cons z zs <'' X_Cons w ws = (z <'' w) && (zs <'' ws)"

declare ga_selector_pre [simp]
declare ga_selector_undef_pre_0 [simp]
declare ga_comm___XPlus__ [simp]
declare ga_assoc___XPlus__ [simp]
declare ga_right_unit___XPlus__ [simp]
declare ga_left_unit___XPlus__ [simp]
declare ga_left_comm___XPlus__ [simp]
declare ga_comm___Xx__ [simp]
declare ga_assoc___Xx__ [simp]
declare ga_right_unit___Xx__ [simp]
declare ga_left_unit___Xx__ [simp]
declare ga_left_comm___Xx__ [simp]
declare ga_comm_min [simp]
declare ga_assoc_min [simp]
declare ga_left_comm_min [simp]
declare ga_comm_max [simp]
declare ga_assoc_max [simp]
declare ga_right_unit_max [simp]
declare ga_left_unit_max [simp]
declare ga_left_comm_max [simp]
declare leq_def1_Nat [simp]
declare leq_def2_Nat [simp]
declare leq_def3_Nat [simp]
declare even_0_Nat [simp]
declare even_suc_Nat [simp]
declare factorial_0 [simp]
declare add_0_Nat [simp]
declare mult_0_Nat [simp]
declare power_0_Nat [simp]
declare subTotal_def1_Nat [simp]
declare subTotal_def2_Nat [simp]
declare sub_dom_Nat [simp]
declare divide_0_Nat [simp]
declare min_0 [simp]
declare Comp1 [simp]
declare IdDef [simp]
declare FlipDef [simp]
declare FstDef [simp]
declare SndDef [simp]
declare CurryDef [simp]
declare UncurryDef [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare EqualReflex [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare LengthNil [simp]
declare LengthCons [simp]
declare NotDefHead [simp]
declare HeadDef [simp]
declare NotDefTail [simp]
declare TailDef [simp]
declare FoldrNil [simp]
declare FoldlNil [simp]
declare MapNil [simp]
declare XPlusXPlusNil [simp]
declare FilterNil [simp]
declare FilterConsF [simp]
declare ZipNil [simp]
declare EqualListNilDef [simp]

theorem LeListNilFalse : "Nil' <'' Nil' = False'"
by auto

ML "Header.record \"LeListNilFalse\""

theorem FoldlDecomp :
"ALL e.
 ALL i.
 ALL ts.
 ALL ys. X_foldl i e (ys ++' ts) = X_foldl i (X_foldl i e ys) ts"
apply(auto)
apply(case_tac "ys ++' ts")
apply(auto)
apply(simp add: FoldlCons)
apply(induct_tac List)
apply(simp add: FoldlCons)

oops

ML "Header.record \"FoldlDecomp\""

theorem MapDecomp :
"ALL f.
 ALL xs. ALL zs. X_map f (xs ++' zs) = X_map f xs ++' X_map f zs"
apply(auto)
apply(induct_tac xs)
apply(auto)
apply(simp add: MapCons XPlusXPlusCons)
done

ML "Header.record \"MapDecomp\""

theorem MapFunctor :
"ALL f.
 ALL g. ALL xs. X_map (X__o__X (g, f)) xs = X_map g (X_map f xs)"
apply(auto)
apply(induct_tac xs)
apply(auto)
apply(simp add: MapNil MapCons Comp1)
done

ML "Header.record \"MapFunctor\""

theorem FilterProm :
"ALL f.
 ALL p.
 ALL xs.
 X_filter p (X_map f xs) = X_map f (X_filter (X__o__X (p, f)) xs)"
apply(auto)
apply(induct_tac xs)
apply(auto)
apply(case_tac "p(f a)")
apply(auto)
apply(simp add: MapCons)
apply(simp add: FilterConsT)
apply(simp add: MapCons)
apply(simp add: FilterConsT)
done

ML "Header.record \"FilterProm\""

theorem LengthNil1 : "ALL xs. length'(xs) = 0' = (xs = Nil')"
apply(auto)
apply(case_tac xs)
apply(auto)
done

ML "Header.record \"LengthNil1\""

theorem LengthEqualNil :
"ALL ys. length'(Nil') = length'(ys) --> ys = Nil'"
apply(auto)
apply(case_tac ys)
apply(auto)
done

ML "Header.record \"LengthEqualNil\""

theorem LengthEqualCons :
"ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 length'(X_Cons x xs) = length'(X_Cons y ys) -->
 length'(xs) = length'(ys)"
by auto

ML "Header.record \"LengthEqualCons\""

theorem ZipSpec :
"ALL xs.
 ALL ys.
 length'(xs) = length'(ys) --> unzip(X_zip xs ys) = (xs, ys)"
oops
(*
theorem ZipSpec:
assumes "length'(xs) = length'(ys)"
 shows "unzip(X_zip xs ys) = (xs, ys)"
using assms proof (induct xs arbitrary: ys)
 fix ys
 assume "length'(Nil') = length'(ys)"
 then have "ys = Nil'" by (simp add: LengthEqualNil)
 then show "unzip(X_zip Nil' ys) = (Nil', ys)" by (simp add: ZipNil UnzipNil)
next
 fix x
 fix xs::"'a List"
 fix ys::"'b List"
 assume 1: "!!ys::'b List. length'(xs) = length'(ys) ==>
   unzip(X_zip xs ys) = (xs, ys)"
 assume 2: "length'(X_Cons x xs) = length'(ys)"
 then obtain z zs where ys: "ys = X_Cons z zs" and
   length: "length'(xs) = length'(zs)"
   sorry
 hence H: "unzip(X_zip xs zs) = (xs, zs)" using 1 by simp
 have "unzip(X_zip (X_Cons x xs) ys) = unzip(X_zip (X_Cons x xs) (X_Cons z zs))"
   using ys by simp
 also have "... = unzip(X_Cons (x, z) (X_zip xs zs))"
   by (metis ZipConsCons ys)
 also have "... = (X_Cons x xs, X_Cons z zs)"
   using H by (simp add: UnzipCons Let_def)
 also have "... = (X_Cons x xs, ys)" using ys by simp
 finally show "unzip(X_zip (X_Cons x xs) ys) = (X_Cons x xs, ys)" .
qed
*)

ML "Header.record \"ZipSpec\""

end


section \<open>Generic While-Combinator\<close>
theory RefineG_While
imports
  RefineG_Recursion
  "HOL-Library.While_Combinator"
begin

definition
  "WHILEI_body bind return I b f \<equiv>
  (\<lambda>W s.
    if I s then
      if b s then bind (f s) W else return s
    else top)"
definition
  "iWHILEI bind return I b f s0 \<equiv> REC (WHILEI_body bind return I b f) s0"
definition
  "iWHILEIT bind return I b f s0 \<equiv> RECT (WHILEI_body bind return I b f) s0"
definition "iWHILE bind return \<equiv> iWHILEI bind return (\<lambda>_. True)"
definition "iWHILET bind return \<equiv> iWHILEIT bind return (\<lambda>_. True)"

(* TODO: Move to refine_mono_prover*)

locale generic_WHILE =
  fixes bind :: "'m \<Rightarrow> ('a\<Rightarrow>'m) \<Rightarrow> ('m::complete_lattice)"
  fixes return :: "'a \<Rightarrow> 'm"
  fixes WHILEIT WHILEI WHILET WHILE
  assumes imonad1: "bind (return x) f = f x"
  assumes imonad2: "bind M return = M"
  assumes imonad3: "bind (bind M f) g = bind M (\<lambda>x. bind (f x) g)"
  assumes ibind_mono_ge: "\<lbrakk>flat_ge m m'; \<And>x. flat_ge (f x) (f' x)\<rbrakk>
    \<Longrightarrow> flat_ge (bind m f) (bind m' f')"
  assumes ibind_mono: "\<lbrakk>(\<le>) m m'; \<And>x. (\<le>) (f x) (f' x)\<rbrakk>
    \<Longrightarrow> (\<le>) (bind m f) (bind m' f')"
  assumes WHILEIT_eq: "WHILEIT \<equiv> iWHILEIT bind return"
  assumes WHILEI_eq: "WHILEI \<equiv> iWHILEI bind return"
  assumes WHILET_eq: "WHILET \<equiv> iWHILET bind return"
  assumes WHILE_eq: "WHILE \<equiv> iWHILE bind return"
begin

  lemmas WHILEIT_def = WHILEIT_eq[unfolded iWHILEIT_def [abs_def]]
  lemmas WHILEI_def = WHILEI_eq[unfolded iWHILEI_def [abs_def]]
  lemmas WHILET_def = WHILET_eq[unfolded iWHILET_def, folded WHILEIT_eq]
  lemmas WHILE_def = WHILE_eq[unfolded iWHILE_def [abs_def], folded WHILEI_eq]

  lemmas imonad_laws = imonad1 imonad2 imonad3

  lemmas [refine_mono] = ibind_mono_ge ibind_mono

(*  lemma ibind_mono: "m \<le> m' \<Longrightarrow> f \<le> f' \<Longrightarrow> bind m f \<le> bind m' f'"
    by (metis (no_types) ibind_mono1 ibind_mono2 le_funD monoD order_trans)
*)

lemma WHILEI_body_trimono: "trimono (WHILEI_body bind return I b f)"
  unfolding WHILEI_body_def
  by refine_mono

lemmas WHILEI_mono = trimonoD_mono[OF WHILEI_body_trimono]
lemmas WHILEI_mono_ge = trimonoD_flatf_ge[OF WHILEI_body_trimono]

lemma WHILEI_unfold: "WHILEI I b f x = (
  if (I x) then (if b x then bind (f x) (WHILEI I b f) else return x) else top) "
  unfolding WHILEI_def
  apply (subst REC_unfold[OF WHILEI_body_trimono])
  unfolding WHILEI_body_def
  apply (rule refl)
  done

(* TODO: Move *)
lemma REC_mono_ref[refine_mono]:
  "\<lbrakk>trimono B; \<And>D x. B D x \<le> B' D x\<rbrakk> \<Longrightarrow> REC B x \<le> REC B' x"
  unfolding REC_def
  apply clarsimp
  apply (rule lfp_mono[THEN le_funD])
  by (rule le_funI)

lemma RECT_mono_ref[refine_mono]:
  "\<lbrakk>trimono B; \<And>D x. B D x \<le> B' D x\<rbrakk> \<Longrightarrow> RECT B x \<le> RECT B' x"
  unfolding RECT_gfp_def
  apply clarsimp
  apply (rule gfp_mono[THEN le_funD])
  by (rule le_funI)

lemma WHILEI_weaken:
  assumes IW: "\<And>x. I x \<Longrightarrow> I' x"
  shows "WHILEI I' b f x \<le> WHILEI I b f x"
  unfolding WHILEI_def
  apply (rule REC_mono_ref[OF WHILEI_body_trimono])
  apply (auto simp add: WHILEI_body_def dest: IW)
  done

lemma WHILEIT_unfold: "WHILEIT I b f x = (
  if (I x) then
    (if b x then bind (f x) (WHILEIT I b f) else return x)
  else top) "
  unfolding WHILEIT_def
  apply (subst RECT_unfold[OF WHILEI_body_trimono])
  unfolding WHILEI_body_def
  apply (rule refl)
  done

lemma WHILEIT_weaken:
  assumes IW: "\<And>x. I x \<Longrightarrow> I' x"
  shows "WHILEIT I' b f x \<le> WHILEIT I b f x"
  unfolding WHILEIT_def
  apply (rule RECT_mono_ref[OF WHILEI_body_trimono])
  apply (auto simp add: WHILEI_body_def dest: IW)
  done

lemma WHILEI_le_WHILEIT: "WHILEI I b f s \<le> WHILEIT I b f s"
  unfolding WHILEI_def WHILEIT_def
  by (rule REC_le_RECT)

subsubsection \<open>While without Annotated Invariant\<close>

lemma WHILE_unfold:
  "WHILE b f s = (if b s then bind (f s) (WHILE b f) else return s)"
  unfolding WHILE_def
  apply (subst WHILEI_unfold)
  apply simp
  done

lemma WHILET_unfold:
  "WHILET b f s = (if b s then bind (f s) (WHILET b f) else return s)"
  unfolding WHILET_def
  apply (subst WHILEIT_unfold)
  apply simp
  done

lemma transfer_WHILEIT_esc[refine_transfer]:
  assumes REF: "\<And>x. return (f x) \<le> F x"
  shows "return (while b f x) \<le> WHILEIT I b F x"
proof -
  interpret transfer return .
  show ?thesis
    unfolding WHILEIT_def
    apply (rule transfer_RECT'[where fr="while b f"])
    apply (rule while_unfold)
    unfolding WHILEI_body_def
    apply (split if_split, intro allI impI conjI)+
    apply simp_all

    apply (rule order_trans[OF _ ibind_mono[OF REF order_refl]])
    apply (simp add: imonad_laws)
    done
qed

lemma transfer_WHILET_esc[refine_transfer]:
  assumes REF: "\<And>x. return (f x) \<le> F x"
  shows "return (while b f x) \<le> WHILET b F x"
  unfolding WHILET_def
  using assms by (rule transfer_WHILEIT_esc)

lemma WHILE_mono_prover_rule[refine_mono]:
  "\<lbrakk>\<And>x. f x \<le> f' x\<rbrakk> \<Longrightarrow> WHILE b f s0 \<le> WHILE b f' s0"
  "\<lbrakk>\<And>x. f x \<le> f' x\<rbrakk> \<Longrightarrow> WHILEI I b f s0 \<le> WHILEI I b f' s0"
  "\<lbrakk>\<And>x. f x \<le> f' x\<rbrakk> \<Longrightarrow> WHILET b f s0 \<le> WHILET b f' s0"
  "\<lbrakk>\<And>x. f x \<le> f' x\<rbrakk> \<Longrightarrow> WHILEIT I b f s0 \<le> WHILEIT I b f' s0"

  "\<lbrakk>\<And>x. flat_ge (f x) (f' x)\<rbrakk> \<Longrightarrow> flat_ge (WHILET b f s0) (WHILET b f' s0)"
  "\<lbrakk>\<And>x. flat_ge (f x) (f' x)\<rbrakk> \<Longrightarrow> flat_ge (WHILEIT I b f s0) (WHILEIT I b f' s0)"
  unfolding WHILE_def WHILEI_def WHILEI_body_def
    WHILET_def WHILEIT_def
  by refine_mono+

end

locale transfer_WHILE =
  c: generic_WHILE cbind creturn cWHILEIT cWHILEI cWHILET cWHILE +
  a: generic_WHILE abind areturn aWHILEIT aWHILEI aWHILET aWHILE +
  dist_transfer \<alpha>
  for cbind and creturn::"'a \<Rightarrow> 'mc::complete_lattice"
  and cWHILEIT cWHILEI cWHILET cWHILE
  and abind and areturn::"'a \<Rightarrow> 'ma::complete_lattice"
  and aWHILEIT aWHILEI aWHILET aWHILE
  and \<alpha> :: "'mc \<Rightarrow> 'ma" +
  assumes transfer_bind: "\<lbrakk>\<alpha> m \<le> M; \<And>x. \<alpha> (f x) \<le> F x \<rbrakk>
    \<Longrightarrow> \<alpha> (cbind m f) \<le> abind M F"
  assumes transfer_return: "\<alpha> (creturn x) \<le> areturn x"
begin

lemma transfer_WHILEIT[refine_transfer]:
  assumes REF: "\<And>x. \<alpha> (f x) \<le> F x"
  shows "\<alpha> (cWHILEIT I b f x) \<le> aWHILEIT I b F x"
  unfolding c.WHILEIT_def a.WHILEIT_def
  apply (rule transfer_RECT[OF _ c.WHILEI_body_trimono])
  unfolding WHILEI_body_def
  apply auto
  apply (rule transfer_bind)
  apply (rule REF)
  apply assumption
  apply (rule transfer_return)
  done

lemma transfer_WHILEI[refine_transfer]:
  assumes REF: "\<And>x. \<alpha> (f x) \<le> F x"
  shows "\<alpha> (cWHILEI I b f x) \<le> aWHILEI I b F x"
  unfolding c.WHILEI_def a.WHILEI_def
  apply (rule transfer_REC[OF _ c.WHILEI_body_trimono])
  unfolding WHILEI_body_def
  apply auto
  apply (rule transfer_bind)
  apply (rule REF)
  apply assumption
  apply (rule transfer_return)
  done

lemma transfer_WHILE[refine_transfer]:
  assumes REF: "\<And>x. \<alpha> (f x) \<le> F x"
  shows "\<alpha> (cWHILE b f x) \<le> aWHILE b F x"
  unfolding c.WHILE_def a.WHILE_def
  using assms by (rule transfer_WHILEI)

lemma transfer_WHILET[refine_transfer]:
  assumes REF: "\<And>x. \<alpha> (f x) \<le> F x"
  shows "\<alpha> (cWHILET b f x) \<le> aWHILET b F x"
  unfolding c.WHILET_def a.WHILET_def
  using assms by (rule transfer_WHILEIT)

end

locale generic_WHILE_rules =
  generic_WHILE bind return WHILEIT WHILEI WHILET WHILE
  for bind return SPEC WHILEIT WHILEI WHILET WHILE +
  assumes iSPEC_eq: "SPEC \<Phi> = Sup {return x  | x. \<Phi> x}"
  assumes ibind_rule: "\<lbrakk> M \<le> SPEC (\<lambda>x. f x \<le> SPEC \<Phi>) \<rbrakk> \<Longrightarrow> bind M f \<le> SPEC \<Phi>"
begin

  lemma ireturn_eq: "return x = SPEC ((=) x)"
    unfolding iSPEC_eq by auto

  lemma iSPEC_rule: "(\<And>x. \<Phi> x \<Longrightarrow> \<Psi> x) \<Longrightarrow> SPEC \<Phi> \<le> SPEC \<Psi>"
    unfolding iSPEC_eq
    by (auto intro: Sup_mono)

  lemma ireturn_rule: "\<Phi> x \<Longrightarrow> return x \<le> SPEC \<Phi>"
    unfolding ireturn_eq
    by (auto intro: iSPEC_rule)

lemma WHILEI_rule:
  assumes I0: "I s"
  assumes ISTEP: "\<And>s. \<lbrakk>I s; b s\<rbrakk> \<Longrightarrow> f s \<le> SPEC I"
  assumes CONS: "\<And>s. \<lbrakk> I s; \<not> b s \<rbrakk> \<Longrightarrow> \<Phi> s"
  shows "WHILEI I b f s \<le> SPEC \<Phi>"
  apply (rule order_trans[where y="SPEC (\<lambda>s. I s \<and> \<not> b s)"])
    apply (unfold WHILEI_def)
    apply (rule REC_rule[OF WHILEI_body_trimono])
      apply (rule I0)

      unfolding WHILEI_body_def
      apply (split if_split)+
      apply (intro impI conjI)
      apply simp_all
      apply (rule ibind_rule)
        apply (erule (1) order_trans[OF ISTEP])
        apply (rule iSPEC_rule, assumption)

        apply (rule ireturn_rule)
        apply simp

    apply (rule iSPEC_rule)
    apply (simp add: CONS)
  done

lemma WHILEIT_rule:
  assumes WF: "wf R"
  assumes I0: "I s"
  assumes IS: "\<And>s. \<lbrakk> I s; b s \<rbrakk> \<Longrightarrow> f s \<le> SPEC (\<lambda>s'. I s' \<and> (s',s)\<in>R)"
  assumes PHI: "\<And>s. \<lbrakk> I s; \<not> b s \<rbrakk> \<Longrightarrow> \<Phi> s"
  shows "WHILEIT I b f s \<le> SPEC \<Phi>"

  unfolding WHILEIT_def
  apply (rule RECT_rule[OF WHILEI_body_trimono WF, where pre=I,OF I0])
  unfolding WHILEI_body_def
  apply (split if_split)+
  apply (intro impI conjI)
  apply simp_all

  apply (rule ibind_rule)
  apply (rule order_trans[OF IS], assumption+)
  apply (rule iSPEC_rule)
  apply simp

  apply (rule ireturn_rule)
  apply (simp add: PHI)
  done

lemma WHILE_rule:
  assumes I0: "I s"
  assumes ISTEP: "\<And>s. \<lbrakk>I s; b s\<rbrakk> \<Longrightarrow> f s \<le> SPEC I"
  assumes CONS: "\<And>s. \<lbrakk> I s; \<not> b s \<rbrakk> \<Longrightarrow> \<Phi> s"
  shows "WHILE b f s \<le> SPEC \<Phi>"
  unfolding WHILE_def
  apply (rule order_trans[OF WHILEI_weaken WHILEI_rule])
  apply (rule TrueI)
  apply (rule I0)
  using assms by auto

lemma WHILET_rule:
  assumes WF: "wf R"
  assumes I0: "I s"
  assumes IS: "\<And>s. \<lbrakk> I s; b s \<rbrakk> \<Longrightarrow> f s \<le> SPEC (\<lambda>s'. I s' \<and> (s',s)\<in>R)"
  assumes PHI: "\<And>s. \<lbrakk> I s; \<not> b s \<rbrakk> \<Longrightarrow> \<Phi> s"
  shows "WHILET b f s \<le> SPEC \<Phi>"
  unfolding WHILET_def
  apply (rule order_trans[OF WHILEIT_weaken WHILEIT_rule])
  apply (rule TrueI)
  apply (rule WF)
  apply (rule I0)
  using assms by auto

end

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory BinarySearch
imports "../../AutoCorres" "../../DataStructures"
begin

install_C_file "binary_search.c"

autocorres [ts_rules = nondet, unsigned_word_abs=binary_search] "binary_search.c"

context binary_search begin

lemma uint_of_nat:
    "uint (of_nat x :: 'a::len word) = (int x) mod 2^ len_of TYPE('a)"
  apply (clarsimp simp only: uint_nat unat_of_nat)
  apply (metis of_nat_numeral semiring_1_class.of_nat_power zmod_int)
  done

lemma ptr_add_uint_of_nat [simp]:
    "p +\<^sub>p uint (of_nat x :: addr) = p +\<^sub>p int x"
  apply (subst uint_of_nat)
  apply (unfold CTypesDefs.ptr_add_def)
  apply (metis (hide_lams, no_types) uint_of_nat of_int_of_nat_eq of_int_uint)
  done

lemmas [simp] = sint_ucast_eq_uint is_up is_down

primrec
  array :: "lifted_globals \<Rightarrow> word32 ptr \<Rightarrow> word32 list \<Rightarrow> bool"
where
    "array s p [] = True"
  | "array s p (x#xs) = ((heap_w32 s p = x) \<and> (is_valid_w32 s p) \<and> array s (p +\<^sub>p 1) xs)"

definition
  "is_array s p n \<equiv> \<exists>l. array s p l \<and> length l = n"

definition
  "the_array s p n \<equiv> (THE l. length l = n \<and> array s p l)"

lemma array_unique:
    "\<lbrakk> array s p l; array s p l'; length l = length l' \<rbrakk> \<Longrightarrow> l = l'"
  apply (induct l arbitrary: l' p)
   apply clarsimp
  apply (case_tac l')
   apply clarsimp
   apply clarsimp
  done

lemma array_concat [simp]:
  "array s p (a @ b) = (array s p a \<and> array s (p +\<^sub>p int (length a)) b)"
  apply (induct a arbitrary: p)
   apply clarsimp
  apply clarsimp
  apply atomize
  apply (erule_tac x="p +\<^sub>p 1" in allE)
  apply (clarsimp simp: CTypesDefs.ptr_add_def field_simps)
  done

lemma array_is_array: "array s p a \<Longrightarrow> is_array s p (length a)"
  apply (clarsimp simp: is_array_def)
  apply force
  done

lemma array_the_array: "\<lbrakk> array s p a; length a = n \<rbrakk> \<Longrightarrow> the_array s p n = a"
  apply (simp add: the_array_def)
  apply (metis (lifting, mono_tags) array_unique the_equality)
  done

lemma length_the_array [simp]: "is_array s p n \<Longrightarrow> length (the_array s p n) = n"
  apply (induct n arbitrary: n)
   apply (clarsimp simp: is_array_def)
   apply (metis array_the_array)
  apply (clarsimp simp: is_array_def)
  done

lemma the_array_Suc:
  "\<lbrakk> is_array s p n; n > 0 \<rbrakk> \<Longrightarrow> the_array s p n = (heap_w32 s p) # (the_array s (p +\<^sub>p 1) (n - 1))"
  apply (clarsimp simp: is_array_def)
  apply (case_tac l)
   apply clarsimp
  apply clarsimp
  apply (metis One_nat_def Suc_eq_plus1 list.size(4) array.simps(2) array_the_array)
  done

lemma the_array_0 [simp]:
  "the_array s p 0 = []"
  by (metis list.size(3) array.simps(1) array_the_array)

lemma is_array_0 [simp]:
  "is_array s p 0"
  apply (clarsimp simp: is_array_def)
  done

lemma is_array_Suc:
  "\<lbrakk> is_array s p n; is_valid_w32 s (p +\<^sub>p int n) \<rbrakk> \<Longrightarrow>
      is_array s p (Suc n)"
  apply (clarsimp simp: is_array_def)
  apply (rule_tac x="l @ [heap_w32 s (p +\<^sub>p int (length l))]" in exI)
  apply clarsimp
  done

lemma array_expand: "array s p n \<Longrightarrow> array s (p +\<^sub>p 1) (tl n)"
  apply (case_tac n)
   apply clarsimp
  apply clarsimp
  done

lemma array_Ex:
  "\<lbrakk> array s p n; 0 \<le> i; i < int (length n) \<rbrakk> \<Longrightarrow> is_valid_w32 s (p +\<^sub>p i)"
  apply (induct n arbitrary: p i)
   apply clarsimp
  apply clarsimp
  apply atomize
  apply (erule_tac x="p +\<^sub>p 1" in allE)
  apply (erule_tac x="i - 1" in allE)
  apply (clarsimp simp: CTypesDefs.ptr_add_def)
  done

lemma sorted_index_lt:
    "\<lbrakk> sorted xs; unat (xs ! m) < v; n \<le> m; m < length xs \<rbrakk> \<Longrightarrow>  unat (xs ! n) < v"
  by (metis (hide_lams, no_types) le_less_trans sorted_equals_nth_mono word_le_nat_alt)

lemma sorted_index_gt:
    "\<lbrakk> sorted xs; v < unat (xs ! m); m \<le> n; n < length xs \<rbrakk> \<Longrightarrow>  v < unat (xs ! n)"
  by (metis le_less_linear le_less_trans less_irrefl sorted_nth_mono word_less_nat_alt)

lemma array_access_to_list_access:
    "\<lbrakk> array s p data; n < length data \<rbrakk> \<Longrightarrow> (heap_w32 s (p +\<^sub>p int n)) = data ! n"
  apply (induct data arbitrary: n p)
   apply clarsimp
  apply (case_tac "n = 0")
   apply clarsimp
  apply atomize
  apply (erule_tac x="n - 1" in allE)
  apply (erule_tac x="p +\<^sub>p 1" in allE)
  apply (erule impE)
   apply clarsimp
  apply (erule impE)
   apply clarsimp
   apply arith
  apply (clarsimp simp: field_simps CTypesDefs.ptr_add_def)
  done

lemma binary_search_correct:
  "\<lbrace> \<lambda>s. array s arr data \<and> length data < 1000000000 \<and> n = length data \<and> sorted data \<rbrace>
           binary_search' arr n v
        \<lbrace> \<lambda>r s. r \<noteq> 0 \<longleftrightarrow> v \<in> unat ` set data \<rbrace>!"
  apply (rule validNF_assume_pre)
  apply (unfold binary_search'_def)
  apply (case_tac "n = 0")
   apply (subst whileLoop_add_inv [where I="\<lambda>(f, l, r) _. f = 0 \<and> l = 0 \<and> r = 0" and M="\<lambda>_. 0"])
   apply ((wp | clarsimp)+)[1]
  apply (subst whileLoop_add_inv [where
        I="\<lambda>(found, l, r) s. array s arr data  \<and> (r \<le> n)
                \<and> (\<forall>i. i < l \<longrightarrow> i < n \<longrightarrow> unat (data ! i) <  v)
                \<and> (\<forall>i. i \<ge> r \<longrightarrow> i < n \<longrightarrow> v < unat (data ! i))
                \<and> (found \<noteq> 0 \<longrightarrow> v \<in> unat ` set data)"
          and  M="\<lambda>((found, l, r), s). if found = 0 then 1 + (r - l) else 0" ])
  apply wp
     apply (clarsimp split del: if_split cong: if_cong
       simp: field_simps array_access_to_list_access array_Ex UINT_MAX_def)
    apply (subgoal_tac "aa \<le> ((aa + b)  div 2) \<and> ((aa + b) div 2) \<le> b")
     apply (case_tac "unat (data ! ((aa + b) div 2)) = v")
      apply (clarsimp simp: UINT_MAX_def INT_MAX_def)
     apply (case_tac "unat (data ! ((aa + b) div 2)) < v")
      apply (auto elim: sorted_index_lt simp: UINT_MAX_def INT_MAX_def cong: if_cong)[1]
     apply (subgoal_tac "unat (data ! ((aa + b) div 2)) > v")
      apply (clarsimp simp: UINT_MAX_def INT_MAX_def)
      apply (fastforce elim: sorted_index_gt)
     apply force
    apply force
   apply (clarsimp split del: if_split simp: field_simps cong: if_cong)
   apply rule
    apply clarsimp
   apply clarsimp
   apply (metis (no_types) in_set_conv_nth le_less_trans neq_iff not_less)
  apply clarsimp
  done

end

end