theory Balance_Adapted
  imports "../Abstract_Rbt"
begin

subsection \<open>Balance Cases\<close>

definition "rbt_balance_ad_case_1 lhs k v rhs \<equiv>
  case (lhs, k, v, rhs) of
  ((Branch color.R a w x b), s, t, (Branch color.R c y z d)) \<Rightarrow>
   Branch color.R (Branch color.B a w x b) s t (Branch color.B c y z d)"

definition "rbt_balance_ad_case_2 lhs k v rhs \<equiv>
  case (lhs, k, v, rhs) of
  ((Branch color.R (Branch color.R a w x b) s t c), y, z, d) \<Rightarrow>
   Branch color.R (Branch color.B a w x b) s t (Branch color.B c y z d)"

definition "rbt_balance_ad_case_3 lhs k v rhs \<equiv>
  case (lhs, k, v, rhs) of
  ((Branch color.R a w x (Branch color.R b s t c)), y, z, d) \<Rightarrow>
   Branch color.R (Branch color.B a w x b) s t (Branch color.B c y z d)"

definition "rbt_balance_ad_case_4 lhs k v rhs \<equiv>
  case (lhs, k, v, rhs) of
  (a, w, x, (Branch color.R b s t (Branch color.R c y z d))) \<Rightarrow>
   Branch color.R (Branch color.B a w x b) s t (Branch color.B c y z d)"

definition "rbt_balance_ad_case_5 lhs k v rhs \<equiv>
  case (lhs, k, v, rhs) of
  (a, w, x, (Branch color.R (Branch color.R b s t c) y z d)) \<Rightarrow>
   Branch color.R (Branch color.B a w x b) s t (Branch color.B c y z d)"

definition "rbt_balance_ad_case_6 lhs k v rhs \<equiv>
  case (lhs, k, v, rhs) of
  (a, s, t, b) \<Rightarrow> Branch color.B a s t b"

subsection \<open>Case Checks\<close>

definition "rbt_check_1 lhs rhs \<equiv> rbt_is_red lhs \<and> rbt_is_red rhs"
definition "rbt_check_2 lhs rhs \<equiv> rbt_is_red lhs \<and> rbt_is_red (rbt_left lhs)"
definition "rbt_check_3 lhs rhs \<equiv> rbt_is_red lhs \<and> rbt_is_red (rbt_right lhs)"
definition "rbt_check_4 lhs rhs \<equiv> rbt_is_red rhs \<and> rbt_is_red (rbt_right rhs)"
definition "rbt_check_5 lhs rhs \<equiv> rbt_is_red rhs \<and> rbt_is_red (rbt_left rhs)"

subsubsection \<open>unfold lemmas for checks\<close>

lemma rbt_check_1_unfold:
  assumes "rbt_check_1 lhs rhs"
  obtains ll k_l v_l lr
    rl k_r v_r rr where
    "lhs = (Branch color.R ll k_l v_l lr)"
    "rhs = (Branch color.R rl k_r v_r rr)"
  using assms by (meson rbt_is_red_unfold_branch rbt_check_1_def)

lemma rbt_check_2_unfold:
  assumes "rbt_check_2 lhs rhs"
  obtains k_l v_l lr
    lll k_ll v_ll llr where
    "lhs = (Branch color.R (Branch color.R lll k_ll v_ll llr) k_l v_l lr)"
  using assms
  unfolding rbt_check_2_def rbt_left_def
  by fastforce

lemma rbt_check_3_unfold:
  assumes "rbt_check_3 lhs rhs"
  obtains ll k_l v_l
    lrl k_lr v_lr lrr where
    "lhs = (Branch color.R ll k_l v_l (Branch color.R lrl k_lr v_lr lrr))"
  using assms
  unfolding rbt_check_3_def rbt_right_def
  by fastforce

lemma rbt_check_4_unfold:
  assumes "rbt_check_4 lhs rhs"
  obtains rl k_r v_r
    rrl k_rr v_rr rrr where
    "rhs = (Branch color.R rl k_r v_r (Branch color.R rrl k_rr v_rr rrr))"
  using assms
  unfolding rbt_check_4_def rbt_right_def
  by fastforce

lemma rbt_check_5_unfold:
  assumes "rbt_check_5 lhs rhs"
  obtains k_r v_r rr
    rll k_rl v_rl rlr where
    "rhs = (Branch color.R (Branch color.R rll k_rl v_rl rlr) k_r v_r rr)"
  using assms
  unfolding rbt_check_5_def rbt_left_def
  by fastforce

subsubsection \<open>Adapted Balance Function\<close>

fun rbt_balance_ad where
  "rbt_balance_ad lhs k v rhs =
  (
    if rbt_check_1 lhs rhs
      then rbt_balance_ad_case_1 lhs k v rhs
    else if rbt_check_2 lhs rhs
      then rbt_balance_ad_case_2 lhs k v rhs
    else if rbt_check_3 lhs rhs
      then rbt_balance_ad_case_3 lhs k v rhs
    else if rbt_check_4 lhs rhs
      then rbt_balance_ad_case_4 lhs k v rhs
    else if rbt_check_5 lhs rhs
      then rbt_balance_ad_case_5 lhs k v rhs
    else rbt_balance_ad_case_6 lhs k v rhs
  )
  "

lemma rbt_balance_ad_correct:
  "rbt_balance_ad lhs k v rhs = rbt_balance lhs k v rhs"
  apply (induction lhs k v rhs rule: balance.induct)
  by (auto simp add:
      rbt_is_red_def
      rbt_left_def
      rbt_right_def
      rbt_balance_ad_case_1_def
      rbt_balance_ad_case_2_def
      rbt_balance_ad_case_3_def
      rbt_balance_ad_case_4_def
      rbt_balance_ad_case_5_def
      rbt_balance_ad_case_6_def
      rbt_check_1_def
      rbt_check_2_def
      rbt_check_3_def
      rbt_check_4_def
      rbt_check_5_def
      )

end


section \<open>Weak Order Dependence\<close>

theory WeakOrderDependence imports "../Basic/CFG" DataDependence begin

text \<open>Weak order dependence is just defined as a static control dependence\<close>

subsection\<open>Definition and some lemmas\<close>

definition (in CFG) weak_order_dependence :: "'node \<Rightarrow> 'node \<Rightarrow> 'node \<Rightarrow> bool"
   ("_ \<longrightarrow>\<^sub>w\<^sub>o\<^sub>d _,_")
where wod_def:"n \<longrightarrow>\<^sub>w\<^sub>o\<^sub>d n\<^sub>1,n\<^sub>2 \<equiv> ((n\<^sub>1 \<noteq> n\<^sub>2) \<and>
   (\<exists>as. (n -as\<rightarrow>* n\<^sub>1) \<and> (n\<^sub>2 \<notin> set (sourcenodes as))) \<and>
   (\<exists>as. (n -as\<rightarrow>* n\<^sub>2) \<and> (n\<^sub>1 \<notin> set (sourcenodes as))) \<and>
   (\<exists>a. (valid_edge a) \<and> (n = sourcenode a) \<and>
        ((\<exists>as. (targetnode a -as\<rightarrow>* n\<^sub>1) \<and>
               (\<forall>as'. (targetnode a -as'\<rightarrow>* n\<^sub>2) \<longrightarrow> n\<^sub>1 \<in> set(sourcenodes as'))) \<or>
         (\<exists>as. (targetnode a -as\<rightarrow>* n\<^sub>2) \<and>
               (\<forall>as'. (targetnode a -as'\<rightarrow>* n\<^sub>1) \<longrightarrow> n\<^sub>2 \<in> set(sourcenodes as'))))))"

inductive_set (in CFG_wf) wod_backward_slice :: "'node set \<Rightarrow> 'node set"
for S :: "'node set"
  where refl:"\<lbrakk>valid_node n; n \<in> S\<rbrakk> \<Longrightarrow> n \<in> wod_backward_slice S"

  | cd_closed:
  "\<lbrakk>n' \<longrightarrow>\<^sub>w\<^sub>o\<^sub>d n\<^sub>1,n\<^sub>2; n\<^sub>1 \<in> wod_backward_slice S; n\<^sub>2 \<in> wod_backward_slice S\<rbrakk>
  \<Longrightarrow> n' \<in> wod_backward_slice S"

  | dd_closed:"\<lbrakk>n' influences V in n''; n'' \<in> wod_backward_slice S\<rbrakk>
  \<Longrightarrow> n' \<in> wod_backward_slice S"

lemma (in CFG_wf)
  wod_backward_slice_valid_node:"n \<in> wod_backward_slice S \<Longrightarrow> valid_node n"
by(induct rule:wod_backward_slice.induct,
   auto dest:path_valid_node simp:wod_def data_dependence_def)

end


(*  Title:      HOL/HOLCF/IOA/NTP/Receiver.thy
    Author:     Tobias Nipkow & Konrad Slind
*)

section \<open>The implementation: receiver\<close>

theory Receiver
imports IOA.IOA Action
begin

type_synonym

'm receiver_state
= "'m list * bool multiset * 'm packet multiset * bool * bool"
(* messages  #replies        #received            header mode *)

definition rq :: "'m receiver_state => 'm list" where "rq == fst"
definition rsent :: "'m receiver_state => bool multiset" where "rsent == fst \<circ> snd"
definition rrcvd :: "'m receiver_state => 'm packet multiset" where "rrcvd == fst \<circ> snd \<circ> snd"
definition rbit :: "'m receiver_state => bool" where "rbit == fst \<circ> snd \<circ> snd \<circ> snd"
definition rsending :: "'m receiver_state => bool" where "rsending == snd \<circ> snd \<circ> snd \<circ> snd"

definition
  receiver_asig :: "'m action signature" where
  "receiver_asig =
   (UN pkt. {R_pkt(pkt)},
    (UN m. {R_msg(m)}) Un (UN b. {S_ack(b)}),
    insert C_m_r (UN m. {C_r_r(m)}))"

definition
  receiver_trans:: "('m action, 'm receiver_state)transition set" where
"receiver_trans =
 {tr. let s = fst(tr);
          t = snd(snd(tr))
      in
      case fst(snd(tr))
      of
      S_msg(m) => False |
      R_msg(m) => rq(s) = (m # rq(t))   &
                  rsent(t)=rsent(s)     &
                  rrcvd(t)=rrcvd(s)     &
                  rbit(t)=rbit(s)       &
                  rsending(t)=rsending(s) |
      S_pkt(pkt) => False |
      R_pkt(pkt) => rq(t) = rq(s)                        &
                       rsent(t) = rsent(s)                  &
                       rrcvd(t) = addm (rrcvd s) pkt        &
                       rbit(t) = rbit(s)                    &
                       rsending(t) = rsending(s) |
      S_ack(b) => b = rbit(s)                        &
                     rq(t) = rq(s)                      &
                     rsent(t) = addm (rsent s) (rbit s) &
                     rrcvd(t) = rrcvd(s)                &
                     rbit(t)=rbit(s)                    &
                     rsending(s)                        &
                     rsending(t) |
      R_ack(b) => False |
      C_m_s => False |
 C_m_r => count (rsent s) (~rbit s) < countm (rrcvd s) (%y. hdr(y)=rbit(s)) &
             rq(t) = rq(s)                        &
             rsent(t)=rsent(s)                    &
             rrcvd(t)=rrcvd(s)                    &
             rbit(t)=rbit(s)                      &
             rsending(s)                          &
             ~rsending(t) |
    C_r_s => False |
 C_r_r(m) => count (rsent s) (rbit s) <= countm (rrcvd s) (%y. hdr(y)=rbit(s)) &
             count (rsent s) (~rbit s) < count (rrcvd s) (rbit(s),m) &
             rq(t) = rq(s)@[m]                         &
             rsent(t)=rsent(s)                         &
             rrcvd(t)=rrcvd(s)                         &
             rbit(t) = (~rbit(s))                      &
             ~rsending(s)                              &
             rsending(t)}"

definition
  receiver_ioa  :: "('m action, 'm receiver_state)ioa" where
  "receiver_ioa =
    (receiver_asig, {([],{|},{|},False,False)}, receiver_trans,{},{})"

lemma in_receiver_asig:
  "S_msg(m) \<notin> actions(receiver_asig)"
  "R_msg(m) \<in> actions(receiver_asig)"
  "S_pkt(pkt) \<notin> actions(receiver_asig)"
  "R_pkt(pkt) \<in> actions(receiver_asig)"
  "S_ack(b) \<in> actions(receiver_asig)"
  "R_ack(b) \<notin> actions(receiver_asig)"
  "C_m_s \<notin> actions(receiver_asig)"
  "C_m_r \<in> actions(receiver_asig)"
  "C_r_s \<notin> actions(receiver_asig)"
  "C_r_r(m) \<in> actions(receiver_asig)"
  by (simp_all add: receiver_asig_def actions_def asig_projections)

lemmas receiver_projections = rq_def rsent_def rrcvd_def rbit_def rsending_def

end


(*  Title:       Deriving class instances for datatypes
    Author:      René Thiemann       <rene.thiemann@uibk.ac.at>
    Maintainer:  René Thiemann
    License:     LGPL
*)

(*
Copyright 2013 René Thiemann

This file is part of IsaFoR/CeTA.

IsaFoR/CeTA is free software: you can redistribute it and/or modify it under the
terms of the GNU Lesser General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.

IsaFoR/CeTA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along
with IsaFoR/CeTA. If not, see <http://www.gnu.org/licenses/>.
*)

header {* Hash functions *}

theory Hash_Generator
imports "../Collections/Lib/HashCode"
  Derive_Manager
begin

subsection "Introduction"

text {*
The interface for hash-functions is defined in the class @{class hashable} which has been developed
as part of the Isabelle Collection Framework \cite{rbt}. It requires a hash-function
(@{const hashcode}), a bounded hash-function (@{const bounded_hashcode}),
and a default hash-table size (@{const def_hashmap_size}).

The @{const hashcode} function for each datatype are created by instantiating the recursors of that
datatype appropriately. E.g., for \texttt{datatype 'a test = C1 'a 'a | C2 "'a test list"}
we get a hash-function which is equivalent to
\begin{verbatim}
hashcode (C1 a b) = c1 * hashcode a + c2 * hashcode b
hashcode (C2 Nil) = c3
hashcode (C2 (a # as)) = c4 * hashcode a + c5 * hashcode as
\end{verbatim}
where each \texttt{c$_{i}$} is a non-negative 32-bit number which is dependent on the
datatype name, the constructor name, and the occurence of the argument (i.e.,
in the example \texttt{c1} and \texttt{c2} will usually be different numbers.)
These parameters are used in linear combination with prime numbers to hopefully
get some useful hash-function.

The @{const bounded_hashcode} functions are constructed in the same way, except that after each
arithmetic operation a modulo operation is performed.

Finally, the default hash-table size is just set to 10, following Java's default
hash-table constructor.
*}

subsection "Features and Limitations"

text {*
We get same limitation as for the order generator.
For mutual recursive datatypes, only
for the first mentioned datatype the instantiations of the @{class hashable}-class are
derived.
*}

subsection "Installing the generator"

lemma hash_mod_lemma: "1 < (n :: nat) \<Longrightarrow> x mod n < n" by auto

ML_file "hash_generator.ML"

setup {*
  Hash_Generator.setup
*}

end