theory prop_35
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  fun dropWhile :: "('a => bool) => 'a list => 'a list" where
  "dropWhile x (Nil2) = Nil2"
  | "dropWhile x (Cons2 z xs) =
       (if x z then dropWhile x xs else Cons2 z xs)"
  (*hipster dropWhile *)
  theorem x0 :
    "(dropWhile (% (x :: 'a) => False) xs) = xs"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


section \<open>Operational Semantics\<close>

theory OG_Tran imports OG_Com begin

type_synonym 'a ann_com_op = "('a ann_com) option"
type_synonym 'a ann_triple_op = "('a ann_com_op \<times> 'a assn)"

primrec com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op" where
  "com (c, q) = c"

primrec post :: "'a ann_triple_op \<Rightarrow> 'a assn" where
  "post (c, q) = q"

definition All_None :: "'a ann_triple_op list \<Rightarrow> bool" where
  "All_None Ts \<equiv> \<forall>(c, q) \<in> set Ts. c = None"

subsection \<open>The Transition Relation\<close>

inductive_set
  ann_transition :: "(('a ann_com_op \<times> 'a) \<times> ('a ann_com_op \<times> 'a)) set"
  and transition :: "(('a com \<times> 'a) \<times> ('a com \<times> 'a)) set"
  and ann_transition' :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
    ("_ -1\<rightarrow> _"[81,81] 100)
  and transition' :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
    ("_ -P1\<rightarrow> _"[81,81] 100)
  and transitions :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
    ("_ -P*\<rightarrow> _"[81,81] 100)
where
  "con_0 -1\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition"
| "con_0 -P1\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition"
| "con_0 -P*\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition\<^sup>*"

| AnnBasic:  "(Some (AnnBasic r f), s) -1\<rightarrow> (None, f s)"

| AnnSeq1: "(Some c0, s) -1\<rightarrow> (None, t) \<Longrightarrow>
               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some c1, t)"
| AnnSeq2: "(Some c0, s) -1\<rightarrow> (Some c2, t) \<Longrightarrow>
               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some (AnnSeq c2 c1), t)"

| AnnCond1T: "s \<in> b  \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c1, s)"
| AnnCond1F: "s \<notin> b \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c2, s)"

| AnnCond2T: "s \<in> b  \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (Some c, s)"
| AnnCond2F: "s \<notin> b \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (None, s)"

| AnnWhileF: "s \<notin> b \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> (None, s)"
| AnnWhileT: "s \<in> b  \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow>
                         (Some (AnnSeq c (AnnWhile i b i c)), s)"

| AnnAwait: "\<lbrakk> s \<in> b; atom_com c; (c, s) -P*\<rightarrow> (Parallel [], t) \<rbrakk> \<Longrightarrow>
                   (Some (AnnAwait r b c), s) -1\<rightarrow> (None, t)"

| Parallel: "\<lbrakk> i<length Ts; Ts!i = (Some c, q); (Some c, s) -1\<rightarrow> (r, t) \<rbrakk>
              \<Longrightarrow> (Parallel Ts, s) -P1\<rightarrow> (Parallel (Ts [i:=(r, q)]), t)"

| Basic:  "(Basic f, s) -P1\<rightarrow> (Parallel [], f s)"

| Seq1:   "All_None Ts \<Longrightarrow> (Seq (Parallel Ts) c, s) -P1\<rightarrow> (c, s)"
| Seq2:   "(c0, s) -P1\<rightarrow> (c2, t) \<Longrightarrow> (Seq c0 c1, s) -P1\<rightarrow> (Seq c2 c1, t)"

| CondT: "s \<in> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c1, s)"
| CondF: "s \<notin> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c2, s)"

| WhileF: "s \<notin> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Parallel [], s)"
| WhileT: "s \<in> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Seq c (While b i c), s)"

monos "rtrancl_mono"

text \<open>The corresponding abbreviations are:\<close>

abbreviation
  ann_transition_n :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a)
                           \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)  where
  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition ^^ n"

abbreviation
  ann_transitions :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
                           ("_ -*\<rightarrow> _"[81,81] 100)  where
  "con_0 -*\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition\<^sup>*"

abbreviation
  transition_n :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
                          ("_ -P_\<rightarrow> _"[81,81,81] 100)  where
  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition ^^ n"

subsection \<open>Definition of Semantics\<close>

definition ann_sem :: "'a ann_com \<Rightarrow> 'a \<Rightarrow> 'a set" where
  "ann_sem c \<equiv> \<lambda>s. {t. (Some c, s) -*\<rightarrow> (None, t)}"

definition ann_SEM :: "'a ann_com \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "ann_SEM c S \<equiv> \<Union>(ann_sem c ` S)"

definition sem :: "'a com \<Rightarrow> 'a \<Rightarrow> 'a set" where
  "sem c \<equiv> \<lambda>s. {t. \<exists>Ts. (c, s) -P*\<rightarrow> (Parallel Ts, t) \<and> All_None Ts}"

definition SEM :: "'a com \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "SEM c S \<equiv> \<Union>(sem c ` S)"

abbreviation Omega :: "'a com"    ("\<Omega>" 63)
  where "\<Omega> \<equiv> While UNIV UNIV (Basic id)"

primrec fwhile :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> nat \<Rightarrow> 'a com" where
    "fwhile b c 0 = \<Omega>"
  | "fwhile b c (Suc n) = Cond b (Seq c (fwhile b c n)) (Basic id)"

subsubsection \<open>Proofs\<close>

declare ann_transition_transition.intros [intro]
inductive_cases transition_cases:
    "(Parallel T,s) -P1\<rightarrow> t"
    "(Basic f, s) -P1\<rightarrow> t"
    "(Seq c1 c2, s) -P1\<rightarrow> t"
    "(Cond b c1 c2, s) -P1\<rightarrow> t"
    "(While b i c, s) -P1\<rightarrow> t"

lemma Parallel_empty_lemma [rule_format (no_asm)]:
  "(Parallel [],s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=[] \<and> n=0 \<and> s=t"
apply(induct n)
 apply(simp (no_asm))
apply clarify
apply(drule relpow_Suc_D2)
apply(force elim:transition_cases)
done

lemma Parallel_AllNone_lemma [rule_format (no_asm)]:
 "All_None Ss \<longrightarrow> (Parallel Ss,s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=Ss \<and> n=0 \<and> s=t"
apply(induct "n")
 apply(simp (no_asm))
apply clarify
apply(drule relpow_Suc_D2)
apply clarify
apply(erule transition_cases,simp_all)
apply(force dest:nth_mem simp add:All_None_def)
done

lemma Parallel_AllNone: "All_None Ts \<Longrightarrow> (SEM (Parallel Ts) X) = X"
apply (unfold SEM_def sem_def)
apply auto
apply(drule rtrancl_imp_UN_relpow)
apply clarify
apply(drule Parallel_AllNone_lemma)
apply auto
done

lemma Parallel_empty: "Ts=[] \<Longrightarrow> (SEM (Parallel Ts) X) = X"
apply(rule Parallel_AllNone)
apply(simp add:All_None_def)
done

text \<open>Set of lemmas from Apt and Olderog "Verification of sequential
and concurrent programs", page 63.\<close>

lemma L3_5i: "X\<subseteq>Y \<Longrightarrow> SEM c X \<subseteq> SEM c Y"
apply (unfold SEM_def)
apply force
done

lemma L3_5ii_lemma1:
 "\<lbrakk> (c1, s1) -P*\<rightarrow> (Parallel Ts, s2); All_None Ts;
  (c2, s2) -P*\<rightarrow> (Parallel Ss, s3); All_None Ss \<rbrakk>
 \<Longrightarrow> (Seq c1 c2, s1) -P*\<rightarrow> (Parallel Ss, s3)"
apply(erule converse_rtrancl_induct2)
apply(force intro:converse_rtrancl_into_rtrancl)+
done

lemma L3_5ii_lemma2 [rule_format (no_asm)]:
 "\<forall>c1 c2 s t. (Seq c1 c2, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow>
  (All_None Ts) \<longrightarrow> (\<exists>y m Rs. (c1,s) -P*\<rightarrow> (Parallel Rs, y) \<and>
  (All_None Rs) \<and> (c2, y) -Pm\<rightarrow> (Parallel Ts, t) \<and>  m \<le> n)"
apply(induct "n")
 apply(force)
apply(safe dest!: relpow_Suc_D2)
apply(erule transition_cases,simp_all)
 apply (fast intro!: le_SucI)
apply (fast intro!: le_SucI elim!: relpow_imp_rtrancl converse_rtrancl_into_rtrancl)
done

lemma L3_5ii_lemma3:
 "\<lbrakk>(Seq c1 c2,s) -P*\<rightarrow> (Parallel Ts,t); All_None Ts\<rbrakk> \<Longrightarrow>
    (\<exists>y Rs. (c1,s) -P*\<rightarrow> (Parallel Rs,y) \<and> All_None Rs
   \<and> (c2,y) -P*\<rightarrow> (Parallel Ts,t))"
apply(drule rtrancl_imp_UN_relpow)
apply(fast dest: L3_5ii_lemma2 relpow_imp_rtrancl)
done

lemma L3_5ii: "SEM (Seq c1 c2) X = SEM c2 (SEM c1 X)"
apply (unfold SEM_def sem_def)
apply auto
 apply(fast dest: L3_5ii_lemma3)
apply(fast elim: L3_5ii_lemma1)
done

lemma L3_5iii: "SEM (Seq (Seq c1 c2) c3) X = SEM (Seq c1 (Seq c2 c3)) X"
apply (simp (no_asm) add: L3_5ii)
done

lemma L3_5iv:
 "SEM (Cond b c1 c2) X = (SEM c1 (X \<inter> b)) Un (SEM c2 (X \<inter> (-b)))"
apply (unfold SEM_def sem_def)
apply auto
apply(erule converse_rtranclE)
 prefer 2
 apply (erule transition_cases,simp_all)
  apply(fast intro: converse_rtrancl_into_rtrancl elim: transition_cases)+
done

lemma  L3_5v_lemma1[rule_format]:
 "(S,s) -Pn\<rightarrow> (T,t) \<longrightarrow> S=\<Omega> \<longrightarrow> (\<not>(\<exists>Rs. T=(Parallel Rs) \<and> All_None Rs))"
apply (unfold UNIV_def)
apply(rule nat_less_induct)
apply safe
apply(erule relpow_E2)
 apply simp_all
apply(erule transition_cases)
 apply simp_all
apply(erule relpow_E2)
 apply(simp add: Id_def)
apply(erule transition_cases,simp_all)
apply clarify
apply(erule transition_cases,simp_all)
apply(erule relpow_E2,simp)
apply clarify
apply(erule transition_cases)
 apply simp+
    apply clarify
    apply(erule transition_cases)
apply simp_all
done

lemma L3_5v_lemma2: "\<lbrakk>(\<Omega>, s) -P*\<rightarrow> (Parallel Ts, t); All_None Ts \<rbrakk> \<Longrightarrow> False"
apply(fast dest: rtrancl_imp_UN_relpow L3_5v_lemma1)
done

lemma L3_5v_lemma3: "SEM (\<Omega>) S = {}"
apply (unfold SEM_def sem_def)
apply(fast dest: L3_5v_lemma2)
done

lemma L3_5v_lemma4 [rule_format]:
 "\<forall>s. (While b i c, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>
  (\<exists>k. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t))"
apply(rule nat_less_induct)
apply safe
apply(erule relpow_E2)
 apply safe
apply(erule transition_cases,simp_all)
 apply (rule_tac x = "1" in exI)
 apply(force dest: Parallel_empty_lemma intro: converse_rtrancl_into_rtrancl simp add: Id_def)
apply safe
apply(drule L3_5ii_lemma2)
 apply safe
apply(drule le_imp_less_Suc)
apply (erule allE , erule impE,assumption)
apply (erule allE , erule impE, assumption)
apply safe
apply (rule_tac x = "k+1" in exI)
apply(simp (no_asm))
apply(rule converse_rtrancl_into_rtrancl)
 apply fast
apply(fast elim: L3_5ii_lemma1)
done

lemma L3_5v_lemma5 [rule_format]:
 "\<forall>s. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>
  (While b i c, s) -P*\<rightarrow> (Parallel Ts,t)"
apply(induct "k")
 apply(force dest: L3_5v_lemma2)
apply safe
apply(erule converse_rtranclE)
 apply simp_all
apply(erule transition_cases,simp_all)
 apply(rule converse_rtrancl_into_rtrancl)
  apply(fast)
 apply(fast elim!: L3_5ii_lemma1 dest: L3_5ii_lemma3)
apply(drule rtrancl_imp_UN_relpow)
apply clarify
apply(erule relpow_E2)
 apply simp_all
apply(erule transition_cases,simp_all)
apply(fast dest: Parallel_empty_lemma)
done

lemma L3_5v: "SEM (While b i c) = (\<lambda>x. (\<Union>k. SEM (fwhile b c k) x))"
apply(rule ext)
apply (simp add: SEM_def sem_def)
apply safe
 apply(drule rtrancl_imp_UN_relpow,simp)
 apply clarify
 apply(fast dest:L3_5v_lemma4)
apply(fast intro: L3_5v_lemma5)
done

section \<open>Validity of Correctness Formulas\<close>

definition com_validity :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool" ("(3\<parallel>= _// _//_)" [90,55,90] 50) where
  "\<parallel>= p c q \<equiv> SEM c p \<subseteq> q"

definition ann_com_validity :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool" ("\<Turnstile> _ _" [60,90] 45) where
  "\<Turnstile> c q \<equiv> ann_SEM c (pre c) \<subseteq> q"

end


section \<open>Deep embedding of Pure terms into term-rewriting logic\<close>

theory Embed
imports
  Constructor_Funs.Constructor_Funs
  "../Utils/Code_Utils"
  Eval_Class
keywords "embed" :: thy_decl
begin

fun non_overlapping' :: "term \<Rightarrow> term \<Rightarrow> bool" where
"non_overlapping' (Const x) (Const y) \<longleftrightarrow> x \<noteq> y" |
"non_overlapping' (Const _) (_ $ _) \<longleftrightarrow> True" |
"non_overlapping' (_ $ _) (Const _) \<longleftrightarrow> True" |
"non_overlapping' (t\<^sub>1 $ t\<^sub>2) (u\<^sub>1 $ u\<^sub>2) \<longleftrightarrow> non_overlapping' t\<^sub>1 u\<^sub>1 \<or> non_overlapping' t\<^sub>2 u\<^sub>2" |
"non_overlapping' _ _ \<longleftrightarrow> False"

lemma non_overlapping_approx:
  assumes "non_overlapping' t u"
  shows "non_overlapping t u"
using assms
by (induct t u rule: non_overlapping'.induct) fastforce+

fun pattern_compatible' :: "term \<Rightarrow> term \<Rightarrow> bool" where
"pattern_compatible' (t\<^sub>1 $ t\<^sub>2) (u\<^sub>1 $ u\<^sub>2) \<longleftrightarrow> pattern_compatible' t\<^sub>1 u\<^sub>1 \<and> (t\<^sub>1 = u\<^sub>1 \<longrightarrow> pattern_compatible' t\<^sub>2 u\<^sub>2)" |
"pattern_compatible' t u \<longleftrightarrow> t = u \<or> non_overlapping' t u"

lemma pattern_compatible_approx:
  assumes "pattern_compatible' t u"
  shows "pattern_compatible t u"
using assms
proof (induction t u rule: pattern_compatible.induct)
  case "2_1" (* FIXME intro rule setup for non_overlapping is broken *)
  thus ?case
    by (force simp: non_overlapping_approx)
next
  case "2_5"
  thus ?case
    by (force simp: non_overlapping_approx)
qed auto

abbreviation pattern_compatibles' :: "(term \<times> 'a) fset \<Rightarrow> bool" where
"pattern_compatibles' \<equiv> fpairwise (\<lambda>(lhs\<^sub>1, _) (lhs\<^sub>2, _). pattern_compatible' lhs\<^sub>1 lhs\<^sub>2)"

definition rules' :: "C_info \<Rightarrow> rule fset \<Rightarrow> bool" where
"rules' C_info rs \<longleftrightarrow>
  fBall rs rule \<and>
  arity_compatibles rs \<and>
  is_fmap rs \<and>
  pattern_compatibles' rs \<and>
  rs \<noteq> {||} \<and>
  fBall rs (\<lambda>(lhs, _). \<not> pre_constants.shadows_consts C_info (heads_of rs) lhs) \<and>
  fdisjnt (heads_of rs) (constructors.C C_info) \<and>
  fBall rs (\<lambda>(_, rhs). pre_constants.welldefined C_info (heads_of rs) rhs) \<and>
  distinct (constructors.all_constructors C_info)"

lemma rules_approx:
  assumes "rules' C_info rs"
  shows "rules C_info rs"
proof
  show "fBall rs rule" "arity_compatibles rs" "is_fmap rs" "rs \<noteq> {||}"
   and "fBall rs (\<lambda>(lhs, _). \<not> pre_constants.shadows_consts C_info (heads_of rs) lhs)"
   and "fBall rs (\<lambda>(_, rhs). pre_constants.welldefined C_info (heads_of rs) rhs)"
   and "fdisjnt (heads_of rs) (constructors.C C_info)"
   and "distinct (constructors.all_constructors C_info)"
    using assms unfolding rules'_def by simp+
next
  have "pattern_compatibles' rs"
    using assms unfolding rules'_def by simp
  thus "pattern_compatibles rs"
    by (rule fpairwise_weaken) (blast intro: pattern_compatible_approx)
qed

lemma embed_ext: "f \<equiv> g \<Longrightarrow> f x \<equiv> g x"
by auto

ML_file "embed.ML"

consts "lift_term" :: "'a \<Rightarrow> term" ("\<langle>_\<rangle>")

setup\<open>
  let
    fun embed ((Const (@{const_name lift_term}, _)) $ t) = HOL_Term.mk_term false t
      | embed (t $ u) = embed t $ embed u
      | embed t = t
  in Context.theory_map (Syntax_Phases.term_check 99 "lift" (K (map embed))) end
\<close>

end


(*
    Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      ProcParEx.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2006-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

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

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

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section "Examples for Procedures as Parameters"

theory ProcParEx imports "../Vcg" begin

lemma conseq_exploit_pre':
             "\<lbrakk>\<forall>s \<in> S. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P) c Q,A\<rbrakk>
              \<Longrightarrow>
              \<Gamma>,\<Theta>\<turnstile> (P \<inter> S)c Q,A"
  apply (rule HoarePartialDef.Conseq)
  apply clarify
  by (metis IntI insertI1 subset_refl)

lemma conseq_exploit_pre'':
             "\<lbrakk>\<forall>Z. \<forall>s \<in> S Z.  \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
              \<Longrightarrow>
              \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S Z)c (Q Z),(A Z)"
  apply (rule allI)
  apply (rule conseq_exploit_pre')
  apply blast
  done

lemma conseq_exploit_pre''':
             "\<lbrakk>\<forall>s \<in> S. \<forall>Z. \<Gamma>,\<Theta> \<turnstile> ({s} \<inter> P Z) c (Q Z),(A Z)\<rbrakk>
              \<Longrightarrow>
              \<forall>Z. \<Gamma>,\<Theta>\<turnstile> (P Z \<inter> S)c (Q Z),(A Z)"
  apply (rule allI)
  apply (rule conseq_exploit_pre')
  apply blast
  done

record 'g vars = "'g state" +
  compare_' :: string
  n_'   :: nat
  m_'   :: nat
  b_'   :: bool
  k_'  :: nat

procedures compare(n,m|b) = "NoBody"
print_locale! compare_signature

context compare_signature
begin
declare [[hoare_use_call_tr' = false]]
term "\<acute>b :== CALL compare(\<acute>n,\<acute>m)"
term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
declare [[hoare_use_call_tr' = true]]
term "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m)"
end

procedures
  LEQ (n,m | b) = "\<acute>b :== \<acute>n \<le> \<acute>m"
  LEQ_spec: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>}  PROC LEQ(\<acute>n,\<acute>m,\<acute>b) \<lbrace>\<acute>b = (\<^bsup>\<sigma>\<^esup>n \<le> \<^bsup>\<sigma>\<^esup>m)\<rbrace>"
  LEQ_modifies: "\<forall>\<sigma>. \<Gamma>\<turnstile> {\<sigma>} PROC LEQ(\<acute>n,\<acute>m,\<acute>b) {t. t may_only_modify_globals \<sigma> in []}"

definition mx:: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"
  where "mx leq a b = (if leq a b then a else b)"

procedures
  Max (compare, n, m | k) =
  "\<acute>b :== DYNCALL \<acute>compare(\<acute>n,\<acute>m);;
   IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI"

  Max_spec: "\<And>leq. \<forall>\<sigma>. \<Gamma>\<turnstile>
  ({\<sigma>} \<inter> {s. (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
              (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})})
    PROC Max(\<acute>compare,\<acute>n,\<acute>m,\<acute>k)
  \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"

lemma (in Max_impl ) Max_spec1:
shows
"\<forall>\<sigma> leq. \<Gamma>\<turnstile>
  ({\<sigma>} \<inter> \<lbrace> (\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
      (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
proof -
  fix \<sigma>:: "('a,'b) vars_scheme" and s::"('a,'b) vars_scheme" and leq
   assume compare_spec:
       "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m\<rbrace>"

  assume compare_modifies:
        "\<forall>\<tau>. \<Gamma>\<turnstile>{\<tau>} \<acute>b :== PROC \<^bsup>s\<^esup>compare(\<acute>n,\<acute>m)
                {t. t may_only_modify_globals \<tau> in []}"

   show "\<Gamma>\<turnstile>({s} \<inter> {\<sigma>})
            \<acute>b :== DYNCALL \<acute>compare (\<acute>n,\<acute>m);;
            IF \<acute>b THEN \<acute>k :== \<acute>n ELSE \<acute>k :== \<acute>m FI
            \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
     apply vcg
     apply (clarsimp simp add: mx_def)
     done
 qed

lemma (in Max_impl) Max_spec2:
shows
"\<forall>\<sigma> leq. \<Gamma>\<turnstile>
  ({\<sigma>} \<inter> \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
      (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
apply vcg
apply (clarsimp simp add: mx_def)
done

lemma (in Max_impl) Max_spec3:
shows
"\<forall>n m leq. \<Gamma>\<turnstile>
  (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace>  \<inter>
   \<lbrace>(\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq \<^bsup>\<tau>\<^esup>n \<^bsup>\<tau>\<^esup>m)\<rbrace>) \<and>
     (\<forall>\<tau>. \<Gamma>\<turnstile> {\<tau>} \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) {t. t may_only_modify_globals \<tau> in []})\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq n m\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
apply vcg
apply (clarsimp simp add: mx_def)
done

locale Max_test = Max_spec + LEQ_spec + LEQ_modifies
lemma (in Max_test)

  shows
  "\<Gamma>\<turnstile> {\<sigma>} \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (op \<le>) \<^bsup>\<sigma>\<^esup>n \<^bsup>\<sigma>\<^esup>m\<rbrace>"
proof -
  note Max_spec = Max_spec [where leq="(op \<le>)"]
  show ?thesis
    apply vcg
    apply (clarsimp)
    apply (rule conjI)
    apply (rule LEQ_spec [simplified])
    apply (rule LEQ_modifies [simplified])
    done
qed

lemma (in Max_impl) Max_spec5:
shows
"\<forall>n m leq. \<Gamma>\<turnstile>
  (\<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<inter> \<lbrace>\<forall>n' m'. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n' \<and> \<acute>m=m'\<rbrace> \<acute>b :== PROC \<acute>compare(\<acute>n,\<acute>m) \<lbrace>\<acute>b = (leq n' m')\<rbrace>\<rbrace>)
    \<acute>k :== PROC Max(\<acute>compare,\<acute>n,\<acute>m)
  \<lbrace>\<acute>k = mx leq n m\<rbrace>"
term "\<lbrace>{s. \<^bsup>s\<^esup>n = n' \<and> \<^bsup>s\<^esup>m = m'} = X\<rbrace>"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (intro allI)
apply (rule conseq_exploit_pre')
apply (rule)
apply clarify
apply vcg
apply clarsimp
apply (clarsimp simp add: mx_def)
done

lemma (in LEQ_impl)
 LEQ_spec: "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace>  PROC LEQ(\<acute>n,\<acute>m,\<acute>b) \<lbrace>\<acute>b = (n \<le> m)\<rbrace>"
  apply vcg
  done

locale Max_test' = Max_impl + LEQ_impl
lemma (in Max_test')
  shows
  "\<forall>n m. \<Gamma>\<turnstile> \<lbrace>\<acute>n=n \<and> \<acute>m=m\<rbrace> \<acute>k :== CALL Max(LEQ_'proc,\<acute>n,\<acute>m) \<lbrace>\<acute>k = mx (op \<le>) n m\<rbrace>"
proof -
  note Max_spec = Max_spec5
  show ?thesis
    apply vcg
    apply (rule_tac x="op \<le>" in exI)
    apply clarsimp
    apply (rule LEQ_spec [rule_format])
    done
qed

end