# Theory AllocImpl

Up to index of Isabelle/ZF/UNITY

theory AllocImpl
imports ClientImpl
begin

    (*Title: ZF/UNITY/AllocImpl
        ID:    $Id: AllocImpl.thy,v 1.9 2005/06/17 14:15:11 haftmann Exp $
        Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
        Copyright   2002  University of Cambridge

    Single-client allocator implementation
    Charpentier and Chandy, section 7 (page 17).
    *)

    theory AllocImpl imports ClientImpl begin

    consts

      NbR :: i            (*number of consumed messages*)
      available_tok :: i  (*number of free tokens (T in paper)*)

    translations
      "NbR" == "Var([succ(2)])"
      "available_tok" == "Var([succ(succ(2))])"

    axioms
      alloc_type_assumes [simp]:
      "type_of(NbR) = nat & type_of(available_tok)=nat"

      alloc_default_val_assumes [simp]:
      "default_val(NbR)  = 0 & default_val(available_tok)=0"

    constdefs
      alloc_giv_act :: i
      "alloc_giv_act ==
           {<s, t> ∈ state*state.
            ∃k. k = length(s`giv) &
                t = s(giv := s`giv @ [nth(k, s`ask)],
                      available_tok := s`available_tok #- nth(k, s`ask)) &
                k < length(s`ask) & nth(k, s`ask) le s`available_tok}"

      alloc_rel_act :: i
      "alloc_rel_act ==
           {<s, t> ∈ state*state.
            t = s(available_tok := s`available_tok #+ nth(s`NbR, s`rel),
                  NbR := succ(s`NbR)) &
            s`NbR < length(s`rel)}"

      (*The initial condition s`giv=[] is missing from the
        original definition: S. O. Ehmety *)
      alloc_prog :: i
      "alloc_prog ==
           mk_program({s:state. s`available_tok=NbT & s`NbR=0 & s`giv=Nil},
                      {alloc_giv_act, alloc_rel_act},
                      \<Union>G ∈ preserves(lift(available_tok)) ∩
                            preserves(lift(NbR)) ∩
                            preserves(lift(giv)). Acts(G))"

    lemma available_tok_value_type [simp,TC]: "s∈state ==> s`available_tok ∈ nat"
    apply (unfold state_def)
    apply (drule_tac a = available_tok in apply_type, auto)
    done

    lemma NbR_value_type [simp,TC]: "s∈state ==> s`NbR ∈ nat"
    apply (unfold state_def)
    apply (drule_tac a = NbR in apply_type, auto)
    done

    (** The Alloc Program **)

    lemma alloc_prog_type [simp,TC]: "alloc_prog ∈ program"
    by (simp add: alloc_prog_def)

    declare alloc_prog_def [THEN def_prg_Init, simp]
    declare alloc_prog_def [THEN def_prg_AllowedActs, simp]
    ML
    {*
    program_defs_ref := [thm"alloc_prog_def"]
    *}

    declare  alloc_giv_act_def [THEN def_act_simp, simp]
    declare  alloc_rel_act_def [THEN def_act_simp, simp]

    lemma alloc_prog_ok_iff:
    "∀G ∈ program. (alloc_prog ok G) <->
         (G ∈ preserves(lift(giv)) & G ∈ preserves(lift(available_tok)) &
           G ∈ preserves(lift(NbR)) &  alloc_prog ∈ Allowed(G))"
    by (auto simp add: ok_iff_Allowed alloc_prog_def [THEN def_prg_Allowed])

    lemma alloc_prog_preserves:
        "alloc_prog ∈ (\<Inter>x ∈ var-{giv, available_tok, NbR}. preserves(lift(x)))"
    apply (rule Inter_var_DiffI, force)
    apply (rule ballI)
    apply (rule preservesI, safety)
    done

    (* As a special case of the rule above *)

    lemma alloc_prog_preserves_rel_ask_tok:
        "alloc_prog ∈
           preserves(lift(rel)) ∩ preserves(lift(ask)) ∩ preserves(lift(tok))"
    apply auto
    apply (insert alloc_prog_preserves)
    apply (drule_tac [3] x = tok in Inter_var_DiffD)
    apply (drule_tac [2] x = ask in Inter_var_DiffD)
    apply (drule_tac x = rel in Inter_var_DiffD, auto)
    done

    lemma alloc_prog_Allowed:
    "Allowed(alloc_prog) =
      preserves(lift(giv)) ∩ preserves(lift(available_tok)) ∩ preserves(lift(NbR))"
    apply (cut_tac v="lift(giv)" in preserves_type)
    apply (auto simp add: Allowed_def client_prog_def [THEN def_prg_Allowed]
                          cons_Int_distrib safety_prop_Acts_iff)
    done

    (* In particular we have *)
    lemma alloc_prog_ok_client_prog: "alloc_prog ok client_prog"
    apply (auto simp add: ok_iff_Allowed)
    apply (cut_tac alloc_prog_preserves)
    apply (cut_tac [2] client_prog_preserves)
    apply (auto simp add: alloc_prog_Allowed client_prog_Allowed)
    apply (drule_tac [6] B = "preserves (lift (NbR))" in InterD)
    apply (drule_tac [5] B = "preserves (lift (available_tok))" in InterD)
    apply (drule_tac [4] B = "preserves (lift (giv))" in InterD)
    apply (drule_tac [3] B = "preserves (lift (tok))" in InterD)
    apply (drule_tac [2] B = "preserves (lift (ask))" in InterD)
    apply (drule_tac B = "preserves (lift (rel))" in InterD)
    apply auto
    done

    (** Safety property: (28) **)
    lemma alloc_prog_Increasing_giv: "alloc_prog ∈ program guarantees Incr(lift(giv))"
    apply (auto intro!: increasing_imp_Increasing simp add: guar_def increasing_def alloc_prog_ok_iff alloc_prog_Allowed, safety+)
    apply (auto dest: ActsD)
    apply (drule_tac f = "lift (giv) " in preserves_imp_eq)
    apply auto
    done

    lemma giv_Bounded_lamma1:
    "alloc_prog ∈ stable({s∈state. s`NbR ≤ length(s`rel)} ∩
                         {s∈state. s`available_tok #+ tokens(s`giv) =
                                     NbT #+ tokens(take(s`NbR, s`rel))})"
    apply safety
    apply auto
    apply (simp add: diff_add_0 add_commute diff_add_inverse add_assoc add_diff_inverse)
    apply (simp (no_asm_simp) add: take_succ)
    done

    lemma giv_Bounded_lemma2:
    "[| G ∈ program; alloc_prog ok G; alloc_prog \<squnion> G ∈ Incr(lift(rel)) |]
      ==> alloc_prog \<squnion> G ∈ Stable({s∈state. s`NbR ≤ length(s`rel)} ∩
       {s∈state. s`available_tok #+ tokens(s`giv) =
        NbT #+ tokens(take(s`NbR, s`rel))})"
    apply (cut_tac giv_Bounded_lamma1)
    apply (cut_tac alloc_prog_preserves_rel_ask_tok)
    apply (auto simp add: Collect_conj_eq [symmetric] alloc_prog_ok_iff)
    apply (subgoal_tac "G ∈ preserves (fun_pair (lift (available_tok), fun_pair (lift (NbR), lift (giv))))")
    apply (rotate_tac -1)
    apply (cut_tac A = "nat * nat * list(nat)"
                 and P = "%<m,n,l> y. n ≤ length(y) &
                                      m #+ tokens(l) = NbT #+ tokens(take(n,y))"
                 and g = "lift(rel)" and F = alloc_prog
           in stable_Join_Stable)
    prefer 3 apply assumption
    apply (auto simp add: Collect_conj_eq)
    apply (frule_tac g = length in imp_Increasing_comp)
    apply (blast intro: mono_length)
    apply (auto simp add: refl_prefix)
    apply (drule_tac a=xa and f = "length comp lift(rel)" in Increasing_imp_Stable)
    apply assumption
    apply (auto simp add: Le_def length_type)
    apply (auto dest: ActsD simp add: Stable_def Constrains_def constrains_def)
    apply (drule_tac f = "lift (rel) " in preserves_imp_eq)
    apply assumption+
    apply (force dest: ActsD)
    apply (erule_tac V = "∀x ∈ Acts (alloc_prog) Un Acts (G). ?P(x)" in thin_rl)
    apply (erule_tac V = "alloc_prog ∈ stable (?u)" in thin_rl)
    apply (drule_tac a = "xc`rel" and f = "lift (rel)" in Increasing_imp_Stable)
    apply (auto simp add: Stable_def Constrains_def constrains_def)
    apply (drule bspec, force)
    apply (drule subsetD)
    apply (rule imageI, assumption)
    apply (auto simp add: prefix_take_iff)
    apply (rotate_tac -1)
    apply (erule ssubst)
    apply (auto simp add: take_take min_def)
    done

    (*Property (29), page 18:
      the number of tokens in circulation never exceeds NbT*)
    lemma alloc_prog_giv_Bounded: "alloc_prog ∈ Incr(lift(rel))
          guarantees Always({s∈state. tokens(s`giv) ≤ NbT #+ tokens(s`rel)})"
    apply (cut_tac NbT_pos)
    apply (auto simp add: guar_def)
    apply (rule Always_weaken)
    apply (rule AlwaysI)
    apply (rule_tac [2] giv_Bounded_lemma2, auto)
    apply (rule_tac j = "NbT #+ tokens(take (x` NbR, x`rel))" in le_trans)
    apply (erule subst)
    apply (auto intro!: tokens_mono simp add: prefix_take_iff min_def length_take)
    done

    (*Property (30), page 18: the number of tokens given never exceeds the number
      asked for*)
    lemma alloc_prog_ask_prefix_giv:
         "alloc_prog ∈ Incr(lift(ask)) guarantees
                       Always({s∈state. <s`giv, s`ask> ∈ prefix(tokbag)})"
    apply (auto intro!: AlwaysI simp add: guar_def)
    apply (subgoal_tac "G ∈ preserves (lift (giv))")
     prefer 2 apply (simp add: alloc_prog_ok_iff)
    apply (rule_tac P = "%x y. <x,y> ∈ prefix(tokbag)" and A = "list(nat)"
           in stable_Join_Stable)
    apply safety
     prefer 2 apply (simp add: lift_def, clarify)
    apply (drule_tac a = k in Increasing_imp_Stable, auto)
    done

    subsection{* Towards proving the liveness property, (31) *}

    subsubsection{*First, we lead up to a proof of Lemma 49, page 28.*}

    lemma alloc_prog_transient_lemma:
         "[|G ∈ program; k∈nat|]
          ==> alloc_prog \<squnion> G ∈
                 transient({s∈state. k ≤ length(s`rel)} ∩
                 {s∈state. succ(s`NbR) = k})"
    apply auto
    apply (erule_tac V = "G∉?u" in thin_rl)
    apply (rule_tac act = alloc_rel_act in transientI)
    apply (simp (no_asm) add: alloc_prog_def [THEN def_prg_Acts])
    apply (simp (no_asm) add: alloc_rel_act_def [THEN def_act_eq, THEN act_subset])
    apply (auto simp add: alloc_prog_def [THEN def_prg_Acts] domain_def)
    apply (rule ReplaceI)
    apply (rule_tac x = "x (available_tok:= x`available_tok #+ nth (x`NbR, x`rel),
                            NbR:=succ (x`NbR))"
           in exI)
    apply (auto intro!: state_update_type)
    done

    lemma alloc_prog_rel_Stable_NbR_lemma:
        "[| G ∈ program; alloc_prog ok G; k∈nat |]
         ==> alloc_prog \<squnion> G ∈ Stable({s∈state . k ≤ succ(s ` NbR)})"
    apply (auto intro!: stable_imp_Stable simp add: alloc_prog_ok_iff, safety, auto)
    apply (blast intro: le_trans leI)
    apply (drule_tac f = "lift (NbR)" and A = nat in preserves_imp_increasing)
    apply (drule_tac [2] g = succ in imp_increasing_comp)
    apply (rule_tac [2] mono_succ)
    apply (drule_tac [4] x = k in increasing_imp_stable)
        prefer 5 apply (simp add: Le_def comp_def, auto)
    done

    lemma alloc_prog_NbR_LeadsTo_lemma:
         "[| G ∈ program; alloc_prog ok G;
             alloc_prog \<squnion> G ∈ Incr(lift(rel)); k∈nat |]
          ==> alloc_prog \<squnion> G ∈
                {s∈state. k ≤ length(s`rel)} ∩ {s∈state. succ(s`NbR) = k}
                LeadsTo {s∈state. k ≤ s`NbR}"
    apply (subgoal_tac "alloc_prog \<squnion> G ∈ Stable ({s∈state. k ≤ length (s`rel)})")
    apply (drule_tac [2] a = k and g1 = length in imp_Increasing_comp [THEN Increasing_imp_Stable])
    apply (rule_tac [2] mono_length)
        prefer 3 apply simp
    apply (simp_all add: refl_prefix Le_def comp_def length_type)
    apply (rule LeadsTo_weaken)
    apply (rule PSP_Stable)
    prefer 2 apply assumption
    apply (rule PSP_Stable)
    apply (rule_tac [2] alloc_prog_rel_Stable_NbR_lemma)
    apply (rule alloc_prog_transient_lemma [THEN transient_imp_leadsTo, THEN leadsTo_imp_LeadsTo], assumption+)
    apply (auto dest: not_lt_imp_le elim: lt_asym simp add: le_iff)
    done

    lemma alloc_prog_NbR_LeadsTo_lemma2 [rule_format]:
        "[| G ∈ program; alloc_prog ok G; alloc_prog \<squnion> G ∈ Incr(lift(rel));
            k∈nat; n ∈ nat; n < k |]
          ==> alloc_prog \<squnion> G ∈
                {s∈state . k ≤ length(s ` rel)} ∩ {s∈state . s ` NbR = n}
                   LeadsTo {x ∈ state. k ≤ length(x`rel)} ∩
                     (\<Union>m ∈ greater_than(n). {x ∈ state. x ` NbR=m})"
    apply (unfold greater_than_def)
    apply (rule_tac A' = "{x ∈ state. k ≤ length(x`rel)} ∩ {x ∈ state. n < x`NbR}"
           in LeadsTo_weaken_R)
    apply safe
    apply (subgoal_tac "alloc_prog \<squnion> G ∈ Stable ({s∈state. k ≤ length (s`rel) }) ")
    apply (drule_tac [2] a = k and g1 = length in imp_Increasing_comp [THEN Increasing_imp_Stable])
    apply (rule_tac [2] mono_length)
        prefer 3 apply simp
    apply (simp_all add: refl_prefix Le_def comp_def length_type)
    apply (subst Int_commute [of _ "{x ∈ state . n < x ` NbR}"])
    apply (rule_tac A = "({s ∈ state . k ≤ length (s ` rel) } ∩
                          {s∈state . s ` NbR = n}) ∩ {s∈state. k ≤ length(s`rel)}"
           in LeadsTo_weaken_L)
    apply (rule PSP_Stable, safe)
    apply (rule_tac B = "{x ∈ state . n < length (x ` rel) } ∩ {s∈state . s ` NbR = n}" in LeadsTo_Trans)
    apply (rule_tac [2] LeadsTo_weaken)
    apply (rule_tac [2] k = "succ (n)" in alloc_prog_NbR_LeadsTo_lemma)
    apply simp_all
    apply (rule subset_imp_LeadsTo, auto)
    apply (blast intro: lt_trans2)
    done

    lemma Collect_vimage_eq: "u∈nat ==> {<s,f(s)>. s ∈ A} -`` u = {s∈A. f(s) < u}"
    by (force simp add: lt_def)

    (* Lemma 49, page 28 *)

    lemma alloc_prog_NbR_LeadsTo_lemma3:
      "[|G ∈ program; alloc_prog ok G; alloc_prog \<squnion> G ∈ Incr(lift(rel));
         k∈nat|]
       ==> alloc_prog \<squnion> G ∈
               {s∈state. k ≤ length(s`rel)} LeadsTo {s∈state. k ≤ s`NbR}"
    (* Proof by induction over the difference between k and n *)
    apply (rule_tac f = "λs∈state. k #- s`NbR" in LessThan_induct)
    apply (simp_all add: lam_def, auto)
    apply (rule single_LeadsTo_I, auto)
    apply (simp (no_asm_simp) add: Collect_vimage_eq)
    apply (rename_tac "s0")
    apply (case_tac "s0`NbR < k")
    apply (rule_tac [2] subset_imp_LeadsTo, safe)
    apply (auto dest!: not_lt_imp_le)
    apply (rule LeadsTo_weaken)
    apply (rule_tac n = "s0`NbR" in alloc_prog_NbR_LeadsTo_lemma2, safe)
    prefer 3 apply assumption
    apply (auto split add: nat_diff_split simp add: greater_than_def not_lt_imp_le not_le_iff_lt)
    apply (blast dest: lt_asym)
    apply (force dest: add_lt_elim2)
    done

    subsubsection{*Towards proving lemma 50, page 29*}

    lemma alloc_prog_giv_Ensures_lemma:
    "[| G ∈ program; k∈nat; alloc_prog ok G;
      alloc_prog \<squnion> G ∈ Incr(lift(ask)) |] ==>
      alloc_prog \<squnion> G ∈
      {s∈state. nth(length(s`giv), s`ask) ≤ s`available_tok} ∩
      {s∈state.  k < length(s`ask)} ∩ {s∈state. length(s`giv)=k}
      Ensures {s∈state. ~ k <length(s`ask)} Un {s∈state. length(s`giv) ≠ k}"
    apply (rule EnsuresI, auto)
    apply (erule_tac [2] V = "G∉?u" in thin_rl)
    apply (rule_tac [2] act = alloc_giv_act in transientI)
     prefer 2
     apply (simp add: alloc_prog_def [THEN def_prg_Acts])
     apply (simp add: alloc_giv_act_def [THEN def_act_eq, THEN act_subset])
    apply (auto simp add: alloc_prog_def [THEN def_prg_Acts] domain_def)
    apply (erule_tac [2] swap)
    apply (rule_tac [2] ReplaceI)
    apply (rule_tac [2] x = "x (giv := x ` giv @ [nth (length(x`giv), x ` ask) ], available_tok := x ` available_tok #- nth (length(x`giv), x ` ask))" in exI)
    apply (auto intro!: state_update_type simp add: app_type)
    apply (rule_tac A = "{s∈state . nth (length(s ` giv), s ` ask) ≤ s ` available_tok} ∩ {s∈state . k < length(s ` ask) } ∩ {s∈state. length(s`giv) =k}" and A' = "{s∈state . nth (length(s ` giv), s ` ask) ≤ s ` available_tok} Un {s∈state. ~ k < length(s`ask) } Un {s∈state . length(s ` giv) ≠ k}" in Constrains_weaken)
    apply (auto dest: ActsD simp add: Constrains_def constrains_def alloc_prog_def [THEN def_prg_Acts] alloc_prog_ok_iff)
    apply (subgoal_tac "length(xa ` giv @ [nth (length(xa ` giv), xa ` ask) ]) = length(xa ` giv) #+ 1")
    apply (rule_tac [2] trans)
    apply (rule_tac [2] length_app, auto)
    apply (rule_tac j = "xa ` available_tok" in le_trans, auto)
    apply (drule_tac f = "lift (available_tok)" in preserves_imp_eq)
    apply assumption+
    apply auto
    apply (drule_tac a = "xa ` ask" and r = "prefix(tokbag)" and A = "list(tokbag)"
           in Increasing_imp_Stable)
    apply (auto simp add: prefix_iff)
    apply (drule StableD)
    apply (auto simp add: Constrains_def constrains_def, force)
    done

    lemma alloc_prog_giv_Stable_lemma:
    "[| G ∈ program; alloc_prog ok G; k∈nat |]
      ==> alloc_prog \<squnion> G ∈ Stable({s∈state . k ≤ length(s`giv)})"
    apply (auto intro!: stable_imp_Stable simp add: alloc_prog_ok_iff, safety)
    apply (auto intro: leI)
    apply (drule_tac f = "lift (giv)" and g = length in imp_preserves_comp)
    apply (drule_tac f = "length comp lift (giv)" and A = nat and r = Le in preserves_imp_increasing)
    apply (drule_tac [2] x = k in increasing_imp_stable)
     prefer 3 apply (simp add: Le_def comp_def)
    apply (auto simp add: length_type)
    done

    (* Lemma 50, page 29 *)

    lemma alloc_prog_giv_LeadsTo_lemma:
    "[| G ∈ program; alloc_prog ok G;
        alloc_prog \<squnion> G ∈ Incr(lift(ask)); k∈nat |]
     ==> alloc_prog \<squnion> G ∈
            {s∈state. nth(length(s`giv), s`ask) ≤ s`available_tok} ∩
            {s∈state.  k < length(s`ask)} ∩
            {s∈state. length(s`giv) = k}
            LeadsTo {s∈state. k < length(s`giv)}"
    apply (subgoal_tac "alloc_prog \<squnion> G ∈ {s∈state. nth (length(s`giv), s`ask) ≤ s`available_tok} ∩ {s∈state. k < length(s`ask) } ∩ {s∈state. length(s`giv) = k} LeadsTo {s∈state. ~ k <length(s`ask) } Un {s∈state. length(s`giv) ≠ k}")
    prefer 2 apply (blast intro: alloc_prog_giv_Ensures_lemma [THEN LeadsTo_Basis])
    apply (subgoal_tac "alloc_prog \<squnion> G ∈ Stable ({s∈state. k < length(s`ask) }) ")
    apply (drule PSP_Stable, assumption)
    apply (rule LeadsTo_weaken)
    apply (rule PSP_Stable)
    apply (rule_tac [2] k = k in alloc_prog_giv_Stable_lemma)
    apply (auto simp add: le_iff)
    apply (drule_tac a = "succ (k)" and g1 = length in imp_Increasing_comp [THEN Increasing_imp_Stable])
    apply (rule mono_length)
     prefer 2 apply simp
    apply (simp_all add: refl_prefix Le_def comp_def length_type)
    done

    text{*Lemma 51, page 29.
      This theorem states as invariant that if the number of
      tokens given does not exceed the number returned, then the upper limit
      (@{term NbT}) does not exceed the number currently available.*}
    lemma alloc_prog_Always_lemma:
    "[| G ∈ program; alloc_prog ok G;
        alloc_prog \<squnion> G ∈ Incr(lift(ask));
        alloc_prog \<squnion> G ∈ Incr(lift(rel)) |]
      ==> alloc_prog \<squnion> G ∈
            Always({s∈state. tokens(s`giv) ≤ tokens(take(s`NbR, s`rel)) -->
                    NbT ≤ s`available_tok})"
    apply (subgoal_tac
           "alloc_prog \<squnion> G
              ∈ Always ({s∈state. s`NbR ≤ length(s`rel) } ∩
                        {s∈state. s`available_tok #+ tokens(s`giv) =
                                  NbT #+ tokens(take (s`NbR, s`rel))})")
    apply (rule_tac [2] AlwaysI)
    apply (rule_tac [3] giv_Bounded_lemma2, auto)
    apply (rule Always_weaken, assumption, auto)
    apply (subgoal_tac "0 ≤ tokens(take (x ` NbR, x ` rel)) #- tokens(x`giv) ")
     prefer 2 apply (force)
    apply (subgoal_tac "x`available_tok =
                        NbT #+ (tokens(take(x`NbR,x`rel)) #- tokens(x`giv))")
    apply (simp add: );
    apply (auto split add: nat_diff_split dest: lt_trans2)
    done

    subsubsection{* Main lemmas towards proving property (31)*}

    lemma LeadsTo_strength_R:
        "[|  F ∈ C LeadsTo B'; F ∈ A-C LeadsTo B; B'<=B |] ==> F ∈ A LeadsTo  B"
    by (blast intro: LeadsTo_weaken LeadsTo_Un_Un)

    lemma PSP_StableI:
    "[| F ∈ Stable(C); F ∈ A - C LeadsTo B;
       F ∈ A ∩ C LeadsTo B Un (state - C) |] ==> F ∈ A LeadsTo  B"
    apply (rule_tac A = " (A-C) Un (A ∩ C)" in LeadsTo_weaken_L)
     prefer 2 apply blast
    apply (rule LeadsTo_Un, assumption)
    apply (blast intro: LeadsTo_weaken dest: PSP_Stable)
    done

    lemma state_compl_eq [simp]: "state - {s∈state. P(s)} = {s∈state. ~P(s)}"
    by auto

    (*needed?*)
    lemma single_state_Diff_eq [simp]: "{s}-{x ∈ state. P(x)} = (if s∈state & P(s) then 0 else {s})"
    by auto

    locale alloc_progress =
     fixes G
     assumes Gprog [intro,simp]: "G ∈ program"
         and okG [iff]:          "alloc_prog ok G"
         and Incr_rel [intro]:   "alloc_prog \<squnion> G ∈ Incr(lift(rel))"
         and Incr_ask [intro]:   "alloc_prog \<squnion> G ∈ Incr(lift(ask))"
         and safety:   "alloc_prog \<squnion> G
                          ∈ Always(\<Inter>k ∈ nat. {s∈state. nth(k, s`ask) ≤ NbT})"
         and progress: "alloc_prog \<squnion> G
                          ∈ (\<Inter>k∈nat. {s∈state. k ≤ tokens(s`giv)} LeadsTo
                            {s∈state. k ≤ tokens(s`rel)})"

    (*First step in proof of (31) -- the corrected version from Charpentier.
      This lemma implies that if a client releases some tokens then the Allocator
      will eventually recognize that they've been released.*)
    lemma (in alloc_progress) tokens_take_NbR_lemma:
     "k ∈ tokbag
      ==> alloc_prog \<squnion> G ∈
            {s∈state. k ≤ tokens(s`rel)}
            LeadsTo {s∈state. k ≤ tokens(take(s`NbR, s`rel))}"
    apply (rule single_LeadsTo_I, safe)
    apply (rule_tac a1 = "s`rel" in Increasing_imp_Stable [THEN PSP_StableI])
    apply (rule_tac [4] k1 = "length(s`rel)" in alloc_prog_NbR_LeadsTo_lemma3 [THEN LeadsTo_strength_R])
    apply (rule_tac [8] subset_imp_LeadsTo)
    apply (auto intro!: Incr_rel)
    apply (rule_tac j = "tokens(take (length(s`rel), x`rel))" in le_trans)
    apply (rule_tac j = "tokens(take (length(s`rel), s`rel))" in le_trans)
    apply (auto intro!: tokens_mono take_mono simp add: prefix_iff)
    done

    (*** Rest of proofs done by lcp ***)

    (*Second step in proof of (31): by LHS of the guarantee and transivity of
      LeadsTo *)
    lemma (in alloc_progress) tokens_take_NbR_lemma2:
         "k ∈ tokbag
          ==> alloc_prog \<squnion> G ∈
                {s∈state. tokens(s`giv) = k}
                LeadsTo {s∈state. k ≤ tokens(take(s`NbR, s`rel))}"
    apply (rule LeadsTo_Trans)
     apply (rule_tac [2] tokens_take_NbR_lemma)
     prefer 2 apply assumption
    apply (insert progress)
    apply (blast intro: LeadsTo_weaken_L progress nat_into_Ord)
    done

    (*Third step in proof of (31): by PSP with the fact that giv increases *)
    lemma (in alloc_progress) length_giv_disj:
         "[| k ∈ tokbag; n ∈ nat |]
          ==> alloc_prog \<squnion> G ∈
                {s∈state. length(s`giv) = n & tokens(s`giv) = k}
                LeadsTo
                  {s∈state. (length(s`giv) = n & tokens(s`giv) = k &
                             k ≤ tokens(take(s`NbR, s`rel))) | n < length(s`giv)}"
    apply (rule single_LeadsTo_I, safe)
    apply (rule_tac a1 = "s`giv" in Increasing_imp_Stable [THEN PSP_StableI])
    apply (rule alloc_prog_Increasing_giv [THEN guaranteesD])
    apply (simp_all add: Int_cons_left)
    apply (rule LeadsTo_weaken)
    apply (rule_tac k = "tokens(s`giv)" in tokens_take_NbR_lemma2)
    apply auto
    apply (force dest: prefix_length_le [THEN le_iff [THEN iffD1]])
    apply (simp add: not_lt_iff_le)
    apply (force dest: prefix_length_le_equal)
    done

    (*Fourth step in proof of (31): we apply lemma (51) *)
    lemma (in alloc_progress) length_giv_disj2:
         "[|k ∈ tokbag; n ∈ nat|]
          ==> alloc_prog \<squnion> G ∈
                {s∈state. length(s`giv) = n & tokens(s`giv) = k}
                LeadsTo
                  {s∈state. (length(s`giv) = n & NbT ≤ s`available_tok) |
                            n < length(s`giv)}"
    apply (rule LeadsTo_weaken_R)
    apply (rule Always_LeadsToD [OF alloc_prog_Always_lemma length_giv_disj], auto)
    done

    (*Fifth step in proof of (31): from the fourth step, taking the union over all
      k∈nat *)
    lemma (in alloc_progress) length_giv_disj3:
         "n ∈ nat
          ==> alloc_prog \<squnion> G ∈
                {s∈state. length(s`giv) = n}
                LeadsTo
                  {s∈state. (length(s`giv) = n & NbT ≤ s`available_tok) |
                            n < length(s`giv)}"
    apply (rule LeadsTo_weaken_L)
    apply (rule_tac I = nat in LeadsTo_UN)
    apply (rule_tac k = i in length_giv_disj2)
    apply (simp_all add: UN_conj_eq)
    done

    (*Sixth step in proof of (31): from the fifth step, by PSP with the
      assumption that ask increases *)
    lemma (in alloc_progress) length_ask_giv:
     "[|k ∈ nat;  n < k|]
      ==> alloc_prog \<squnion> G ∈
            {s∈state. length(s`ask) = k & length(s`giv) = n}
            LeadsTo
              {s∈state. (NbT ≤ s`available_tok & length(s`giv) < length(s`ask) &
                         length(s`giv) = n) |
                        n < length(s`giv)}"
    apply (rule single_LeadsTo_I, safe)
    apply (rule_tac a1 = "s`ask" and f1 = "lift(ask)"
           in Increasing_imp_Stable [THEN PSP_StableI])
    apply (rule Incr_ask, simp_all)
    apply (rule LeadsTo_weaken)
    apply (rule_tac n = "length(s ` giv)" in length_giv_disj3)
    apply simp_all
    apply blast
    apply clarify
    apply simp
    apply (blast dest!: prefix_length_le intro: lt_trans2)
    done

    (*Seventh step in proof of (31): no request (ask[k]) exceeds NbT *)
    lemma (in alloc_progress) length_ask_giv2:
         "[|k ∈ nat;  n < k|]
          ==> alloc_prog \<squnion> G ∈
                {s∈state. length(s`ask) = k & length(s`giv) = n}
                LeadsTo
                  {s∈state. (nth(length(s`giv), s`ask) ≤ s`available_tok &
                             length(s`giv) < length(s`ask) & length(s`giv) = n) |
                            n < length(s`giv)}"
    apply (rule LeadsTo_weaken_R)
    apply (rule Always_LeadsToD [OF safety length_ask_giv], assumption+, clarify)
    apply (simp add: INT_iff)
    apply (drule_tac x = "length(x ` giv)" and P = "%x. ?f (x) ≤ NbT" in bspec)
    apply simp
    apply (blast intro: le_trans)
    done

    (*Eighth step in proof of (31): by 50, we get |giv| > n. *)
    lemma (in alloc_progress) extend_giv:
         "[| k ∈ nat;  n < k|]
          ==> alloc_prog \<squnion> G ∈
                {s∈state. length(s`ask) = k & length(s`giv) = n}
                LeadsTo {s∈state. n < length(s`giv)}"
    apply (rule LeadsTo_Un_duplicate)
    apply (rule LeadsTo_cancel1)
    apply (rule_tac [2] alloc_prog_giv_LeadsTo_lemma)
    apply (simp_all add: Incr_ask lt_nat_in_nat)
    apply (rule LeadsTo_weaken_R)
    apply (rule length_ask_giv2, auto)
    done

    (*Ninth and tenth steps in proof of (31): by 50, we get |giv| > n.
      The report has an error: putting |ask|=k for the precondition fails because
      we can't expect |ask| to remain fixed until |giv| increases.*)
    lemma (in alloc_progress) alloc_prog_ask_LeadsTo_giv:
     "k ∈ nat
      ==> alloc_prog \<squnion> G ∈
            {s∈state. k ≤ length(s`ask)} LeadsTo {s∈state. k ≤ length(s`giv)}"
    (* Proof by induction over the difference between k and n *)
    apply (rule_tac f = "λs∈state. k #- length(s`giv)" in LessThan_induct)
    apply (auto simp add: lam_def Collect_vimage_eq)
    apply (rule single_LeadsTo_I, auto)
    apply (rename_tac "s0")
    apply (case_tac "length(s0 ` giv) < length(s0 ` ask) ")
     apply (rule_tac [2] subset_imp_LeadsTo)
      apply (auto simp add: not_lt_iff_le)
     prefer 2 apply (blast dest: le_imp_not_lt intro: lt_trans2)
    apply (rule_tac a1 = "s0`ask" and f1 = "lift (ask)"
           in Increasing_imp_Stable [THEN PSP_StableI])
    apply (rule Incr_ask, simp)
    apply (force)
    apply (rule LeadsTo_weaken)
    apply (rule_tac n = "length(s0 ` giv)" and k = "length(s0 ` ask)"
           in extend_giv)
    apply (auto dest: not_lt_imp_le simp add: leI diff_lt_iff_lt)
    apply (blast dest!: prefix_length_le intro: lt_trans2)
    done

    (*Final lemma: combine previous result with lemma (30)*)
    lemma (in alloc_progress) final:
         "h ∈ list(tokbag)
          ==> alloc_prog \<squnion> G
                ∈ {s∈state. <h, s`ask> ∈ prefix(tokbag)} LeadsTo
                  {s∈state. <h, s`giv> ∈ prefix(tokbag)}"
    apply (rule single_LeadsTo_I)
     prefer 2 apply simp
    apply (rename_tac s0)
    apply (rule_tac a1 = "s0`ask" and f1 = "lift (ask)"
           in Increasing_imp_Stable [THEN PSP_StableI])
       apply (rule Incr_ask)
      apply (simp_all add: Int_cons_left)
    apply (rule LeadsTo_weaken)
    apply (rule_tac k1 = "length(s0 ` ask)"
           in Always_LeadsToD [OF alloc_prog_ask_prefix_giv [THEN guaranteesD]
                                  alloc_prog_ask_LeadsTo_giv])
    apply (auto simp add: Incr_ask)
    apply (blast intro: length_le_prefix_imp_prefix prefix_trans prefix_length_le
                        lt_trans2)
    done

    (** alloc_prog liveness property (31), page 18 **)

    theorem alloc_prog_progress:
    "alloc_prog ∈
        Incr(lift(ask)) ∩ Incr(lift(rel)) ∩
        Always(\<Inter>k ∈ nat. {s∈state. nth(k, s`ask) ≤ NbT}) ∩
        (\<Inter>k∈nat. {s∈state. k ≤ tokens(s`giv)} LeadsTo
                  {s∈state. k ≤ tokens(s`rel)})
      guarantees (\<Inter>h ∈ list(tokbag).
                  {s∈state. <h, s`ask> ∈ prefix(tokbag)} LeadsTo
                  {s∈state. <h, s`giv> ∈ prefix(tokbag)})"
    apply (rule guaranteesI)
    apply (rule INT_I)
    apply (rule alloc_progress.final)
    apply (auto simp add: alloc_progress_def)
    done

    end

lemma available_tok_value_type:

      s ∈ state ==> s ` available_tok ∈ nat

lemma NbR_value_type:

      s ∈ state ==> s ` NbR ∈ nat

lemma alloc_prog_type:

      alloc_prog ∈ program

lemma alloc_prog_ok_iff:

      ∀G∈program.
         alloc_prog ok G <->
         G ∈ preserves(lift(giv)) ∧
         G ∈ preserves(lift(available_tok)) ∧
         G ∈ preserves(lift(NbR)) ∧ alloc_prog ∈ Allowed(G)

lemma alloc_prog_preserves:

      alloc_prog ∈ (\<Inter>x∈var - {giv, available_tok, NbR}. preserves(lift(x)))

lemma alloc_prog_preserves_rel_ask_tok:

      alloc_prog ∈ preserves(lift(rel)) ∩ preserves(lift(ask)) ∩ preserves(lift(tok))

lemma alloc_prog_Allowed:

      Allowed(alloc_prog) =
      preserves(lift(giv)) ∩ preserves(lift(available_tok)) ∩ preserves(lift(NbR))

lemma alloc_prog_ok_client_prog:

      alloc_prog ok client_prog

lemma alloc_prog_Increasing_giv:

      alloc_prog ∈ program guarantees Incr(lift(giv))

lemma giv_Bounded_lamma1:

      alloc_prog ∈
      stable
       ({s ∈ state . s ` NbR ≤ length(s ` rel)} ∩
        {s ∈ state .
         s ` available_tok #+ tokens(s ` giv) =
         NbT #+ tokens(take(s ` NbR, s ` rel))})

lemma giv_Bounded_lemma2:

      [| G ∈ program; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(rel)) |]
      ==> alloc_prog Join G ∈
          Stable
           ({s ∈ state . s ` NbR ≤ length(s ` rel)} ∩
            {s ∈ state .
             s ` available_tok #+ tokens(s ` giv) =
             NbT #+ tokens(take(s ` NbR, s ` rel))})

lemma alloc_prog_giv_Bounded:

      alloc_prog ∈
      Incr(lift(rel)) guarantees
      Always({s ∈ state . tokens(s ` giv) ≤ NbT #+ tokens(s ` rel)})

lemma alloc_prog_ask_prefix_giv:

      alloc_prog ∈
      Incr(lift(ask)) guarantees
      Always({s ∈ state . ⟨s ` giv, s ` ask⟩ ∈ prefix(nat)})

### Towards proving the liveness property, (31)

#### First, we lead up to a proof of Lemma 49, page 28.

lemma alloc_prog_transient_lemma:

      [| G ∈ program; k ∈ nat |]
      ==> alloc_prog Join G ∈
          transient
           ({s ∈ state . k ≤ length(s ` rel)} ∩ {s ∈ state . succ(s ` NbR) = k})

lemma alloc_prog_rel_Stable_NbR_lemma:

      [| G ∈ program; alloc_prog ok G; k ∈ nat |]
      ==> alloc_prog Join G ∈ Stable({s ∈ state . k ≤ succ(s ` NbR)})

lemma alloc_prog_NbR_LeadsTo_lemma:

      [| G ∈ program; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(rel)); k ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . k ≤ length(s ` rel)} ∩ {s ∈ state . succ(s ` NbR) = k} LeadsTo
          {s ∈ state . k ≤ s ` NbR}

lemma alloc_prog_NbR_LeadsTo_lemma2:

      [| G ∈ program; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(rel)); k ∈ nat;
         n ∈ nat; n < k |]
      ==> alloc_prog Join G ∈
          {s ∈ state . k ≤ length(s ` rel)} ∩ {s ∈ state . s ` NbR = n} LeadsTo
          {x ∈ state . k ≤ length(x ` rel)} ∩
          (\<Union>m∈greater_than(n). {x ∈ state . x ` NbR = m})

lemma Collect_vimage_eq:

      u ∈ nat ==> {⟨s, f(s)⟩ . s ∈ A} -`` u = {s ∈ A . f(s) < u}

lemma alloc_prog_NbR_LeadsTo_lemma3:

      [| G ∈ program; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(rel)); k ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . k ≤ length(s ` rel)} LeadsTo {s ∈ state . k ≤ s ` NbR}

#### Towards proving lemma 50, page 29

lemma alloc_prog_giv_Ensures_lemma:

      [| G ∈ program; k ∈ nat; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(ask)) |]
      ==> alloc_prog Join G ∈
          {s ∈ state . nth(length(s ` giv), s ` ask) ≤ s ` available_tok} ∩
          {s ∈ state . k < length(s ` ask)} ∩
          {s ∈ state . length(s ` giv) = k} Ensures
          {s ∈ state . ¬ k < length(s ` ask)} ∪ {s ∈ state . length(s ` giv) ≠ k}

lemma alloc_prog_giv_Stable_lemma:

      [| G ∈ program; alloc_prog ok G; k ∈ nat |]
      ==> alloc_prog Join G ∈ Stable({s ∈ state . k ≤ length(s ` giv)})

lemma alloc_prog_giv_LeadsTo_lemma:

      [| G ∈ program; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(ask)); k ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . nth(length(s ` giv), s ` ask) ≤ s ` available_tok} ∩
          {s ∈ state . k < length(s ` ask)} ∩
          {s ∈ state . length(s ` giv) = k} LeadsTo
          {s ∈ state . k < length(s ` giv)}

lemma alloc_prog_Always_lemma:

      [| G ∈ program; alloc_prog ok G; alloc_prog Join G ∈ Incr(lift(ask));
         alloc_prog Join G ∈ Incr(lift(rel)) |]
      ==> alloc_prog Join G ∈
          Always
           ({s ∈ state .
             tokens(s ` giv) ≤ tokens(take(s ` NbR, s ` rel)) -->
             NbT ≤ s ` available_tok})

#### Main lemmas towards proving property (31)

lemma LeadsTo_strength_R:

      [| F ∈ C LeadsTo B'; F ∈ A - C LeadsTo B; B' ⊆ B |] ==> F ∈ A LeadsTo B

lemma PSP_StableI:

      [| F ∈ Stable(C); F ∈ A - C LeadsTo B; F ∈ A ∩ C LeadsTo B ∪ (state - C) |]
      ==> F ∈ A LeadsTo B

lemma state_compl_eq:

      state - {s ∈ state . P(s)} = {s ∈ state . ¬ P(s)}

lemma single_state_Diff_eq:

      {s} - {x ∈ state . P(x)} = (if s ∈ state ∧ P(s) then 0 else {s})

lemma tokens_take_NbR_lemma:

      [| alloc_progress(G); k ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . k ≤ tokens(s ` rel)} LeadsTo
          {s ∈ state . k ≤ tokens(take(s ` NbR, s ` rel))}

lemma tokens_take_NbR_lemma2:

      [| alloc_progress(G); k ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . tokens(s ` giv) = k} LeadsTo
          {s ∈ state . k ≤ tokens(take(s ` NbR, s ` rel))}

lemma length_giv_disj:

      [| alloc_progress(G); k ∈ nat; n ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . length(s ` giv) = n ∧ tokens(s ` giv) = k} LeadsTo
          {s ∈ state .
           length(s ` giv) = n ∧
           tokens(s ` giv) = k ∧ k ≤ tokens(take(s ` NbR, s ` rel)) ∨
           n < length(s ` giv)}

lemma length_giv_disj2:

      [| alloc_progress(G); k ∈ nat; n ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . length(s ` giv) = n ∧ tokens(s ` giv) = k} LeadsTo
          {s ∈ state .
           length(s ` giv) = n ∧ NbT ≤ s ` available_tok ∨ n < length(s ` giv)}

lemma length_giv_disj3:

      [| alloc_progress(G); n ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . length(s ` giv) = n} LeadsTo
          {s ∈ state .
           length(s ` giv) = n ∧ NbT ≤ s ` available_tok ∨ n < length(s ` giv)}

lemma length_ask_giv:

      [| alloc_progress(G); k ∈ nat; n < k |]
      ==> alloc_prog Join G ∈
          {s ∈ state . length(s ` ask) = k ∧ length(s ` giv) = n} LeadsTo
          {s ∈ state .
           NbT ≤ s ` available_tok ∧
           length(s ` giv) < length(s ` ask) ∧ length(s ` giv) = n ∨
           n < length(s ` giv)}

lemma length_ask_giv2:

      [| alloc_progress(G); k ∈ nat; n < k |]
      ==> alloc_prog Join G ∈
          {s ∈ state . length(s ` ask) = k ∧ length(s ` giv) = n} LeadsTo
          {s ∈ state .
           nth(length(s ` giv), s ` ask) ≤ s ` available_tok ∧
           length(s ` giv) < length(s ` ask) ∧ length(s ` giv) = n ∨
           n < length(s ` giv)}

lemma extend_giv:

      [| alloc_progress(G); k ∈ nat; n < k |]
      ==> alloc_prog Join G ∈
          {s ∈ state . length(s ` ask) = k ∧ length(s ` giv) = n} LeadsTo
          {s ∈ state . n < length(s ` giv)}

lemma alloc_prog_ask_LeadsTo_giv:

      [| alloc_progress(G); k ∈ nat |]
      ==> alloc_prog Join G ∈
          {s ∈ state . k ≤ length(s ` ask)} LeadsTo {s ∈ state . k ≤ length(s ` giv)}

lemma final:

      [| alloc_progress(G); h ∈ list(nat) |]
      ==> alloc_prog Join G ∈
          {s ∈ state . ⟨h, s ` ask⟩ ∈ prefix(nat)} LeadsTo
          {s ∈ state . ⟨h, s ` giv⟩ ∈ prefix(nat)}

theorem alloc_prog_progress:

      alloc_prog ∈
      Incr(lift(ask)) ∩ Incr(lift(rel)) ∩
      Always(\<Inter>k∈nat. {s ∈ state . nth(k, s ` ask) ≤ NbT}) ∩
      (\<Inter>k∈nat.
          {s ∈ state . k ≤ tokens(s ` giv)} LeadsTo
          {s ∈ state . k ≤ tokens(s ` rel)}) guarantees
      (\<Inter>h∈list(nat).
          {s ∈ state . ⟨h, s ` ask⟩ ∈ prefix(nat)} LeadsTo
          {s ∈ state . ⟨h, s ` giv⟩ ∈ prefix(nat)})