theory MPA_Stack
imports StackSemantics Lib_GeneralProofRules OpSem_Proof_Rules
begin

datatype PC =
  L1
| L2
| L3

consts t1 :: T
consts t2 :: T
consts d :: L
consts f :: L

definition "thrdsvars \<equiv> t1 \<noteq> t2 \<and>
                        d \<noteq> f"

record mp_state =
  pc :: "T \<Rightarrow> PC"
  state :: surrey_state
  lstate :: stacks_state
  r :: V

definition
  "update_pc t nv pcf \<equiv> pcf (t := nv)"

lemmas mp_sis [simp] =
  update_pc_def
  thrdsvars_def

definition prog :: "T \<Rightarrow>  mp_state \<Rightarrow> mp_state \<Rightarrow> bool " where
"prog t s s' \<equiv>
(
  if t = t1
    then
      if (pc s) t = L1
        then
           pc s'  = update_pc t L2 (pc s) \<and>
           (state s) [d:=5]\<^sub>t (state s') \<and> lstate s' = lstate s \<and>
           r s = r s'
        else
          if (pc s) t = L2
            then
              pc s' = update_pc t L3 (pc s) \<and>
              (lstate s) (state s) PUSH[1, True]\<^sub>t (lstate s') (state s') \<and>
              r s = r s'
            else
              False
  else
    if t = t2
      then
        if (pc s) t = L1
          then
            (pc s' = update_pc t L2 (pc s) \<and>
            ((lstate s) (state s) POP[1, True]\<^sub>t (lstate s') (state s')))
            \<or>
            (pc s'  = pc s \<and>
            (\<exists> v . v \<noteq> 1 \<and> ((lstate s) (state s) POP[v, True]\<^sub>t (lstate s') (state s'))))
         else
          if (pc s) t = L2
            then
              pc s' = update_pc t L3 (pc s) \<and> lstate s' = lstate s \<and>
              ((state s) [r s' \<leftarrow> d]\<^sub>t (state s'))
            else
              False
   else
    False
)"

definition prog_inv :: "T \<Rightarrow> PC \<Rightarrow> mp_state \<Rightarrow> bool " where
"prog_inv t p s \<equiv> let t' = t2 in
  if t = t1
    then
      (case p of
          L1 \<Rightarrow> \<not>[POP \<approx>\<^sub>t' 1] (lstate s) \<and> [d =\<^sub>t 0] (state s)
        | L2 \<Rightarrow> \<not>[POP \<approx>\<^sub>t' 1] (lstate s) \<and> [d =\<^sub>t 5] (state s)
        | L3 \<Rightarrow> [d =\<^sub>t 5] (state s)
      )
  else
     if t = t2 then
      (case p of
          L1 \<Rightarrow> [POP = 1]\<lparr>d =\<^sub>t 5\<rparr> (lstate s) (state s)
        | L2 \<Rightarrow> [d =\<^sub>t 5] (state s)
        | L3 \<Rightarrow> r s = 5
      )
  else False
"

lemma t1_local:
  assumes "thrdsvars"
      and "wfs (state s)"
      and "ops_wfs (lstate s) (state s)"
      and "prog_inv t1 ((pc s) t1) s"
      and "prog t1 s s'"
    shows "prog_inv t1 ((pc s') t1) s'"
  using assms
  apply (simp add: prog_def prog_inv_def)
  apply (cases "pc s t1"; simp)
  using d_obs_WrX_set apply blast
  using d_obs_push_pres apply blast
  done

lemma t1_global :
  assumes "prog_inv t1 ((pc s) t1) s"
      and "wfs (state s)"
      and "ops_wfs (lstate s) (state s)"
   and "prog_inv t2 ((pc s) t2) s"
  and "thrdsvars"
  and "prog t2 s s'"
shows  "prog_inv t1 ((pc s') t1) s'"
  using assms
  apply (simp add: prog_inv_def prog_def)
  apply (cases "(pc s) t1";cases "(pc s) t2";cases  "pc s' t1"; simp)
             apply(elim conjE exE disjE, intro conjI)
  using not_p_pops_pop_pres apply blast
  using d_obs_pop_pres apply auto[1]
             apply(intro conjI)
  using not_p_pops_pop_pres apply blast
  using d_obs_pop_pres apply blast
  apply auto[1]
           apply auto[1]
  using dobs_RdX_pres apply blast
         apply(intro conjI)
          apply auto[1]
  apply auto[1]
  using d_obs_pop_pres not_p_pops_pop_pres apply blast
  apply auto[1]
  using dobs_RdX_pres apply blast
  apply auto[1]
  apply auto[1]
  using d_obs_pop_pres apply blast
  using dobs_RdX_pres by blast

lemma t2_local:
  assumes "thrdsvars"
      and "wfs (state s)"
       and "ops_wfs (lstate s) (state s)"
     and "prog_inv t2 ((pc s) t2) s"
      and "prog t2 s s'"
    shows "prog_inv t2 ((pc s') t2) s'"
  using assms
  apply (simp add: prog_def prog_inv_def)
  apply (cases "pc s t2", auto)
  using c_pops_transfer apply blast
  using p_pops_pop_pres_poped_value_unknown apply blast
  using d_obs_read_value by blast

lemma t2_global :
  assumes "wfs (state s)"
        and "ops_wfs (lstate s) (state s)"
   and "prog_inv t2 ((pc s) t2) s"
   and "prog_inv t1 ((pc s) t1) s"
  and "thrdsvars"
  and "prog t1 s s'"
shows  "prog_inv t2 ((pc s') t2) s'"
  using assms
  apply (simp add: prog_inv_def prog_def)
  apply (cases "(pc s) t2";cases "(pc s) t1"; cases "(pc s') t2")
                      apply simp_all
  defer
  using c_pops_intro apply blast
  apply(elim conjE)
   apply (simp add: d_obs_def d_obs_t_def)
  using d_obs_push_pres apply blast
  apply (elim conjE)
  using not_p_pops_c_obs_client_write
  by blast

theorem final_inv:
  assumes "wfs (state s)"
  assumes "ops_wfs (lstate s) (state s)"
  and "thrdsvars"
  and "t \<in> {t1, t2}"
  and "t' \<in> {t1, t2}"
  and "prog_inv t ((pc s) t) s"
  and "prog_inv t' ((pc s) t') s"
  and "prog t' s s'"
shows "prog_inv t ((pc s') t) s'"
  using assms apply (simp del: thrdsvars_def)
  using t1_global t1_local t2_global t2_local
  by blast

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_propositional_Sound
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Form = x "Form" "Form" | Not "Form" | Var "int"

fun z :: "'a list => 'a list => 'a list" where
  "z (nil2) y2 = y2"
| "z (cons2 z2 xs) y2 = cons2 z2 (z xs y2)"

fun y :: "int => ((int, bool) pair) list => bool list" where
  "y x2 (nil2) = nil2"
| "y x2 (cons2 (pair2 y22 True) x22) = cons2 (x2 = y22) (y x2 x22)"
| "y x2 (cons2 (pair2 y22 False) x22) = y x2 x22"

fun or2 :: "bool list => bool" where
  "or2 (nil2) = False"
| "or2 (cons2 y2 xs) = (y2 | (or2 xs))"

fun models7 :: "int => ((int, bool) pair) list =>
                ((int, bool) pair) list" where
  "models7 x2 (nil2) = nil2"
| "models7 x2 (cons2 z2 xs) =
     (if (x2 ~= (case z2 of pair2 x22 y22 => x22)) then
        cons2 z2 (models7 x2 xs)
        else
        models7 x2 xs)"

fun models6 :: "int => ((int, bool) pair) list => bool list" where
  "models6 x2 (nil2) = nil2"
| "models6 x2 (cons2 (pair2 y22 True) x22) = models6 x2 x22"
| "models6 x2 (cons2 (pair2 y22 False) x22) =
     cons2 (x2 = y22) (models6 x2 x22)"

fun models5 :: "int => ((int, bool) pair) list =>
                ((int, bool) pair) list" where
  "models5 x2 (nil2) = nil2"
| "models5 x2 (cons2 z2 xs) =
     (if (x2 ~= (case z2 of pair2 x22 y22 => x22)) then
        cons2 z2 (models5 x2 xs)
        else
        models5 x2 xs)"

fun models4 :: "int => ((int, bool) pair) list => bool list" where
  "models4 x2 (nil2) = nil2"
| "models4 x2 (cons2 (pair2 y22 True) x22) =
     cons2 (x2 = y22) (models4 x2 x22)"
| "models4 x2 (cons2 (pair2 y22 False) x22) = models4 x2 x22"

function models :: "(((int, bool) pair) list) list => Form =>
                    (((int, bool) pair) list) list => (((int, bool) pair) list) list"
  and
  models2 :: "Form => (((int, bool) pair) list) list =>
                     (((int, bool) pair) list) list"
  and
  models3 :: "Form => ((int, bool) pair) list =>
                     (((int, bool) pair) list) list" where
  "models x2 q (nil2) = models2 q x2"
| "models x2 q (cons2 z2 x22) = cons2 z2 (models x2 q x22)"
| "models2 q (nil2) = nil2"
| "models2 q (cons2 y2 z2) = models z2 q (models3 q y2)"
| "models3 (x p q) y2 = models2 q (models3 p y2)"
| "models3 (Not (x r q2)) y2 =
     z (models3 (Not r) y2) (models3 (x r (Not q2)) y2)"
| "models3 (Not (Not p2)) y2 = models3 p2 y2"
| "models3 (Not (Var x22)) y2 =
     (if (~ (or2 (models4 x22 y2))) then
        cons2 (cons2 (pair2 x22 False) (models5 x22 y2)) (nil2)
        else
        nil2)"
| "models3 (Var x3) y2 =
     (if (~ (or2 (models6 x3 y2))) then
        cons2 (cons2 (pair2 x3 True) (models7 x3 y2)) (nil2)
        else
        nil2)"
  by pat_completeness auto

fun t2 :: "((int, bool) pair) list => Form => bool" where
  "t2 x2 (x p q) = ((t2 x2 p) & (t2 x2 q))"
| "t2 x2 (Not r) = (~ (t2 x2 r))"
| "t2 x2 (Var z2) = or2 (y z2 x2)"

fun formula :: "Form => (((int, bool) pair) list) list =>
              bool" where
  "formula p (nil2) = True"
| "formula p (cons2 y2 xs) = ((t2 y2 p) & (formula p xs))"

theorem property0 :
  "formula p (models3 p (nil2))"
  oops

end


(*  Title:      Uint8.thy
    Author:     Andreas Lochbihler, ETH Zurich
*)

chapter \<open>Unsigned words of 8 bits\<close>

theory Uint8 imports
  Code_Target_Word_Base
begin

text \<open>
  Restriction for OCaml code generation:
  OCaml does not provide an int8 type, so no special code generation
  for this type is set up. If the theory \<open>Code_Target_Bits_Int\<close>
  is imported, the type \<open>uint8\<close> is emulated via @{typ "8 word"}.
\<close>

declare prod.Quotient[transfer_rule]

section \<open>Type definition and primitive operations\<close>

typedef uint8 = "UNIV :: 8 word set" ..

setup_lifting type_definition_uint8

text \<open>Use an abstract type for code generation to disable pattern matching on @{term Abs_uint8}.\<close>
declare Rep_uint8_inverse[code abstype]

declare Quotient_uint8[transfer_rule]

instantiation uint8 :: comm_ring_1
begin
lift_definition zero_uint8 :: uint8 is "0 :: 8 word" .
lift_definition one_uint8 :: uint8 is "1" .
lift_definition plus_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(+) :: 8 word \<Rightarrow> _" .
lift_definition minus_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(-)" .
lift_definition uminus_uint8 :: "uint8 \<Rightarrow> uint8" is uminus .
lift_definition times_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(*)" .
instance by (standard; transfer) (simp_all add: algebra_simps)
end

instantiation uint8 :: semiring_modulo
begin
lift_definition divide_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(div)" .
lift_definition modulo_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(mod)" .
instance by (standard; transfer) (fact word_mod_div_equality)
end

instantiation uint8 :: linorder begin
lift_definition less_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> bool" is "(<)" .
lift_definition less_eq_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> bool" is "(\<le>)" .
instance by (standard; transfer) (simp_all add: less_le_not_le linear)
end

lemmas [code] = less_uint8.rep_eq less_eq_uint8.rep_eq

context
  includes lifting_syntax
  notes
    transfer_rule_of_bool [transfer_rule]
    transfer_rule_numeral [transfer_rule]
begin

lemma transfer_rule_numeral_uint [transfer_rule]:
  "((=) ===> cr_uint8) numeral numeral"
  by transfer_prover

lemma [transfer_rule]:
  \<open>(cr_uint8 ===> (\<longleftrightarrow>)) even ((dvd) 2 :: uint8 \<Rightarrow> bool)\<close>
  by (unfold dvd_def) transfer_prover

end

instantiation uint8 :: semiring_bits
begin

lift_definition bit_uint8 :: \<open>uint8 \<Rightarrow> nat \<Rightarrow> bool\<close> is bit .

instance
  by (standard; transfer)
    (fact bit_iff_odd even_iff_mod_2_eq_zero odd_iff_mod_2_eq_one odd_one bits_induct
       bits_div_0 bits_div_by_1 bits_mod_div_trivial even_succ_div_2
       even_mask_div_iff exp_div_exp_eq div_exp_eq mod_exp_eq mult_exp_mod_exp_eq
       div_exp_mod_exp_eq even_mult_exp_div_exp_iff)+

end

instantiation uint8 :: semiring_bit_shifts
begin
lift_definition push_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is push_bit .
lift_definition drop_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is drop_bit .
lift_definition take_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is take_bit .
instance by (standard; transfer)
  (fact push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
end

instantiation uint8 :: ring_bit_operations
begin
lift_definition not_uint8 :: \<open>uint8 \<Rightarrow> uint8\<close> is NOT .
lift_definition and_uint8 :: \<open>uint8 \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>(AND)\<close> .
lift_definition or_uint8 :: \<open>uint8 \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>(OR)\<close> .
lift_definition xor_uint8 :: \<open>uint8 \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>(XOR)\<close> .
lift_definition mask_uint8 :: \<open>nat \<Rightarrow> uint8\<close> is mask .
lift_definition set_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>Bit_Operations.set_bit\<close> .
lift_definition unset_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>unset_bit\<close> .
lift_definition flip_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>flip_bit\<close> .
instance by (standard; transfer)
  (simp_all add: bit_simps mask_eq_decr_exp minus_eq_not_minus_1 set_bit_def flip_bit_def)
end

lemma [code]:
  \<open>mask (Suc n) = push_bit n (1 :: uint8) OR mask n\<close>
  \<open>mask 0 = (0 :: uint8)\<close>
  by (simp_all add: mask_Suc_exp push_bit_of_1)

lemma [code]:
  \<open>Bit_Operations.set_bit n w = w OR push_bit n 1\<close> for w :: uint8
  by (fact set_bit_eq_or)

lemma [code]:
  \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: uint8
  by (fact unset_bit_eq_and_not)

lemma [code]:
  \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: uint8
  by (fact flip_bit_eq_xor)

instantiation uint8 :: lsb
begin
lift_definition lsb_uint8 :: \<open>uint8 \<Rightarrow> bool\<close> is lsb .
instance by (standard; transfer)
  (fact lsb_odd)
end

instantiation uint8 :: msb
begin
lift_definition msb_uint8 :: \<open>uint8 \<Rightarrow> bool\<close> is msb .
instance ..
end

setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.qualified_path true \<^binding>\<open>Generic\<close>))\<close>

instantiation uint8 :: set_bit
begin
lift_definition set_bit_uint8 :: \<open>uint8 \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> uint8\<close> is set_bit .
instance
  apply standard
  apply transfer
  apply (simp add: bit_simps)
  done
end

setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.parent_path))\<close>

instantiation uint8 :: bit_comprehension begin
lift_definition set_bits_uint8 :: "(nat \<Rightarrow> bool) \<Rightarrow> uint8" is "set_bits" .
instance by (standard; transfer) (fact set_bits_bit_eq)
end

lemmas [code] = bit_uint8.rep_eq lsb_uint8.rep_eq msb_uint8.rep_eq

instantiation uint8 :: equal begin
lift_definition equal_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> bool" is "equal_class.equal" .
instance by standard (transfer, simp add: equal_eq)
end

lemmas [code] = equal_uint8.rep_eq

instantiation uint8 :: size begin
lift_definition size_uint8 :: "uint8 \<Rightarrow> nat" is "size" .
instance ..
end

lemmas [code] = size_uint8.rep_eq

lift_definition sshiftr_uint8 :: "uint8 \<Rightarrow> nat \<Rightarrow> uint8" (infixl ">>>" 55) is \<open>\<lambda>w n. signed_drop_bit n w\<close> .

lift_definition uint8_of_int :: "int \<Rightarrow> uint8" is "word_of_int" .

definition uint8_of_nat :: "nat \<Rightarrow> uint8"
where "uint8_of_nat = uint8_of_int \<circ> int"

lift_definition int_of_uint8 :: "uint8 \<Rightarrow> int" is "uint" .
lift_definition nat_of_uint8 :: "uint8 \<Rightarrow> nat" is "unat" .

definition integer_of_uint8 :: "uint8 \<Rightarrow> integer"
where "integer_of_uint8 = integer_of_int o int_of_uint8"

text \<open>Use pretty numerals from integer for pretty printing\<close>

context includes integer.lifting begin

lift_definition Uint8 :: "integer \<Rightarrow> uint8" is "word_of_int" .

lemma Rep_uint8_numeral [simp]: "Rep_uint8 (numeral n) = numeral n"
by(induction n)(simp_all add: one_uint8_def Abs_uint8_inverse numeral.simps plus_uint8_def)

lemma numeral_uint8_transfer [transfer_rule]:
  "(rel_fun (=) cr_uint8) numeral numeral"
by(auto simp add: cr_uint8_def)

lemma numeral_uint8 [code_unfold]: "numeral n = Uint8 (numeral n)"
by transfer simp

lemma Rep_uint8_neg_numeral [simp]: "Rep_uint8 (- numeral n) = - numeral n"
by(simp only: uminus_uint8_def)(simp add: Abs_uint8_inverse)

lemma neg_numeral_uint8 [code_unfold]: "- numeral n = Uint8 (- numeral n)"
by transfer(simp add: cr_uint8_def)

end

lemma Abs_uint8_numeral [code_post]: "Abs_uint8 (numeral n) = numeral n"
by(induction n)(simp_all add: one_uint8_def numeral.simps plus_uint8_def Abs_uint8_inverse)

lemma Abs_uint8_0 [code_post]: "Abs_uint8 0 = 0"
by(simp add: zero_uint8_def)

lemma Abs_uint8_1 [code_post]: "Abs_uint8 1 = 1"
by(simp add: one_uint8_def)

section \<open>Code setup\<close>

code_printing code_module Uint8 \<rightharpoonup> (SML)
\<open>(* Test that words can handle numbers between 0 and 3 *)
val _ = if 3 <= Word.wordSize then () else raise (Fail ("wordSize less than 3"));

structure Uint8 : sig
  val set_bit : Word8.word -> IntInf.int -> bool -> Word8.word
  val shiftl : Word8.word -> IntInf.int -> Word8.word
  val shiftr : Word8.word -> IntInf.int -> Word8.word
  val shiftr_signed : Word8.word -> IntInf.int -> Word8.word
  val test_bit : Word8.word -> IntInf.int -> bool
end = struct

fun set_bit x n b =
  let val mask = Word8.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))
  in if b then Word8.orb (x, mask)
     else Word8.andb (x, Word8.notb mask)
  end

fun shiftl x n =
  Word8.<< (x, Word.fromLargeInt (IntInf.toLarge n))

fun shiftr x n =
  Word8.>> (x, Word.fromLargeInt (IntInf.toLarge n))

fun shiftr_signed x n =
  Word8.~>> (x, Word.fromLargeInt (IntInf.toLarge n))

fun test_bit x n =
  Word8.andb (x, Word8.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word8.fromInt 0

end; (* struct Uint8 *)\<close>
code_reserved SML Uint8

code_printing code_module Uint8 \<rightharpoonup> (Haskell)
 \<open>module Uint8(Int8, Word8) where

  import Data.Int(Int8)
  import Data.Word(Word8)\<close>
code_reserved Haskell Uint8

text \<open>
  Scala provides only signed 8bit numbers, so we use these and
  implement sign-sensitive operations like comparisons manually.
\<close>

code_printing code_module Uint8 \<rightharpoonup> (Scala)
\<open>object Uint8 {

def less(x: Byte, y: Byte) : Boolean =
  if (x < 0) y < 0 && x < y
  else y < 0 || x < y

def less_eq(x: Byte, y: Byte) : Boolean =
  if (x < 0) y < 0 && x <= y
  else y < 0 || x <= y

def set_bit(x: Byte, n: BigInt, b: Boolean) : Byte =
  if (b)
    (x | (1 << n.intValue)).toByte
  else
    (x & (1 << n.intValue).unary_~).toByte

def shiftl(x: Byte, n: BigInt) : Byte = (x << n.intValue).toByte

def shiftr(x: Byte, n: BigInt) : Byte = ((x & 255) >>> n.intValue).toByte

def shiftr_signed(x: Byte, n: BigInt) : Byte = (x >> n.intValue).toByte

def test_bit(x: Byte, n: BigInt) : Boolean =
  (x & (1 << n.intValue)) != 0

} /* object Uint8 */\<close>
code_reserved Scala Uint8

text \<open>
  Avoid @{term Abs_uint8} in generated code, use @{term Rep_uint8'} instead.
  The symbolic implementations for code\_simp use @{term Rep_uint8}.

  The new destructor @{term Rep_uint8'} is executable.
  As the simplifier is given the [code abstract] equations literally,
  we cannot implement @{term Rep_uint8} directly, because that makes code\_simp loop.

  If code generation raises Match, some equation probably contains @{term Rep_uint8}
  ([code abstract] equations for @{typ uint8} may use @{term Rep_uint8} because
  these instances will be folded away.)

  To convert @{typ "8 word"} values into @{typ uint8}, use @{term "Abs_uint8'"}.
\<close>

definition Rep_uint8' where [simp]: "Rep_uint8' = Rep_uint8"

lemma Rep_uint8'_transfer [transfer_rule]:
  "rel_fun cr_uint8 (=) (\<lambda>x. x) Rep_uint8'"
unfolding Rep_uint8'_def by(rule uint8.rep_transfer)

lemma Rep_uint8'_code [code]: "Rep_uint8' x = (BITS n. bit x n)"
  by transfer (simp add: set_bits_bit_eq)

lift_definition Abs_uint8' :: "8 word \<Rightarrow> uint8" is "\<lambda>x :: 8 word. x" .

lemma Abs_uint8'_code [code]: "Abs_uint8' x = Uint8 (integer_of_int (uint x))"
including integer.lifting by transfer simp

declare [[code drop: "term_of_class.term_of :: uint8 \<Rightarrow> _"]]

lemma term_of_uint8_code [code]:
  defines "TR \<equiv> typerep.Typerep" and "bit0 \<equiv> STR ''Numeral_Type.bit0''" shows
  "term_of_class.term_of x =
   Code_Evaluation.App (Code_Evaluation.Const (STR ''Uint8.uint8.Abs_uint8'') (TR (STR ''fun'') [TR (STR ''Word.word'') [TR bit0 [TR bit0 [TR bit0 [TR (STR ''Numeral_Type.num1'') []]]]], TR (STR ''Uint8.uint8'') []]))
       (term_of_class.term_of (Rep_uint8' x))"
by(simp add: term_of_anything)

lemma Uin8_code [code abstract]: "Rep_uint8 (Uint8 i) = word_of_int (int_of_integer_symbolic i)"
unfolding Uint8_def int_of_integer_symbolic_def by(simp add: Abs_uint8_inverse)

code_printing type_constructor uint8 \<rightharpoonup>
  (SML) "Word8.word" and
  (Haskell) "Uint8.Word8" and
  (Scala) "Byte"
| constant Uint8 \<rightharpoonup>
  (SML) "Word8.fromLargeInt (IntInf.toLarge _)" and
  (Haskell) "(Prelude.fromInteger _ :: Uint8.Word8)" and
  (Haskell_Quickcheck) "(Prelude.fromInteger (Prelude.toInteger _) :: Uint8.Word8)" and
  (Scala) "_.byteValue"
| constant "0 :: uint8" \<rightharpoonup>
  (SML) "(Word8.fromInt 0)" and
  (Haskell) "(0 :: Uint8.Word8)" and
  (Scala) "0.toByte"
| constant "1 :: uint8" \<rightharpoonup>
  (SML) "(Word8.fromInt 1)" and
  (Haskell) "(1 :: Uint8.Word8)" and
  (Scala) "1.toByte"
| constant "plus :: uint8 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.+ ((_), (_))" and
  (Haskell) infixl 6 "+" and
  (Scala) "(_ +/ _).toByte"
| constant "uminus :: uint8 \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.~" and
  (Haskell) "negate" and
  (Scala) "(- _).toByte"
| constant "minus :: uint8 \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.- ((_), (_))" and
  (Haskell) infixl 6 "-" and
  (Scala) "(_ -/ _).toByte"
| constant "times :: uint8 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.* ((_), (_))" and
  (Haskell) infixl 7 "*" and
  (Scala) "(_ */ _).toByte"
| constant "HOL.equal :: uint8 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
  (SML) "!((_ : Word8.word) = _)" and
  (Haskell) infix 4 "==" and
  (Scala) infixl 5 "=="
| class_instance uint8 :: equal \<rightharpoonup> (Haskell) -
| constant "less_eq :: uint8 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
  (SML) "Word8.<= ((_), (_))" and
  (Haskell) infix 4 "<=" and
  (Scala) "Uint8.less'_eq"
| constant "less :: uint8 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
  (SML) "Word8.< ((_), (_))" and
  (Haskell) infix 4 "<" and
  (Scala) "Uint8.less"
| constant "NOT :: uint8 \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.notb" and
  (Haskell) "Data'_Bits.complement" and
  (Scala) "_.unary'_~.toByte"
| constant "(AND) :: uint8 \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.andb ((_),/ (_))" and
  (Haskell) infixl 7 "Data_Bits..&." and
  (Scala) "(_ & _).toByte"
| constant "(OR) :: uint8 \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.orb ((_),/ (_))" and
  (Haskell) infixl 5 "Data_Bits..|." and
  (Scala) "(_ | _).toByte"
| constant "(XOR) :: uint8 \<Rightarrow> _" \<rightharpoonup>
  (SML) "Word8.xorb ((_),/ (_))" and
  (Haskell) "Data'_Bits.xor" and
  (Scala) "(_ ^ _).toByte"

definition uint8_divmod :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8 \<times> uint8" where
  "uint8_divmod x y =
  (if y = 0 then (undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8), undefined ((mod) :: uint8 \<Rightarrow> _) x (0 :: uint8))
  else (x div y, x mod y))"

definition uint8_div :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8"
where "uint8_div x y = fst (uint8_divmod x y)"

definition uint8_mod :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8"
where "uint8_mod x y = snd (uint8_divmod x y)"

lemma div_uint8_code [code]: "x div y = (if y = 0 then 0 else uint8_div x y)"
including undefined_transfer unfolding uint8_divmod_def uint8_div_def
by transfer (simp add: word_div_def)

lemma mod_uint8_code [code]: "x mod y = (if y = 0 then x else uint8_mod x y)"
including undefined_transfer unfolding uint8_mod_def uint8_divmod_def
by transfer (simp add: word_mod_def)

definition uint8_sdiv :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8"
where
  "uint8_sdiv x y =
   (if y = 0 then undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8)
    else Abs_uint8 (Rep_uint8 x sdiv Rep_uint8 y))"

definition div0_uint8 :: "uint8 \<Rightarrow> uint8"
where [code del]: "div0_uint8 x = undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8)"
declare [[code abort: div0_uint8]]

definition mod0_uint8 :: "uint8 \<Rightarrow> uint8"
where [code del]: "mod0_uint8 x = undefined ((mod) :: uint8 \<Rightarrow> _) x (0 :: uint8)"
declare [[code abort: mod0_uint8]]

lemma uint8_divmod_code [code]:
  "uint8_divmod x y =
  (if 0x80 \<le> y then if x < y then (0, x) else (1, x - y)
   else if y = 0 then (div0_uint8 x, mod0_uint8 x)
   else let q = push_bit 1 (uint8_sdiv (drop_bit 1 x) y);
            r = x - q * y
        in if r \<ge> y then (q + 1, r - y) else (q, r))"
including undefined_transfer unfolding uint8_divmod_def uint8_sdiv_def div0_uint8_def mod0_uint8_def
  apply transfer
  apply (simp add: divmod_via_sdivmod push_bit_eq_mult)
  done

lemma uint8_sdiv_code [code abstract]:
  "Rep_uint8 (uint8_sdiv x y) =
   (if y = 0 then Rep_uint8 (undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8))
    else Rep_uint8 x sdiv Rep_uint8 y)"
unfolding uint8_sdiv_def by(simp add: Abs_uint8_inverse)

text \<open>
  Note that we only need a translation for signed division, but not for the remainder
  because @{thm uint8_divmod_code} computes both with division only.
\<close>

code_printing
  constant uint8_div \<rightharpoonup>
  (SML) "Word8.div ((_), (_))" and
  (Haskell) "Prelude.div"
| constant uint8_mod \<rightharpoonup>
  (SML) "Word8.mod ((_), (_))" and
  (Haskell) "Prelude.mod"
| constant uint8_divmod \<rightharpoonup>
  (Haskell) "divmod"
| constant uint8_sdiv \<rightharpoonup>
  (Scala) "(_ '/ _).toByte"

definition uint8_test_bit :: "uint8 \<Rightarrow> integer \<Rightarrow> bool"
where [code del]:
  "uint8_test_bit x n =
  (if n < 0 \<or> 7 < n then undefined (bit :: uint8 \<Rightarrow> _) x n
   else bit x (nat_of_integer n))"

lemma bit_uint8_code [code]:
  "bit x n \<longleftrightarrow> n < 8 \<and> uint8_test_bit x (integer_of_nat n)"
  including undefined_transfer integer.lifting unfolding uint8_test_bit_def
  by (transfer, simp, transfer, simp)

lemma uint8_test_bit_code [code]:
  "uint8_test_bit w n =
  (if n < 0 \<or> 7 < n then undefined (bit :: uint8 \<Rightarrow> _) w n else bit (Rep_uint8 w) (nat_of_integer n))"
  unfolding uint8_test_bit_def
  by (simp add: bit_uint8.rep_eq)

code_printing constant uint8_test_bit \<rightharpoonup>
  (SML) "Uint8.test'_bit" and
  (Haskell) "Data'_Bits.testBitBounded" and
  (Scala) "Uint8.test'_bit" and
  (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_test'_bit out of bounds\") else Uint8.test'_bit x i)"

definition uint8_set_bit :: "uint8 \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> uint8"
where [code del]:
  "uint8_set_bit x n b =
  (if n < 0 \<or> 7 < n then undefined (set_bit :: uint8 \<Rightarrow> _) x n b
   else set_bit x (nat_of_integer n) b)"

lemma set_bit_uint8_code [code]:
  "set_bit x n b = (if n < 8 then uint8_set_bit x (integer_of_nat n) b else x)"
including undefined_transfer integer.lifting unfolding uint8_set_bit_def
by(transfer)(auto cong: conj_cong simp add: not_less set_bit_beyond word_size)

lemma uint8_set_bit_code [code abstract]:
  "Rep_uint8 (uint8_set_bit w n b) =
  (if n < 0 \<or> 7 < n then Rep_uint8 (undefined (set_bit :: uint8 \<Rightarrow> _) w n b)
   else set_bit (Rep_uint8 w) (nat_of_integer n) b)"
including undefined_transfer unfolding uint8_set_bit_def by transfer simp

code_printing constant uint8_set_bit \<rightharpoonup>
  (SML) "Uint8.set'_bit" and
  (Haskell) "Data'_Bits.setBitBounded" and
  (Scala) "Uint8.set'_bit" and
  (Eval) "(fn x => fn i => fn b => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_set'_bit out of bounds\") else Uint8.set'_bit x i b)"

lift_definition uint8_set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> uint8 \<Rightarrow> nat \<Rightarrow> uint8" is set_bits_aux .

lemma uint8_set_bits_code [code]:
  "uint8_set_bits f w n =
  (if n = 0 then w
   else let n' = n - 1 in uint8_set_bits f (push_bit 1 w OR (if f n' then 1 else 0)) n')"
  apply (transfer fixing: n)
  apply (cases n)
   apply simp_all
  done

lemma set_bits_uint8 [code]:
  "(BITS n. f n) = uint8_set_bits f 0 8"
by transfer(simp add: set_bits_conv_set_bits_aux)

lemma lsb_code [code]: fixes x :: uint8 shows "lsb x = bit x 0"
  by (simp add: lsb_odd)

definition uint8_shiftl :: "uint8 \<Rightarrow> integer \<Rightarrow> uint8"
where [code del]:
  "uint8_shiftl x n = (if n < 0 \<or> 8 \<le> n then undefined (push_bit :: nat \<Rightarrow> uint8 \<Rightarrow> _) x n else push_bit (nat_of_integer n) x)"

lemma shiftl_uint8_code [code]:
  "push_bit n x = (if n < 8 then uint8_shiftl x (integer_of_nat n) else 0)"
  including undefined_transfer integer.lifting unfolding uint8_shiftl_def
  by transfer simp

lemma uint8_shiftl_code [code abstract]:
  "Rep_uint8 (uint8_shiftl w n) =
  (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined (push_bit :: nat \<Rightarrow> uint8 \<Rightarrow> _) w n)
   else push_bit (nat_of_integer n) (Rep_uint8 w))"
  including undefined_transfer unfolding uint8_shiftl_def
  by transfer simp

code_printing constant uint8_shiftl \<rightharpoonup>
  (SML) "Uint8.shiftl" and
  (Haskell) "Data'_Bits.shiftlBounded" and
  (Scala) "Uint8.shiftl" and
  (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_shiftl out of bounds\") else Uint8.shiftl x i)"

definition uint8_shiftr :: "uint8 \<Rightarrow> integer \<Rightarrow> uint8"
where [code del]:
  "uint8_shiftr x n = (if n < 0 \<or> 8 \<le> n then undefined (drop_bit :: _ \<Rightarrow> _ \<Rightarrow> uint8) x n else drop_bit (nat_of_integer n) x)"

lemma shiftr_uint8_code [code]:
  "drop_bit n x = (if n < 8 then uint8_shiftr x (integer_of_nat n) else 0)"
  including undefined_transfer integer.lifting unfolding uint8_shiftr_def
  by transfer simp

lemma uint8_shiftr_code [code abstract]:
  "Rep_uint8 (uint8_shiftr w n) =
  (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined (drop_bit :: _ \<Rightarrow> _ \<Rightarrow> uint8) w n)
   else drop_bit (nat_of_integer n) (Rep_uint8 w))"
including undefined_transfer unfolding uint8_shiftr_def by transfer simp

code_printing constant uint8_shiftr \<rightharpoonup>
  (SML) "Uint8.shiftr" and
  (Haskell) "Data'_Bits.shiftrBounded" and
  (Scala) "Uint8.shiftr" and
  (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_shiftr out of bounds\") else Uint8.shiftr x i)"

definition uint8_sshiftr :: "uint8 \<Rightarrow> integer \<Rightarrow> uint8"
where [code del]:
  "uint8_sshiftr x n =
  (if n < 0 \<or> 8 \<le> n then undefined sshiftr_uint8 x n else sshiftr_uint8 x (nat_of_integer n))"

lemma sshiftr_uint8_code [code]:
  "x >>> n =
  (if n < 8 then uint8_sshiftr x (integer_of_nat n) else if bit x 7 then -1 else 0)"
  including undefined_transfer integer.lifting unfolding uint8_sshiftr_def
  by transfer (simp add: not_less signed_drop_bit_beyond word_size)

lemma uint8_sshiftr_code [code abstract]:
  "Rep_uint8 (uint8_sshiftr w n) =
  (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined sshiftr_uint8 w n)
   else signed_drop_bit (nat_of_integer n) (Rep_uint8 w))"
  including undefined_transfer unfolding uint8_sshiftr_def
  by transfer simp

code_printing constant uint8_sshiftr \<rightharpoonup>
  (SML) "Uint8.shiftr'_signed" and
  (Haskell)
    "(Prelude.fromInteger (Prelude.toInteger (Data'_Bits.shiftrBounded (Prelude.fromInteger (Prelude.toInteger _) :: Uint8.Int8) _)) :: Uint8.Word8)" and
  (Scala) "Uint8.shiftr'_signed" and
  (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_sshiftr out of bounds\") else Uint8.shiftr'_signed x i)"

lemma uint8_msb_test_bit: "msb x \<longleftrightarrow> bit (x :: uint8) 7"
  by transfer (simp add: msb_word_iff_bit)

lemma msb_uint16_code [code]: "msb x \<longleftrightarrow> uint8_test_bit x 7"
  by (simp add: uint8_test_bit_def uint8_msb_test_bit)

lemma uint8_of_int_code [code]: "uint8_of_int i = Uint8 (integer_of_int i)"
including integer.lifting by transfer simp

lemma int_of_uint8_code [code]:
  "int_of_uint8 x = int_of_integer (integer_of_uint8 x)"
by(simp add: integer_of_uint8_def)

lemma nat_of_uint8_code [code]:
  "nat_of_uint8 x = nat_of_integer (integer_of_uint8 x)"
unfolding integer_of_uint8_def including integer.lifting by transfer simp

definition integer_of_uint8_signed :: "uint8 \<Rightarrow> integer"
where
  "integer_of_uint8_signed n = (if bit n 7 then undefined integer_of_uint8 n else integer_of_uint8 n)"

lemma integer_of_uint8_signed_code [code]:
  "integer_of_uint8_signed n =
  (if bit n 7 then undefined integer_of_uint8 n else integer_of_int (uint (Rep_uint8' n)))"
unfolding integer_of_uint8_signed_def integer_of_uint8_def
including undefined_transfer by transfer simp

code_printing
  constant "integer_of_uint8" \<rightharpoonup>
  (SML) "IntInf.fromLarge (Word8.toLargeInt _)" and
  (Haskell) "Prelude.toInteger"
| constant "integer_of_uint8_signed" \<rightharpoonup>
  (Scala) "BigInt"

section \<open>Quickcheck setup\<close>

definition uint8_of_natural :: "natural \<Rightarrow> uint8"
where "uint8_of_natural x \<equiv> Uint8 (integer_of_natural x)"

instantiation uint8 :: "{random, exhaustive, full_exhaustive}" begin
definition "random_uint8 \<equiv> qc_random_cnv uint8_of_natural"
definition "exhaustive_uint8 \<equiv> qc_exhaustive_cnv uint8_of_natural"
definition "full_exhaustive_uint8 \<equiv> qc_full_exhaustive_cnv uint8_of_natural"
instance ..
end

instantiation uint8 :: narrowing begin

interpretation quickcheck_narrowing_samples
  "\<lambda>i. let x = Uint8 i in (x, 0xFF - x)" "0"
  "Typerep.Typerep (STR ''Uint8.uint8'') []" .

definition "narrowing_uint8 d = qc_narrowing_drawn_from (narrowing_samples d) d"
declare [[code drop: "partial_term_of :: uint8 itself \<Rightarrow> _"]]
lemmas partial_term_of_uint8 [code] = partial_term_of_code

instance ..
end

no_notation sshiftr_uint8 (infixl ">>>" 55)

end


section {*L\_ATS\_Language0*}
theory
  L_ATS_Language0

imports
  L_ATS

begin

locale ATS_Language0 =
  ATS
  "TSstructure :: 'TSstructure \<Rightarrow> bool"
  "configurations :: 'TSstructure \<Rightarrow> 'conf set"
  "initial_configurations :: 'TSstructure \<Rightarrow> 'conf set"
  "step_labels :: 'TSstructure \<Rightarrow> 'label set"
  "step_relation :: 'TSstructure \<Rightarrow> 'conf \<Rightarrow> 'label \<Rightarrow> 'conf \<Rightarrow> bool"
  for
    TSstructure configurations initial_configurations step_labels step_relation
    +
  fixes effects :: "'TSstructure \<Rightarrow> 'event set"
  fixes marking_condition :: "'TSstructure \<Rightarrow> ('label,'conf)derivation \<Rightarrow> bool"
  fixes marked_effect :: "'TSstructure \<Rightarrow> ('label,'conf)derivation \<Rightarrow> 'event set"
  fixes unmarked_effect :: "'TSstructure \<Rightarrow> ('label,'conf)derivation \<Rightarrow> 'event set"

context ATS_Language0
begin

definition marked_language :: "
  'TSstructure
  \<Rightarrow> 'event set"
  where
    "marked_language G \<equiv>
  {w. \<exists>d.
    derivation_initial G d
    \<and> w \<in> marked_effect G d
    \<and> derivation G d
    \<and> marking_condition G d}"

definition marked_languageALT :: "
  'TSstructure
  \<Rightarrow> 'event set"
  where
    "marked_languageALT G \<equiv>
  {w. \<exists>d.
    derivation_initial G d
    \<and> w \<in> marked_effect G d
    \<and> marking_condition G d}"

lemma marked_languageALT_equals_marked_language: "
  marked_languageALT G = marked_language G"
  apply(simp add: marked_languageALT_def marked_language_def derivation_initial_def)
  apply(force)
  done

definition finite_marked_language :: "
  'TSstructure
  \<Rightarrow> 'event set"
  where
    "finite_marked_language G \<equiv>
  {w. \<exists>d.
    derivation_initial G d
    \<and> w \<in> marked_effect G d
    \<and> marking_condition G d
    \<and> (\<exists>n. maximum_of_domain d n)}"

definition unmarked_language :: "
  'TSstructure
  \<Rightarrow> 'event set"
  where
    "unmarked_language G \<equiv>
  {w. \<exists>d.
    derivation_initial G d
    \<and> w \<in> unmarked_effect G d
    \<and> derivation G d}"

definition unmarked_languageALT :: "
  'TSstructure
  \<Rightarrow> 'event set"
  where
    "unmarked_languageALT G \<equiv>
  {w. \<exists>d.
    derivation_initial G d
    \<and> w \<in> unmarked_effect G d}"

lemma unmarked_languageALT_equals_unmarked_language: "
  unmarked_languageALT G = unmarked_language G"
  apply(simp add: unmarked_languageALT_def unmarked_language_def derivation_initial_def)
  apply(force)
  done

definition finite_unmarked_language :: "
  'TSstructure
  \<Rightarrow> 'event set"
  where
    "finite_unmarked_language G \<equiv>
  {w. \<exists>d.
    derivation_initial G d
    \<and> w \<in> unmarked_effect G d
    \<and> (\<exists>n. maximum_of_domain d n)}"

definition Nonblockingness_pattern :: "
  'TSstructure
  \<Rightarrow> ('TSstructure \<Rightarrow> ('label,'conf) derivation \<Rightarrow> nat \<Rightarrow> bool)
  \<Rightarrow> ('TSstructure \<Rightarrow> ('label,'conf) derivation \<Rightarrow> nat \<Rightarrow> ('label,'conf) derivation \<Rightarrow> nat \<Rightarrow> ('label,'conf) derivation \<Rightarrow> bool)
  \<Rightarrow> bool"
  where
    "Nonblockingness_pattern M Rest Adapt \<equiv>
  \<forall>dh n.
  derivation_initial M dh
  \<longrightarrow> maximum_of_domain dh n
  \<longrightarrow> Rest M dh n
  \<longrightarrow> (\<exists>dh' dc n'.
  Adapt M dh n dc n' dh'
  \<and> derivation M dc
  \<and> belongs M dc
  \<and> maximum_of_domain dc n'
  \<and> derivation_append_fit dh' dc n
  \<and> marking_condition M (derivation_append dh' dc n))"

definition PB_Nonblockingness_NoRest :: "
  'TSstructure
  \<Rightarrow> ('label,'conf) derivation
  \<Rightarrow> nat
  \<Rightarrow> bool"
  where
    "PB_Nonblockingness_NoRest M dh n \<equiv>
  True"

definition PB_Nonblockingness_NoAdapt :: "
  'TSstructure
  \<Rightarrow> ('label,'conf) derivation
  \<Rightarrow> nat
  \<Rightarrow> ('label,'conf) derivation
  \<Rightarrow> nat
  \<Rightarrow> ('label,'conf) derivation
  \<Rightarrow> bool"
  where
    "PB_Nonblockingness_NoAdapt G dh nh dc nc dh' \<equiv>
  dh' = dh"

definition PB_Nonblockingness_branching :: "
  'TSstructure
  \<Rightarrow> bool"
  where
    "PB_Nonblockingness_branching M \<equiv>
  Nonblockingness_pattern M PB_Nonblockingness_NoRest PB_Nonblockingness_NoAdapt"

definition Nonblockingness_branching :: "
  'TSstructure
  \<Rightarrow> bool"
  where
    "Nonblockingness_branching M \<equiv>
  \<forall>dh n.
  derivation_initial M dh
  \<longrightarrow> maximum_of_domain dh n
  \<longrightarrow> (\<exists>dc n'.
        derivation M dc
        \<and> belongs M dc
        \<and> maximum_of_domain dc n'
        \<and> derivation_append_fit dh dc n
        \<and> marking_condition M (derivation_append dh dc n))"

corollary Nonblockingness_branching_vs_PB_Nonblockingness_branching: "
  Nonblockingness_branching M = PB_Nonblockingness_branching M"
  apply(simp add: Nonblockingness_branching_def Nonblockingness_pattern_def PB_Nonblockingness_branching_def PB_Nonblockingness_NoRest_def PB_Nonblockingness_NoAdapt_def)
  done

definition Nonblockingness_configuration :: "
  'TSstructure
  \<Rightarrow> 'conf
  \<Rightarrow> bool"
  where
    "Nonblockingness_configuration M c \<equiv>
  \<exists>d.
  derivation M d
  \<and> belongs M d
  \<and> d 0 = Some (pair None c)
  \<and> marking_condition M d"

definition derivation_livelock :: "'TSstructure \<Rightarrow> ('label,'conf)derivation \<Rightarrow> bool"
  where
    "derivation_livelock G d \<equiv>
  derivation_initial G d
  \<and> (\<forall>n. d n \<noteq> None)
  \<and> (\<exists>N. \<forall>n\<ge>N.
  unmarked_effect G (derivation_take d N)
  = unmarked_effect G (derivation_take d n))"

definition has_livelock :: "'TSstructure \<Rightarrow> bool"
  where
    "has_livelock G \<equiv>
  \<exists>d. derivation_livelock G d"

definition initial_marking_derivations :: "
  'TSstructure
  \<Rightarrow> ('label,'conf)derivation set"
  where
    "initial_marking_derivations G \<equiv>
  {d. derivation_initial G d \<and> marking_condition G d}"

lemma initial_marking_derivations_equal_implies_marked_language_equal: "
  generator Gi
  \<Longrightarrow> generator Go
  \<Longrightarrow> initial_marking_derivations Go = initial_marking_derivations Gi
  \<Longrightarrow> (\<And>d. derivation_initial Go d \<Longrightarrow> derivation_initial Gi d \<Longrightarrow> marked_effect Go d = marked_effect Gi d)
  \<Longrightarrow> marked_language Go = marked_language Gi"
  apply(simp add: marked_language_def)
  apply(rule antisym)
   apply(clarsimp)
   apply(rule_tac x="d" in exI)
   apply(subgoal_tac "d \<in> initial_marking_derivations Gi")
    prefer 2
    apply(rule_tac A="initial_marking_derivations Go" in set_mp)
     apply(force)
    apply(simp add: initial_marking_derivations_def)
    apply(force)
   apply(simp add: initial_marking_derivations_def)
   apply(simp add: derivation_initial_def)
  apply(clarsimp)
  apply(rule_tac x="d" in exI)
  apply(subgoal_tac "d \<in> initial_marking_derivations Go")
   prefer 2
   apply(rule_tac A="initial_marking_derivations Gi" in set_mp)
    apply(force)
   apply(simp add: initial_marking_derivations_def)
  apply(thin_tac "initial_marking_derivations Go =
           initial_marking_derivations Gi")
  apply(simp add: initial_marking_derivations_def)
  apply(simp add: derivation_initial_def)
  done

end

end