theory Next_Key
  imports Heap_Hash_Map
begin

section \<open>A next-key operation for hashmaps\<close>

subsection \<open>Definition and key properties\<close>

definition
  "hm_it_next_key ht = do {
    n\<leftarrow>Array.len (the_array ht);
    if n = 0 then raise (STR ''Map is empty!'')
    else do {
      i\<leftarrow>hm_it_adjust (n - 1) ht;
      l\<leftarrow>Array.nth (the_array ht) i;
      case l of
        [] \<Rightarrow> raise (STR ''Map is empty!'')
      | (x # _) \<Rightarrow> return (fst x)
    }
  }
"

lemma hm_it_next_key_rule:
  "<is_hashmap m ht> hm_it_next_key ht <\<lambda>r. is_hashmap m ht * \<up> (r \<in> dom m)>"
  if "m \<noteq> Map.empty"
  using that
  unfolding hm_it_next_key_def
  unfolding is_hashmap_def unfolding is_hashmap'_def
  apply (sep_auto intro: hm_it_adjust_rule)
  subgoal
    using le_imp_less_Suc by fastforce
  subgoal premises prems for l xs i xs'
  proof -
    from prems have "l ! i \<noteq> []"
      by (auto simp: concat_take_Suc_empty)
    with prems(1-6) show ?thesis
      apply (cases xs')
       apply sep_auto
      apply sep_auto
      subgoal for a b list aa ba
        apply (rule weak_map_of_SomeI[of _ b])
        apply clarsimp
        apply (rule bexI[of _ "l ! i"])
        subgoal
          by (metis list.set_intros(1))
        subgoal
          by (cases "length l"; fastforce simp: take_Suc_conv_app_nth)
        done
      done
  qed
  done

definition
  "next_key m = do {
    ASSERT (m \<noteq> Map.empty);
    k \<leftarrow> SPEC (\<lambda> k. k \<in> dom m);
    RETURN k
  }
  "

lemma hm_it_next_key_next_key_aux:
  assumes "is_pure K" "nofail (next_key m)"
  shows
    "<hm.assn K V m mi>
      hm_it_next_key mi
    <\<lambda>r. \<exists>\<^sub>Axa. hm.assn K V m mi * K xa r * true * \<up> (RETURN xa \<le> next_key m)>"
  using \<open>nofail _\<close> unfolding next_key_def
  apply (simp add: pw_bind_nofail pw_ASSERT(1))
  unfolding hm.assn_def hr_comp_def
  apply sep_auto
  subgoal for m'
    apply (rule cons_post_rule)
     apply (rule hm_it_next_key_rule)
     defer
     apply (sep_auto eintros del: exI)
    subgoal premises prems for x v'
    proof -
      from prems obtain k v where "m k = Some v" "(x, k) \<in> the_pure K" "(v', v) \<in> the_pure V"
        apply atomize_elim
        by (meson map_rel_obtain2)
      with prems \<open>is_pure K\<close> show ?thesis
        apply -
        apply (rule exI[where x = k], rule exI[where x = m'])
        apply sep_auto
        apply (rule entailsI)
        apply sep_auto
        by (metis mod_pure_star_dist mod_star_trueI pure_def pure_the_pure)
    qed
    by force
  done

lemma hm_it_next_key_next_key:
  assumes "CONSTRAINT is_pure K"
  shows "(hm_it_next_key, next_key) \<in> (hm.assn K V)\<^sup>k \<rightarrow>\<^sub>a K"
  using assms by sepref_to_hoare (sep_auto intro!: hm_it_next_key_next_key_aux)

lemma hm_it_next_key_next_key':
  "(hm_it_next_key, next_key) \<in> (hm.hms_assn V)\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding hm.hms_assn_def
  apply sepref_to_hoare
  apply sep_auto
  unfolding next_key_def
  apply (simp add: refine_pw_simps)
  subgoal for m m' mi
    apply (rule cons_rule[where
          P' = "is_hashmap mi m' * map_assn V m mi * \<up>(mi \<noteq> Map.empty)"
          and Q = "\<lambda> x. is_hashmap mi m' * \<up> (x \<in> dom mi) * map_assn V m mi"]
        )
      apply (sep_auto; unfold map_assn_def; auto; fail)+
    by (rule norm_pre_pure_rule1, rule frame_rule[OF hm_it_next_key_rule[of mi m']]) sep_auto
  done

lemma no_fail_next_key_iff:
  "nofail (next_key m) \<longleftrightarrow> m \<noteq> Map.empty"
  unfolding next_key_def by auto

context
  fixes mi m K
  assumes map_rel: "(mi, m) \<in> \<langle>K, Id\<rangle>map_rel"
begin

private lemma k_aux:
  assumes "k \<in> dom mi" "(mi, m) \<in> \<langle>K, Id\<rangle>map_rel"
  shows "\<exists> k'. (k, k') \<in> K"
  using assms unfolding map_rel_def by auto

private lemma k_aux2:
  assumes "k \<in> dom mi" "(k, k') \<in> K"
  shows "k' \<in> dom m"
  using assms map_rel unfolding map_rel_def by (cases "m k'") (auto dest: fun_relD)

private lemma map_empty_iff: "mi \<noteq> Map.empty \<longleftrightarrow> m \<noteq> Map.empty"
  using map_rel by auto

private lemma aux:
  assumes "RETURN k \<le> next_key mi"
  shows "RETURN (SOME k'. (k, k') \<in> K) \<le> next_key m"
  using map_rel assms
  unfolding next_key_def
  apply (cases "m \<noteq> Map.empty")
   apply (clarsimp simp: map_empty_iff)
  apply (frule (1) k_aux[OF domI])
  apply (drule someI_ex)
  apply (auto dest: k_aux2[OF domI])
  done

private lemma aux1:
  assumes "RETURN k \<le> next_key mi" "nofail (next_key m)"
  shows "(k, SOME k'. (k, k') \<in> K) \<in> K"
  using map_rel assms
  unfolding next_key_def
  apply (cases "m \<noteq> Map.empty")
   apply (auto simp: map_empty_iff)
  apply (drule (1) k_aux[OF domI], erule someI_ex)
  done

lemmas hm_it_next_key_next_key''_aux = aux aux1

end (* Anonymous context *)

lemma hm_it_next_key_next_key'':
  assumes "is_pure K"
  shows "(hm_it_next_key, next_key) \<in> (hm.hms_assn' K V)\<^sup>k \<rightarrow>\<^sub>a K"
  unfolding hm.hms_assn'_def
  apply sepref_to_hoare
  unfolding hr_comp_def
  apply sep_auto
  subgoal for m m' mi
    using hm_it_next_key_next_key'[to_hnr, unfolded hn_refine_def, of mi V m']
    apply (sep_auto simp: hn_ctxt_def)
    subgoal
      unfolding no_fail_next_key_iff by auto
    apply (erule cons_post_rule)
    using \<open>is_pure K\<close>
    apply sep_auto
     apply (erule (1) hm_it_next_key_next_key''_aux)
    apply (subst pure_the_pure[symmetric, of K], assumption)
    apply (sep_auto intro: hm_it_next_key_next_key''_aux simp: pure_def)
    done
  done

subsection \<open>Computing the range of a map\<close>

definition ran_of_map where
  "ran_of_map m \<equiv> do
      {
        (xs, m) \<leftarrow> WHILEIT
          (\<lambda> (xs, m'). finite (dom m') \<and> ran m = ran m' \<union> set xs) (\<lambda> (_, m). Map.empty \<noteq> m)
            (\<lambda> (xs, m). do
              {
                k \<leftarrow> next_key m;
                let (x, m) = op_map_extract k m;
                ASSERT (x \<noteq> None);
                RETURN (the x # xs, m)
              }
            )
            ([], m);
        RETURN xs
      }
  "

context
begin

private definition
  "ran_of_map_var = (inv_image (measure (card o dom)) (\<lambda> (a, b). b))"

private lemma wf_ran_of_map_var:
  "wf ran_of_map_var"
  unfolding ran_of_map_var_def by auto

(* XXX Maybe move *)
private lemma insert_restrict_ran:
  "insert v (ran (m |` (- {k}))) = ran m " if "m k = Some v"
  using that unfolding ran_def restrict_map_def by force

lemma ran_of_map_correct[refine]:
  "ran_of_map m \<le> SPEC (\<lambda> r. set r = ran m)" if "finite (dom m)"
  using that unfolding ran_of_map_def next_key_def
  apply (refine_vcg wf_ran_of_map_var)
         apply (clarsimp; fail)+
  subgoal for s xs m' x v xs' xs1 xs'1
    unfolding dom_def by (clarsimp simp: map_upd_eq_restrict, auto dest: insert_restrict_ran)
  subgoal
    unfolding ran_of_map_var_def op_map_extract_def by (fastforce intro: card_Diff1_less)
  by auto

end \<comment> \<open>End of private context for auxiliary facts and definitions\<close>

sepref_register next_key :: "(('b, 'a) i_map \<Rightarrow> 'b nres)"

definition (in imp_map_is_empty) [code_unfold]: "hms_is_empty \<equiv> is_empty"

lemma (in imp_map_is_empty) hms_empty_rule [sep_heap_rules]:
  "<hms_assn A m mi> hms_is_empty mi <\<lambda>r. hms_assn A m mi * \<up>(r \<longleftrightarrow> m=Map.empty)>\<^sub>t"
  unfolding hms_is_empty_def hms_assn_def map_assn_def by sep_auto

context imp_map_is_empty
begin

lemma hms_is_empty_hnr[sepref_fr_rules]:
  "(hms_is_empty, RETURN o op_map_is_empty) \<in> (hms_assn A)\<^sup>k \<rightarrow>\<^sub>a bool_assn"
  by sepref_to_hoare sep_auto

sepref_decl_impl is_empty: hms_is_empty_hnr uses op_map_is_empty.fref[where V = Id] .

end

lemma (in imp_map) hms_assn'_id_hms_assn:
  "hms_assn' id_assn A = hms_assn A"
  by (subst hms_assn'_def) simp

(* This is to make the pre-processing phase pick the right type for the input *)
lemma [intf_of_assn]:
  "intf_of_assn (hm.hms_assn' a b) TYPE(('aa, 'bb) i_map)"
  by simp

context
  fixes K :: "_ \<Rightarrow> _ :: {hashable, heap} \<Rightarrow> assn"
  assumes is_pure_K[safe_constraint_rules]: "is_pure K"
  and left_unique_K[safe_constraint_rules]: "IS_LEFT_UNIQUE (the_pure K)"
  and right_unique_K[safe_constraint_rules]: "IS_RIGHT_UNIQUE (the_pure K)"
  notes [sepref_fr_rules] = hm_it_next_key_next_key''[OF is_pure_K]
begin

sepref_definition ran_of_map_impl is
  "ran_of_map" :: "(hm.hms_assn' K A)\<^sup>d \<rightarrow>\<^sub>a list_assn A"
  unfolding ran_of_map_def hm.hms_assn'_id_hms_assn[symmetric]
  unfolding op_map_is_empty_def[symmetric]
  unfolding hm.hms_fold_custom_empty HOL_list.fold_custom_empty
  by sepref

end (* Anonymous context for setup *)

lemmas ran_of_map_impl_code[code] =
  ran_of_map_impl_def[of "pure Id", simplified, OF Sepref_Constraints.safe_constraint_rules(41)]

context
  notes [sepref_fr_rules] = hm_it_next_key_next_key'[folded hm.hms_assn'_id_hms_assn]
begin

sepref_definition ran_of_map_impl' is
  "ran_of_map" :: "(hm.hms_assn A)\<^sup>d \<rightarrow>\<^sub>a list_assn A"
  unfolding ran_of_map_def hm.hms_assn'_id_hms_assn[symmetric]
  unfolding op_map_is_empty_def[symmetric]
  unfolding hm.hms_fold_custom_empty HOL_list.fold_custom_empty
  by sepref

end (* Anonymous context for setup *)

end (* Theory *)


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                   July 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_SKIP_DIV
imports CSP_F_law_SKIP CSP_F_law_DIV CSP_T_law_SKIP_DIV
begin

(*********************************************************
                   (SKIP [+] DIV)
 *********************************************************)

lemma cspF_SKIP_DIV_Ext_choice1: "(SKIP [+] DIV) =F[M1,M2] SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_DIV_Ext_choice)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

(*********************************************************
                   (DIV [+] SKIP)
 *********************************************************)

lemma cspF_SKIP_DIV_Ext_choice2: "(DIV [+] SKIP) =F[M1,M2] SKIP"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_SKIP_DIV_Ext_choice1)
done

lemmas cspF_SKIP_DIV_Ext_choice =
       cspF_SKIP_DIV_Ext_choice1
       cspF_SKIP_DIV_Ext_choice2

(*********************************************************
                    SKIP |[X]| DIV
 *********************************************************)

lemma cspF_SKIP_DIV_Parallel1:
   "SKIP |[X]| DIV =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_DIV_Parallel1)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
done

lemma cspF_SKIP_DIV_Parallel2:
   "DIV |[X]| SKIP =F[M1,M2] DIV"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Parallel1)
apply (rule cspF_reflex)
done

lemmas cspF_SKIP_DIV_Parallel =
       cspF_SKIP_DIV_Parallel1
       cspF_SKIP_DIV_Parallel2
       cspF_Parallel_term
       cspF_DIV_Parallel

(*********************************************************
                 DIV and Parallel-SKIP
 *********************************************************)

(*********************************************************
                      SKIP and Parallel
 *********************************************************)

(*** SKIP and DIV ***)

lemma cspF_DIV_Parallel_Ext_choice_SKIP_l:
  "(P [+] SKIP) |[X]| DIV =F[M,M] (P |[X]| DIV)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Parallel_Ext_choice_SKIP_l)
apply (rule order_antisym)
apply (rule, simp add: in_failures)+
done

lemma cspF_DIV_Parallel_Ext_choice_SKIP_r:
  "DIV |[X]| (P [+] SKIP) =F[M,M] (DIV |[X]| P)"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_DIV_Parallel_Ext_choice_SKIP_l)
apply (rule cspF_commut)
done

lemmas cspF_DIV_Parallel_Ext_choice_SKIP =
       cspF_DIV_Parallel_Ext_choice_SKIP_l
       cspF_DIV_Parallel_Ext_choice_SKIP_r

lemmas cspF_DIV_Parallel_Ext_choice =
       cspF_DIV_Parallel_Ext_choice_SKIP
       cspF_DIV_Parallel_Ext_choice_DIV

(*********************************************************
                 SKIP and Parallel-DIV
 *********************************************************)

(*** DIV and SKIP ***)

lemma cspF_SKIP_Parallel_Ext_choice_DIV_l:
  "((? :Y -> Pf) [+] DIV) |[X]| SKIP =F[M,M]
   (? x:(Y - X) -> (Pf x |[X]| SKIP)) [+] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Parallel_Ext_choice_DIV_l)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (simp add: par_tr_nil_right)
  apply (elim conjE)
  apply (simp add: image_iff)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp add: par_tr_nil_right)

  apply (simp add: par_tr_Tick_right)
  apply (elim conjE)
  apply (simp add: image_iff)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp add: par_tr_Tick_right)

  apply (simp add: in_traces)

(* <= *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (simp add: in_traces)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp add: par_tr_nil_right)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp add: par_tr_nil_right)
  apply (simp add: image_iff)
  apply (fast)

  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp add: par_tr_Tick_right)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp add: par_tr_Tick_right)
  apply (simp add: image_iff)
  apply (fast)

  apply (simp add: in_traces)
  apply (simp add: in_traces)
done

lemma cspF_SKIP_Parallel_Ext_choice_DIV_r:
  "SKIP |[X]| ((? :Y -> Pf) [+] DIV) =F[M,M]
   (? x:(Y - X) -> (SKIP |[X]| Pf x)) [+] DIV"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_Parallel_Ext_choice_DIV_l)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_commut)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
done

lemmas cspF_SKIP_Parallel_Ext_choice_DIV =
       cspF_SKIP_Parallel_Ext_choice_DIV_l
       cspF_SKIP_Parallel_Ext_choice_DIV_r

lemmas cspF_SKIP_Parallel_Ext_choice =
       cspF_SKIP_Parallel_Ext_choice_SKIP
       cspF_SKIP_Parallel_Ext_choice_DIV

(*---------------------------------------------*
 |                 SKIP , DIV                  |
 *---------------------------------------------*)

lemmas cspF_SKIP_DIV_Parallel_step =
       cspF_Parallel_preterm
       cspF_DIV_Parallel_step

lemmas cspF_SKIP_DIV_Parallel_Ext_choice =
       cspF_SKIP_Parallel_Ext_choice
       cspF_DIV_Parallel_Ext_choice

lemmas cspF_SKIP_DIV_Hiding_Id =
       cspF_SKIP_Hiding_Id
       cspF_DIV_Hiding_Id

lemmas cspF_SKIP_DIV_Hiding_step =
       cspF_DIV_Hiding_step
       cspF_SKIP_Hiding_step

lemmas cspF_SKIP_DIV_Renaming_Id =
       cspF_SKIP_Renaming_Id
       cspF_DIV_Renaming_Id

lemmas cspF_SKIP_DIV_Seq_compo =
       cspF_Seq_compo_unit
       cspF_DIV_Seq_compo

lemmas cspF_SKIP_DIV_Seq_compo_step =
       cspF_SKIP_Seq_compo_step
       cspF_DIV_Seq_compo_step

lemmas cspF_SKIP_DIV_Depth_rest =
       cspF_SKIP_Depth_rest
       cspF_DIV_Depth_rest

lemmas cspF_SKIP_DIV =
       cspF_SKIP_DIV_Parallel_step
       cspF_SKIP_DIV_Ext_choice
       cspF_SKIP_DIV_Parallel
       cspF_SKIP_DIV_Parallel_Ext_choice
       cspF_SKIP_DIV_Hiding_Id
       cspF_SKIP_DIV_Hiding_step
       cspF_SKIP_DIV_Renaming_Id
       cspF_SKIP_DIV_Seq_compo
       cspF_SKIP_DIV_Seq_compo_step
       cspF_SKIP_DIV_Depth_rest

(*** resolve ***)

lemmas cspF_Ext_choice_SKIP_DIV_resolve =
       cspF_Ext_choice_SKIP_resolve
       cspF_Ext_choice_DIV_resolve

(*----------------------------------------------*
 |                                              |
 |        for convenienve  (SKIP or DIV)        |
 |                                              |
 *----------------------------------------------*)

(*********************************************************
            (SKIP or DIV [+] SKIP or DIV)
 *********************************************************)

lemma cspF_SKIP_or_DIV_Ext_choice:
  "[| P = SKIP | P = DIV ; Q = SKIP | Q = DIV |] ==>
   (P [+] Q) =F[M1,M2] (if (P = SKIP | Q = SKIP) then SKIP else DIV)"
apply (elim disjE)
apply (simp_all)
apply (rule cspF_rw_left)
apply (rule cspF_Ext_choice_idem)
apply (simp)
apply (simp add: cspF_SKIP_DIV)
apply (simp add: cspF_SKIP_DIV)
apply (rule cspF_rw_left)
apply (rule cspF_Ext_choice_idem)
apply (simp)
done

(*********************************************************
            (SKIP or DIV |[X]| SKIP or DIV)
 *********************************************************)

lemma cspF_SKIP_or_DIV_Parallel:
  "[| P = SKIP | P = DIV ; Q = SKIP | Q = DIV |] ==>
   (P |[X]| Q) =F[M1,M2] (if (P = SKIP & Q = SKIP) then SKIP else DIV)"
apply (elim disjE)
apply (simp_all add: cspF_SKIP_DIV)
done

(*********************************************************
                  (SKIP or DIV) and Hiding
 *********************************************************)

lemma cspF_SKIP_or_DIV_Hiding_step:
  "Q = SKIP | Q = DIV ==>
   ((? :Y -> Pf) [+] Q) -- X =F[M,M]
   (((? x:(Y-X) -> (Pf x -- X)) [+] Q) |~| (! x:(Y Int X) .. (Pf x -- X)))"
apply (erule disjE)
apply (simp_all add: cspF_SKIP_DIV)
done

(*********************************************************
                  SKIP or DIV |. Suc n
 *********************************************************)

lemma cspF_SKIP_or_DIV_Depth_rest:
   "Q = SKIP | Q = DIV ==> Q |. (Suc n) =F[M1,M2] Q"
apply (erule disjE)
apply (simp_all add: cspF_SKIP_DIV)
done

(*********************************************************
                    P [+] (SKIP or DIV)
 *********************************************************)

lemma cspF_Ext_choice_SKIP_or_DIV_resolve:
  "Q = SKIP | Q = DIV ==> P [+] Q =F[M,M] P [> Q"
apply (erule disjE)
apply (simp_all add: cspF_Ext_choice_SKIP_DIV_resolve)
done

lemmas cspF_SKIP_or_DIV =
       cspF_SKIP_or_DIV_Ext_choice
       cspF_SKIP_or_DIV_Parallel
       cspF_SKIP_or_DIV_Hiding_step
       cspF_SKIP_or_DIV_Depth_rest

       (* no resolv *)

end


(*<*)
theory Everything
imports DenotationalEquivalences Correctness  "Correctness-Counterexample" "~~/src/HOL/Library/LaTeXsugar"
begin

(*
notation (latex output) DenotationalUpd.ESem ("\<lbrakk>_\<rbrakk>\<^bsup>u\<^esup>\<^bsub>_\<^esub>"  [60,60] 60)
notation (latex output) "Denotational-PropsUpd.HSem_syn" ("\<lbrace>_\<rbrace>\<^bsup>u\<^esup>_"  [60,60] 60)
*)

translations
  "xs" <= "CONST set xs"
translations
  "xs" <= "CONST asToHeap xs"
translations
  "a" <= "CONST atom a"

lemma Terms:
  "\<exists> x assn e'. (e = (Lam [x]. e') \<or> (e = Var x) \<or> (e = App e' x) \<or> (e = Let assn e'))"
  by (metis Terms.exp_assn.exhaust(1))
lemma expressions_grammar:
"(\<forall> var. y = Var var \<longrightarrow> P) \<longrightarrow>
(\<forall> exp var. y = App exp var \<longrightarrow> P) \<longrightarrow>
(\<forall> assn exp. y = Terms.Let assn exp \<longrightarrow> P) \<longrightarrow> (\<forall> var exp. y = Lam [var]. exp \<longrightarrow> P) \<longrightarrow> P"
  by (metis exp_assn.exhaust(1))

abbreviation (Grammar output)
  "grammar_imp"
where
  "grammar_imp \<equiv> op \<longrightarrow>"

syntax (Grammar output)
  "_grapats" :: "term \<Rightarrow> term \<Rightarrow> term" ("_ | _")
  "_grafirst" :: "term \<Rightarrow> term \<Rightarrow> term" ("_ ::= _")
  "_grarest" :: "term \<Rightarrow> term \<Rightarrow> term"
  "_firsteq" :: "term \<Rightarrow> term \<Rightarrow> term"
  "_resteq" :: "term \<Rightarrow> term \<Rightarrow> term"

translations
  "_grapats (_firsteq all) (_grarest (CONST grammar_imp rest1 rest2))" <= "CONST grammar_imp all (CONST grammar_imp rest1 rest2)"
  "_grapats (_resteq all) (_grarest (CONST grammar_imp rest1 rest2))" <= "_grarest (CONST grammar_imp all (CONST grammar_imp rest1 rest2))"
  "_resteq all" <= "_grarest (CONST grammar_imp all rest)"
  "_resteq all" <= "_resteq (CONST grammar_imp all rest)"
  "_firsteq all" <= "_firsteq (CONST grammar_imp all rest)"
  "_firsteq imp" <= "_firsteq (ALL x. imp)"
  "_resteq imp" <= "_resteq (ALL x. imp)"
  "_grafirst x t" <= "_firsteq (x = t)"
  "t" <= "_resteq (x = t)"

(*
thm expressions_grammar[no_vars]
thm (Grammar) expressions_grammar[no_vars]
thm (latex) expressions_grammar[no_vars]
thm (latex Grammar) expressions_grammar[no_vars]
*)

declare [[names_short]]

(*>*)
subsection {* Main definitions and theorems *}

text {*
For your convenience, the main definitions and theorems of the present work are assembled in this section. The following
formulas are mechanically pretty-printed versions of the statements as defined resp.\ proven in Isabelle.
Free variables are all-quantified. Some type conversion functions (like @{term_type set}) are omitted.
The relations @{text \<sharp>} and @{text "\<sharp>*"} come from the Nominal package and express freshness of the
variables on the left with regard to the expressions on the right.

\input{map.tex}
*}

subsubsection {* Expressions *}

text {*
The type @{typ var} of variables is abstract and provided by the Nominal package. All we know about
it is that it is countably infinite.
Expressions of type @{typ exp} are given by the following grammar:
\begin{alignatstar}{2}
@{term e} \Coloneqq {}& @{term "Lam [x]. e"} &\quad& \text{lambda abstraction}\\
\mid {} & @{term "App e x"} && \text{application}\\
\mid {} & @{term "Var x"} && \text{variable} \\
\mid {} & @{term "Let as e"} && \text{recursive let}
\end{alignatstar}
In the introduction we pretty-print expressions to match the notation in \cite{launchbury} and omit
the constructor names @{term Var}, @{term App}, @{text Lam} and @{term Let}. In the actual theories, these are visible.
These expressions are, due to the machinery of the Nominal package, actually alpha-equivalency classes, so @{thm alpha_test[no_vars]} holds provably. This differs from Launchbury's original definition, which expects distinctly-named expressions and performs explicit alpha-renaming in the semantics.

The type @{type heap} is an abbreviation for @{typ "(var \<times> exp) list"}. These are \emph{not} alpha-equivalency classes, i.e.\ we manage the bindings in heaps explicitly.
*}

subsubsection {* The natural semantics *}

text_raw {*
\newlength{\rulelen}
\setlength{\rulelen}{\linewidth}
\newlength{\rulenamelen}
\settowidth{\rulenamelen}{~{\sc Application}}
\addtolength{\rulelen}{-\rulenamelen}
*}

text {*
Launchbury's original semantics, extended with some technical overhead related to name binding,
is defined as follows:\\
%\begin{center}
\parbox[t]{\rulelen}{\centering@{thm[mode=Axiom] Launchbury.reds.Lambda[no_vars]}}~{\sc Lambda}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] Launchbury.reds.Application[no_vars]}}~{\sc Application}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] Launchbury.reds.Variable[no_vars]}}~{\sc Variable}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] Launchbury.reds.Let[no_vars]}}~{\sc Let}
%\end{center}
*}

subsubsection {* The stacked semantics *}

text {*
This is our modified semantics that allows the correctness theorem to go through without generalisation:\\
\parbox[t]{\rulelen}{\centering@{thm[mode=Axiom] LaunchburyStacked.reds.Lambda[no_vars]}}~{\sc Lambda}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] LaunchburyStacked.reds.Application[no_vars]}}~{\sc Application}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] LaunchburyStacked.reds.Variable[no_vars]}}~{\sc Variable}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] LaunchburyStacked.reds.Let[no_vars]}}~{\sc Let}
*}
subsubsection {* The denotational semantics *}

text {*
The value domain of the denotational semantics is the initial solution to
\[
D = [D \to D]_\bot
\]
as introduced in \cite{abramsky}. The type @{typ Value}, together with the bottom value @{term_type "\<bottom>::Value"}, the
injection @{term_type "Fn"} and the projection @{term "DUMMY \<down>Fn DUMMY"}@{text "::"}@{typeof "Fn_project"},
is constructed as a pointed chain-complete partial order from this equation by the HOLCF package.
The type of semantic environments, @{typ Env}, is an abbreviation for @{typ "var f\<rightharpoonup> Value"}.

The semantics of an expression @{term_type "e :: exp"} in an environment @{term "\<rho>"}@{text "::"}@{typ Env} is
written \mbox{@{term_type "Rep_cfun (Denotational.ESem e) \<rho>"}} and defined by the following equations:
\begin{alignstar}
@{thm (lhs) Denotational.ESem.simps(1)[no_vars]} & = @{thm (rhs) Denotational.ESem.simps(1)[no_vars]} \\
@{thm (lhs) Denotational.ESem.simps(2)[no_vars]} & = @{thm (rhs) Denotational.ESem.simps(2)[no_vars]} \\
@{thm (lhs) Denotational.ESem.simps(3)[no_vars]} & = @{thm (rhs) Denotational.ESem.simps(3)[no_vars]} \\
@{thm (lhs) Denotational.ESem.simps(4)[no_vars]} & = @{thm (rhs) Denotational.ESem.simps(4)[no_vars]}.
\end{alignstar}
*}

text {*
We study two alternatives for the semantics @{term "Rep_cfun (Denotational.HSem \<Gamma>) \<rho>"}@{text "::"}@{typ Env} of a
heap @{term "\<Gamma> :: heap"}@{text "::"}@{typ heap}
in an environment @{term "\<rho>"}@{text "::"}@{typ Env}. As this is used in denotations of a Let expression,
we have also two expression semantics. Their defining equations are, besides the choice of heap semantics, identical.

The first involves a least upper bound ($\sqcup$) and is defined by the recursive equation
\[ @{thm (concl) Denotational.HSem_eq[no_vars]}, \]
where the set in the index position indicates the expansion of the map to the given domain and
@{term "heapToEnv:: heap \<Rightarrow> (exp \<Rightarrow> Value) \<Rightarrow> Env"}@{text "::"}@{typ "heap \<Rightarrow> (exp \<Rightarrow> Value) \<Rightarrow> Env"}
maps the given expression semantics over the heap, producing a semantic environment.

The other, here shown with a superscript @{text "u"}, uses the right-sided update operator @{text "f++"}
and is defined by the recursive equation
\[ @ {thm "Denotational-PropsUpd.UHSem_eq"[no_vars]}. \]

The semantics of the heap in the empty environment @{term "fempty"} is abbreviated as @ {abbrev "HSem_fempty \<Gamma>"}.

It is worth noting that the two semantics agree on expressions, i.e. @ {thm UHSem_join_update(1)[no_vars] },
but obviously not on heaps that bind variables that also occur in the environment.
*}

subsubsection {* Equivalences *}
text {*
The stacked semantics is equivalent to the original semantics in the following sense:
\begin{itemize}
\item If @{thm[mode=IfThen] (prem 1) forget_stack_nice[no_vars] } is derivable in the stacked semantics,
and @{term L} is chosen such that @{thm[mode=IfThen] (prem 2) forget_stack_nice[no_vars]} holds, then
 @{thm[mode=IfThen] (concl) forget_stack_nice[no_vars]} is derivable in the original semantics.
\item If @{thm[mode=IfThen] (prem 1) add_stack[no_vars]} is derivable in the original semantics and
@{term "x"} and @{term "\<Gamma>'"} are chosen such that @{thm[mode=IfThen] (prem 2) add_stack[no_vars]} and
@{thm[mode=IfThen] (prem 3) add_stack[no_vars]} holds, then  @{thm[mode=IfThen] (concl) add_stack[no_vars]}
is derivable in the stacked semantics.
\end{itemize}
*}

subsubsection {* Correctness *}
text {* The statement of correctness for the stacked semantics reads:
If @{thm [mode=IfThen] (prem 1) CorrectnessStacked.correctness[no_vars]} and, as a side condition,
@{thm [mode=IfThen] (prem 2) CorrectnessStacked.correctness[no_vars]} holds, then @{thm [mode=IfThen] (concl) CorrectnessStacked.correctness(1)[no_vars]}. *}

text {* By the stated equivalency, we obtain the correctness of the original semantics:
If \mbox{@{thm [mode=IfThen] (prem 1) Correctness.correctness(1)[no_vars]}} and, as a side condition,
@{thm [mode=IfThen] (prem 2) Correctness.correctness(1)[no_vars]} holds, then @{thm [mode=IfThen] (concl) Correctness.correctness(1)[no_vars]} and
 @{thm [mode=IfThen] (concl) Correctness.correctness(2)[no_vars]} *}

text {* The generalization introduced by Launchbury is true if the update-based semantics is chosen:
If @ {thm [mode=IfThen] (prem 1) CorrectnessUpd.correctness(1)[no_vars]} and, as a side condition,
@ {thm [mode=IfThen] (prem 2) CorrectnessUpd.correctness(1)[no_vars]} and
\mbox{@ {thm [mode=IfThen] (prem 3) CorrectnessUpd.correctness(1)[no_vars]}} hold,
then @ {thm [mode=IfThen] (concl) CorrectnessUpd.correctness(1)[no_vars]} and  @ {thm [mode=IfThen] (concl) CorrectnessUpd.correctness(2)[no_vars]}. *}

(*<*)

end
(*>*)


theory Lift_Option
  imports "../Lifter"
begin

(*
 * option
 *)
definition option_l ::
  "('x, 'a, 'b) lifting \<Rightarrow> ('x, 'a, 'b option) lifting" where
"option_l t =
    LMake (\<lambda> s a b .
              (case b of
                Some b' \<Rightarrow> Some (LUpd t s a b')
                | None \<Rightarrow> Some (LUpd t s a (LBase t s))))
            (\<lambda> s b . (case b of Some b' \<Rightarrow> LOut t s b'
                        | None \<Rightarrow> LOut t s (LBase t s)))
            (\<lambda> s . None)"

definition option_l_S :: "('s, 'b) valid_set \<Rightarrow> ('s, 'b option) valid_set" where
"option_l_S S s = (Some ` S s)"

(* TODO: clean up mergeable instances so that we are consistently using Weakb instances
   where needed. *)
locale option_l_valid_weak = lifting_valid_weak

sublocale option_l_valid_weak \<subseteq> out : lifting_valid_weak "option_l l" "option_l_S S"
proof

  fix s a b
  show "LOut (option_l l) s (LUpd (option_l l) s a b) = a"
    using put_get
    by(auto simp add:option_l_def split:option.splits)
next
  fix s b
  assume Hb : "b \<in> option_l_S S s"
  thus "b <[ LUpd (option_l l) s (LOut (option_l l) s b) b"
    using get_put_weak
    by(auto simp add:option_l_def option_l_S_def option_pleq split:option.splits)
next
  fix s :: 'a
  fix a
  fix b :: "'c option"
  show "LUpd (option_l l) s a b \<in> option_l_S S s"
    using put_S
    by(auto simp add: option_l_def option_l_S_def split:option.splits)
qed

lemma (in option_l_valid_weak) ax :
  shows "lifting_valid_weak (option_l l) (option_l_S S)"
  using out.lifting_valid_weak_axioms
    by auto

lemma (in option_l_valid_weak) ax_g :
  assumes "S' = option_l_S S"
  shows "lifting_valid_weak (option_l l) S'"
  using out.lifting_valid_weak_axioms assms
  by auto

locale option_l_valid_base_ext = lifting_sig

sublocale option_l_valid_base_ext \<subseteq> out : lifting_valid_base_ext "option_l l" "option_l_S S"
proof
  fix s
  show "LBase (option_l l) s = \<bottom>"
    by(auto simp add: option_l_def option_bot)
qed

lemma (in option_l_valid_base_ext) ax :
  shows "lifting_valid_base_ext (option_l l)"
  using out.lifting_valid_base_ext_axioms by auto

(*
locale option_l_valid_weak_base = option_l_valid_weak + option_l_valid_base_ext

sublocale option_l_valid_weak_base \<subseteq> out: lifting_valid_weak_base "option_l l" "option_l_S S"
proof
qed

lemma (in option_l_valid_weak_base) ax :
  shows "lifting_valid_weak_base (option_l l) (option_l_S S)"
  using out.lifting_valid_weak_base_axioms
    by auto

lemma (in option_l_valid_weak_base) ax_g :
  assumes "S' = option_l_S S"
  shows "lifting_valid_weak_base (option_l l) S'"
  using out.lifting_valid_weak_base_axioms assms
  by auto
*)

locale option_l_valid_ext = lifting_valid_ext

sublocale option_l_valid_ext \<subseteq> out : lifting_valid_ext "option_l l" "option_l_S S"
proof
  fix s a b
  (*assume "b \<in> option_l_S S s"*)
  show "b <[ LUpd (option_l l) s a b"
    using get_put
    by(auto simp add:option_l_def option_l_S_def LNew_def option_pleq split:option.splits)
qed

lemma (in option_l_valid_ext) ax :
  shows "lifting_valid_ext (option_l l)"
  using out.lifting_valid_ext_axioms
    by auto

locale option_l_valid_ok_ext = lifting_valid_ok_ext

sublocale option_l_valid_ok_ext \<subseteq> out: lifting_valid_ok_ext "option_l l" "option_l_S S"
proof
  fix s
  show "ok_S \<subseteq> option_l_S S s" using ok_S_valid
    by(auto simp add: option_l_S_def option_ok_S)
next
  fix s a b
  assume "(b :: 'c option) \<in> ok_S"
  then show "LUpd (option_l l) s a b \<in> ok_S"
    using ok_S_put
    by(auto simp add: option_l_S_def option_l_def option_ok_S split: option.splits)
qed

lemma (in option_l_valid_ok_ext) ax:
  shows "lifting_valid_ok_ext (option_l l) (option_l_S S)"
  using out.lifting_valid_ok_ext_axioms
  by auto

lemma (in option_l_valid_ok_ext) ax_g :
  assumes "S' = option_l_S S"
  shows "lifting_valid_ok_ext (option_l l) S'"
  using out.lifting_valid_ok_ext_axioms assms
  by auto

locale option_l_valid_pres_ext = lifting_valid_pres_ext + option_l_valid_weak

sublocale option_l_valid_pres_ext \<subseteq> out : lifting_valid_pres_ext "option_l l" "option_l_S S"
proof
  fix V
  fix s
  fix v supr :: "'c option"
  fix f

  assume Nemp : "v \<in> V"
  assume V_valid : "V \<subseteq> option_l_S S s"

  assume Hsup : "is_sup V supr"
  assume Hsup_in : "supr \<in> option_l_S S s"

  obtain supr' where Supr' : "supr = Some supr'" "supr' \<in> S s"
    using V_valid Hsup_in by(auto simp add: option_l_S_def)

  show "is_sup (LMap (option_l l) f s ` V) (LMap (option_l l) f s supr)"
  proof(rule is_supI)
    fix x

    assume X : "x \<in> LMap (option_l l) f s ` V"

    then obtain xo where Xo : "xo \<in> V" "LMap (option_l l) f s xo = x"
      by auto

    have "xo <[ supr" using is_supD1[OF Hsup Xo(1)] by simp

    have "x \<in> option_l_S S s"
      using put_S Xo
      by(auto simp add: option_l_S_def option_l_def split: option.splits)

    then obtain x' where X' : "x = Some x'" "x' \<in> S s"
      by(auto simp add: option_l_S_def)

    obtain xo' where Xo' : "xo = Some xo'" "xo' \<in> S s" using V_valid Xo
      by(auto simp add: option_l_S_def)

    have "xo' <[ supr'" using Xo' Supr' `xo <[ supr`
      by(simp add: option_pleq)

    hence "is_sup {xo', supr'} supr'"
      using is_sup_pair by auto

    hence Conc' : "is_sup (LMap l f s ` {xo', supr'}) (LMap l f s supr')"
      using Xo' Supr' pres[of xo' "{xo', supr'}" s supr' f]
      by auto

    thus "x <[ LMap (option_l l) f s supr"
      using is_supD1[OF Conc', of x'] X' Xo Xo' Supr'
      by(cases l; auto simp add: option_l_def option_pleq)
  next

    fix z

    assume Ub : "is_ub (LMap (option_l l) f s ` V) z"

    obtain V' where SV' : "V = Some ` V'" "V' \<subseteq> S s"
      using V_valid
      by(auto simp add: option_l_S_def; blast)

    obtain v' where V' : "v = Some v'" "v' \<in> V'"
      using Nemp SV'
      by auto

    have Supr'_sup : "is_sup V' supr'"
    proof(rule is_supI)
      fix x'

      assume "x' \<in> V'"

      then show "x' <[ supr'"
        using is_supD1[OF Hsup, of "Some x'"] Supr' SV' V'
        by(auto simp add: option_pleq)
    next

      fix z'

      assume "is_ub V' z'"

      then have "is_ub V (Some z')"
        using V' SV'
        by(auto simp add: option_pleq is_ub_def)

      then show "supr' <[ z'"
        using is_supD2[OF Hsup, of "Some z'"] Supr'
        by(auto simp add: option_pleq)
    qed

    have Supr'_sup : "is_sup (LMap l f s ` V') (LMap l f s supr')"
      using pres[OF V'(2) SV'(2) Supr'_sup, of f] Supr'(2)
      by auto

    obtain vr' where Vr' : "LMap (option_l l) f s v = Some vr'"
      using put_get V'
      by(cases l; auto simp add: option_l_def)

    have "LMap (option_l l) f s v <[ z"
      using is_ubE[OF Ub, of "LMap (option_l l) f s v"] Nemp
      by(auto)

    then obtain z' where Z' : "z = Some z'" using Vr'
      by(cases z; auto simp add: option_pleq)

    hence "is_ub (LMap l f s ` V') z'"
      using Ub SV'
      by(cases l; auto simp add: option_l_def is_ub_def option_pleq)

    hence "LMap l f s supr' <[ z'"
      using is_supD2[OF Supr'_sup] by auto

    then show "LMap (option_l l) f s supr <[ z" using V' Z' Supr'
      by(cases l; auto simp add: option_l_def is_ub_def option_pleq)
  qed
qed

lemma (in option_l_valid_pres_ext) ax:
  shows "lifting_valid_pres_ext (option_l l) (option_l_S S)"
  using out.lifting_valid_pres_ext_axioms
  by auto

lemma (in option_l_valid_pres_ext) ax_g :
  assumes "S' = option_l_S S"
  shows "lifting_valid_pres_ext (option_l l) S'"
  using out.lifting_valid_pres_ext_axioms assms
  by auto

locale option_l_valid_base_pres_ext = option_l_valid_pres_ext

sublocale option_l_valid_base_pres_ext \<subseteq> out: lifting_valid_base_pres_ext "option_l l" "option_l_S S"
proof
  show "\<And> s . \<bottom> \<notin> option_l_S S s"
    by(auto simp add: option_l_S_def option_bot)
qed

lemma (in option_l_valid_base_pres_ext) ax :
  shows "lifting_valid_base_pres_ext (option_l l) (option_l_S S)"
  using out.lifting_valid_base_pres_ext_axioms
  by auto

lemma (in option_l_valid_base_pres_ext) ax_g :
  assumes "S' = option_l_S S"
  shows "lifting_valid_base_pres_ext (option_l l) S'"
  using out.lifting_valid_base_pres_ext_axioms assms
  by auto

locale option_l_valid_pairwise_ext =
  lifting_valid_pairwise_ext

sublocale option_l_valid_pairwise_ext \<subseteq> out : lifting_valid_pairwise_ext "option_l_S S"
proof
  fix s
  fix x1 x2 x3 s12 s13 s23 s123 :: "'b option"
  assume X1 : "x1 \<in> option_l_S S s"
  assume X2 :"x2 \<in> option_l_S S s"
  assume X3 : "x3 \<in> option_l_S S s"
  assume S12 :"is_sup {x1, x2} s12"
  assume S12_in :"s12 \<in> option_l_S S s"
  assume S23 :"is_sup {x2, x3} s23"
  assume S23_in :"s23 \<in> option_l_S S s"
  assume S13 :"is_sup {x1, x3} s13"
  assume S13_in :"s13 \<in> option_l_S S s"
  assume S123 :"is_sup {x1, x2, x3} s123"

  obtain x1' where X1' : "x1 = Some x1'" "x1' \<in> S s"
    using X1
    by(auto simp add: option_l_S_def)

  obtain x2' where X2' : "x2 = Some x2'" "x2' \<in> S s"
    using X2
    by(auto simp add: option_l_S_def)

  obtain x3' where X3' : "x3 = Some x3'" "x3' \<in> S s"
    using X3
    by(auto simp add: option_l_S_def)

  obtain s12' where S12' : "s12 = Some s12'"  "s12' \<in> S s"
    using S12_in
    by(auto simp add: option_l_S_def)

  obtain s13' where S13' : "s13 = Some s13'" "s13' \<in> S s"
    using S13_in
    by(auto simp add: option_l_S_def)

  obtain s23' where S23' : "s23 = Some s23'" "s23' \<in> S s"
    using S23_in
    by(auto simp add: option_l_S_def)

  have S12'_sup : "is_sup {x1', x2'} s12'"
    using is_sup_Some'[of x1' "{x1', x2'}" s12'] S12
    unfolding S12' X1' X2'
    by auto

  have S13'_sup : "is_sup {x1', x3'} s13'"
    using is_sup_Some'[of x1' "{x1', x3'}" s13'] S13
    unfolding S13' X1' X3'
    by auto

  have S23'_sup : "is_sup {x2', x3'} s23'"
    using is_sup_Some'[of x2' "{x2', x3'}" s23'] S23
    unfolding S23' X2' X3'
    by auto

  obtain s123' where S123' : "s123 = Some s123'"
    using is_supD1[OF S123, of x1]
    unfolding X1'
    by(cases s123; auto simp add: option_pleq)

  have S123'_sup : "is_sup {x1', x2', x3'} s123'"
    using is_sup_Some'[of x1' "{x1', x2', x3'}" s123'] S123
    unfolding X1' X2' X3' S123'
    by auto

  have "s123' \<in> S s"
    using pairwise_S[OF X1'(2) X2'(2) X3'(2) S12'_sup S12'(2) S23'_sup S23'(2) S13'_sup S13'(2) S123'_sup ]
    by auto

  then show " s123 \<in> option_l_S S s"
    using S123'
    by(auto simp add: option_l_S_def)
qed

lemma (in option_l_valid_pairwise_ext) ax :
  shows "lifting_valid_pairwise_ext (option_l_S S)"
  using out.lifting_valid_pairwise_ext_axioms
  by auto

lemma (in option_l_valid_pairwise_ext) ax_g :
  assumes "S' = option_l_S S"
  shows "lifting_valid_pairwise_ext S'"
  using out.lifting_valid_pairwise_ext_axioms assms
  by auto

locale option_l_ortho =
  l_ortho

sublocale option_l_ortho \<subseteq> out : l_ortho "option_l l1"  "option_l_S S1" "option_l l2" "option_l_S S2"
proof
  fix s
  show "LBase (option_l l1) s = LBase (option_l l2) s"
    by(auto simp add: option_l_def)
next

  fix b s
  fix a1 :: 'b
  fix a2 :: 'd

  have Base: "LBase l1 s = LBase l2 s"
    using eq_base by auto

  show "LUpd (option_l l1) s a1 (LUpd (option_l l2) s a2 b) =
       LUpd (option_l l2) s a2 (LUpd (option_l l1) s a1 b)"
  proof(cases b)
    case None

    then show ?thesis
      using compat[of s a1 a2 "LBase l1 s"] eq_base
      by(auto simp add: option_l_def)
  next
    case (Some b')

    then show ?thesis
      using compat
      by(auto simp add: option_l_def)
  qed
next

  fix b s a1
  show "LOut (option_l l2) s (LUpd (option_l l1) s a1 b) = LOut (option_l l2) s b"
    using eq_base put1_get2
    by(cases b; auto simp add: option_l_def)
next
  fix b s a2
  show "LOut (option_l l1) s (LUpd (option_l l2) s a2 b) =
       LOut (option_l l1) s b"
    using eq_base put2_get1
    by(cases b; auto simp add: option_l_def)
next
  fix b s a1

  assume B: "b \<in> option_l_S S2 s"

  then obtain b' where B' : "b = Some b'" "b' \<in> S2 s"
    by(auto simp add: option_l_S_def)

  have "Some (LUpd l1 s a1 b') \<in> Some ` S2 s"
    using put1_S2[OF B'(2)]
    by auto

  then show "LUpd (option_l l1) s a1 b \<in> option_l_S S2 s"
    using B'
    by(auto simp add: option_l_S_def option_l_def)
next
  fix b s a2
  assume B: "b \<in> option_l_S S1 s"

  then obtain b' where B' : "b = Some b'" "b' \<in> S1 s"
    by(auto simp add: option_l_S_def)

  have "Some (LUpd l2 s a2 b') \<in> Some ` S1 s"
    using put2_S1[OF B'(2)]
    by auto

  then show "LUpd (option_l l2) s a2 b \<in> option_l_S S1 s"
    using B'
    by(auto simp add: option_l_S_def option_l_def)
qed

lemma (in option_l_ortho) ax :
  shows "l_ortho (option_l l1)  (option_l_S S1) (option_l l2) (option_l_S S2)"
  using out.l_ortho_axioms
  by auto

lemma (in option_l_ortho) ax_g :
  assumes H1 : "\<And> x . S'1 x = option_l_S S1 x"
  assumes H2 : "\<And> x . S'2 x = option_l_S S2 x"
  shows "l_ortho (option_l l1) S'1 (option_l l2) S'2"
proof-
  have H1' : "S'1 = option_l_S S1"
    using H1 by auto

  have H2' : "S'2 = option_l_S S2"
    using H2 by auto

  show ?thesis using ax unfolding H1' H2'
    by auto
qed

lemma sup_singleton :
  "is_sup {x} x"
  by(auto simp add: is_least_def is_ub_def is_sup_def leq_refl)

locale option_l_ortho_base_ext = l_ortho_base_ext

sublocale option_l_ortho_base_ext \<subseteq> out : l_ortho_base_ext "option_l l1" "option_l l2"
proof
  fix s

  show "LBase (option_l l1) s = \<bottom>"
    by(auto simp add: option_l_def option_bot)
next

  fix s
  show "LBase (option_l l2) s = \<bottom>"
    by(auto simp add: option_l_def option_bot)
qed

lemma (in option_l_ortho_base_ext) ax :
  shows "l_ortho_base_ext (option_l l1) (option_l l2)"
  using out.l_ortho_base_ext_axioms
  by auto

(* NB we are not currenly using l_ortho_pres *)
(*
locale option_l_ortho_pres = option_l_ortho + l_ortho_pres + l_ortho_base

sublocale option_l_ortho_pres \<subseteq> out : l_ortho_pres "option_l l1" "option_l_S S1" "option_l l2" "option_l_S S2"
proof
  fix s f1 f2 s1 s2 v V

  assume Sup1 : "is_sup (LMap (option_l l1) f1 s ` V) s1"
  assume Sup2 : "is_sup (LMap (option_l l2) f2 s ` V) s2"
  assume Vin : "v \<in> V"
  assume Vsub1 : "V \<subseteq> option_l_S S1 s"
  assume Sin1 : "s1 \<in> option_l_S S1 s \<inter> option_l_S S2 s"
  assume Vsub2 : "V \<subseteq> option_l_S S2 s"
  assume Sin2 : "s2 \<in> option_l_S S1 s \<inter> option_l_S S2 s"

  obtain V' where SV' : "V' = { x' . Some x' \<in> V}"
    by auto

  have Vv' : "V = Some ` V'"
    using Vsub1 SV'
    by(auto simp add: option_l_S_def)

  have V'sub1 : "V' \<subseteq> S1 s"
    using Vv' Vsub1
    by(auto simp add: option_l_S_def)

  have V'sub2 : "V' \<subseteq> S2 s"
    using Vv' Vsub2
    by(auto simp add: option_l_S_def)

  obtain v' where V' :
    "v' \<in> V'" "v = Some v'"
    using Vin
    unfolding Vv'
    by auto

  have Some_map1 : "LMap (option_l l1) f1 s `V = Some ` LMap l1 f1 s ` V'"
  proof
    show "LMap (option_l l1) f1 s ` V \<subseteq> Some ` LMap l1 f1 s ` V'"
      using Vv'
      by(auto simp add: option_l_def)
  next
    show "Some ` LMap l1 f1 s ` V' \<subseteq> LMap (option_l l1) f1 s ` V"
    proof
      fix x

      assume X: "x \<in> Some ` LMap l1 f1 s ` V'"

      then obtain xo where Xo : "xo \<in> V'" "x = Some (LMap l1 f1 s xo)"
        by auto

      then have X_eq : "x = LMap (option_l l1) f1 s (Some xo)"
        by(auto simp add: option_l_def)

      have Xo_in : "Some xo \<in> V"
        using Xo Vv' by auto

      then show "x \<in> LMap (option_l l1) f1 s ` V"
        using imageI[OF Xo_in, of "LMap (option_l l1) f1 s"] Xo
        by(auto simp add: option_l_def)

    qed
  qed

  have Some_map2 : "LMap (option_l l2) f2 s `V = Some ` LMap l2 f2 s ` V'"
  proof
    show "LMap (option_l l2) f2 s ` V \<subseteq> Some ` LMap l2 f2 s ` V'"
      using Vv'
      by(auto simp add: option_l_def)
  next
    show "Some ` LMap l2 f2 s ` V' \<subseteq> LMap (option_l l2) f2 s ` V"
    proof
      fix x

      assume X: "x \<in> Some ` LMap l2 f2 s ` V'"

      then obtain xo where Xo : "xo \<in> V'" "x = Some (LMap l2 f2 s xo)"
        by auto

      then have X_eq : "x = LMap (option_l l2) f2 s (Some xo)"
        by(auto simp add: option_l_def)

      have Xo_in : "Some xo \<in> V"
        using Xo Vv' by auto

      then show "x \<in> LMap (option_l l2) f2 s ` V"
        using imageI[OF Xo_in, of "LMap (option_l l2) f2 s"] Xo
        by(auto simp add: option_l_def)
    qed
  qed

  have Some_map3 : "LMap (option_l l1) f1 s ` Some ` LMap l2 f2 s ` V' = Some ` LMap l1 f1 s ` LMap l2 f2 s ` V'"
  proof
    show "LMap (option_l l1) f1 s ` Some ` LMap l2 f2 s ` V'
      \<subseteq> Some ` LMap l1 f1 s ` LMap l2 f2 s ` V'"
      using Vv'
      by(auto simp add: option_l_def)
  next
    show "Some ` LMap l1 f1 s ` LMap l2 f2 s ` V'
      \<subseteq> LMap (option_l l1) f1 s ` Some ` LMap l2 f2 s ` V'"
    proof
      fix x
      assume X: "x \<in> Some ` LMap l1 f1 s ` LMap l2 f2 s ` V'"

      then obtain xo where Xo : "xo \<in> V'" "x = Some (LMap l1 f1 s (LMap l2 f2 s xo))"
        by auto

      then have X_eq : "x = LMap (option_l l1) f1 s (Some (LMap l2 f2 s xo))"
        using Vv'
        by(auto simp add: option_l_def)

      have Xo_in : "Some xo \<in> V"
        using Xo Vv' by auto

      have Xo_in' : "Some (LMap l2 f2 s xo) \<in> Some ` LMap l2 f2 s ` V'"
        using Xo
        by auto

      show "x \<in> LMap (option_l l1) f1 s ` Some ` LMap l2 f2 s ` V'"
        using imageI[OF Xo_in', of "LMap (option_l l1) f1 s"] X Xo
        by(auto simp add: option_l_def)
    qed
  qed

  show "is_sup
        (LMap (option_l l1) f1 s `
         LMap (option_l l2) f2 s ` V)
        (LMap (option_l l1) f1 s s2)"
  proof(cases s1)
    case None
    have "LMap (option_l l1) f1 s v <[ s1"
      using is_supD1[OF Sup1 imageI[OF Vin]]
      by(auto)

    then have False using None
      by(cases v; auto simp add: option_l_def option_pleq)

    then show ?thesis by auto
  next
    case (Some s1')

    show ?thesis
    proof(cases s2)
      case None' : None

      have "LMap (option_l l2) f2 s v <[ s2"
        using is_supD1[OF Sup2 imageI[OF Vin]]
        by(auto)

      then have False using None'
        by(cases v; auto simp add: option_l_def option_pleq)

      then show ?thesis by auto
    next
      case Some' : (Some s2')

      have Sup'1 : "is_sup (LMap l1 f1 s ` V') s1'"
      proof(rule is_supI)
        fix x
        assume X : "x \<in> LMap l1 f1 s ` V'"

        then obtain x' where X' : "x' \<in> V'" "LMap l1 f1 s x' = x"
          by auto

        have "Some x \<in> LMap (option_l l1) f1 s ` V"
          unfolding Some_map1
          using imageI[OF X, of Some]
          by(auto simp add: option_l_def)

        then show "x <[ s1'"
          using is_supD1[OF Sup1, of "Some x"] Some
          by(auto simp add: option_pleq)
      next
        fix w

        assume Ub : "is_ub (LMap l1 f1 s ` V') w"
        have Ub' : "is_ub (LMap (option_l l1) f1 s ` V) (Some w)"
        proof(rule is_ubI)
          fix z
          assume Z: "z \<in> LMap (option_l l1) f1 s ` V"

          then have "z \<in> Some ` LMap l1 f1 s ` V'"
            unfolding Some_map1
            by auto

          then obtain z' where Z' : "z' \<in> LMap l1 f1 s ` V'" "z = Some z'"
            by auto

          show "z <[ Some w"
            using is_ubE[OF Ub Z'(1)] Z'(2)
            by(auto simp add: option_pleq)
        qed

        show "s1' <[ w"
          using is_supD2[OF Sup1 Ub'] Some
          by(auto simp add: option_pleq)
      qed

      have Sup'2 : "is_sup (LMap l2 f2 s ` V') s2'"
      proof(rule is_supI)
        fix x
        assume X : "x \<in> LMap l2 f2 s ` V'"

        then obtain x' where X' : "x' \<in> V'" "LMap l2 f2 s x' = x"
          by auto

        have "Some x \<in> LMap (option_l l2) f2 s ` V"
          unfolding Some_map2
          using imageI[OF X, of Some]
          by(auto simp add: option_l_def)

        then show "x <[ s2'"
          using is_supD1[OF Sup2, of "Some x"] Some'
          by(auto simp add: option_pleq)
      next
        fix w

        assume Ub : "is_ub (LMap l2 f2 s ` V') w"
        have Ub' : "is_ub (LMap (option_l l2) f2 s ` V) (Some w)"
        proof(rule is_ubI)
          fix z
          assume Z: "z \<in> LMap (option_l l2) f2 s ` V"

          then have "z \<in> Some ` LMap l2 f2 s ` V'"
            unfolding Some_map2
            by auto

          then obtain z' where Z' : "z' \<in> LMap l2 f2 s ` V'" "z = Some z'"
            by auto

          show "z <[ Some w"
            using is_ubE[OF Ub Z'(1)] Z'(2)
            by(auto simp add: option_pleq)
        qed

        show "s2' <[ w"
          using is_supD2[OF Sup2 Ub'] Some'
          by(auto simp add: option_pleq)
      qed

      have Sin1' : "s1' \<in> S1 s \<inter> S2 s"
        using Sin1 Some
        by(auto simp add: option_l_S_def)

      have Sin2' : "s2' \<in> S1 s \<inter> S2 s"
        using Sin2 Some'
        by(auto simp add: option_l_S_def)

      have Conc' : "is_sup (LMap l1 f1 s ` LMap l2 f2 s ` V') (LMap l1 f1 s s2')"
        using compat_pres1[OF V'(1) V'sub1 V'sub2 Sup'1 Sin1' Sup'2 Sin2']
        by auto

      show "is_sup
          (LMap (option_l l1) f1 s ` LMap (option_l l2) f2 s ` V)
          (LMap (option_l l1) f1 s s2)"
      proof(rule is_supI)
        fix z

        assume Z: "z \<in> LMap (option_l l1) f1 s `
             LMap (option_l l2) f2 s ` V "

        then have Z1 : "z \<in> LMap (option_l l1) f1 s `
             (Some ` LMap l2 f2 s ` V')"
          using Some_map2
          by auto

        then obtain z' where Z2 : "z = Some z'" "z' \<in> LMap l1 f1 s ` LMap l2 f2 s ` V'"
          unfolding Some_map3
          by auto

        show "z <[ LMap (option_l l1) f1 s s2"
          using is_supD1[OF Conc' Z2(2)] Some' Z2(1)
          by(auto simp add: option_l_def option_pleq)
      next

        fix w

        assume Ub : "is_ub
           (LMap (option_l l1) f1 s ` LMap (option_l l2) f2 s ` V)
           w"

        then have Ub1 : "is_ub (LMap (option_l l1) f1 s `
             (Some ` LMap l2 f2 s ` V')) w"
          using Some_map2
          by auto

        show "LMap (option_l l1) f1 s s2 <[ w"
        proof(cases w)
          case None'' : None

          have In' : "LMap (option_l l1) f1 s (Some (LMap l2 f2 s v')) \<in> LMap (option_l l1) f1 s ` Some ` LMap l2 f2 s ` V' "
            using imageI[OF V'(1), of "LMap (option_l l1) f1 s o Some o LMap l2 f2 s"]
            by auto

          have False using is_ubE[OF Ub1 In'] None''
            by(auto simp add: option_l_def option_pleq)

          then show ?thesis by auto
        next
          case Some'' : (Some w')
          have Ub2 : "is_ub (LMap l1 f1 s ` LMap l2 f2 s ` V') w'"
          proof(rule is_ubI)
            fix k

            assume K: "k \<in> LMap l1 f1 s ` LMap l2 f2 s ` V'"

            then have K' : "Some k \<in> Some ` LMap l1 f1 s ` LMap l2 f2 s ` V'"
              by auto

            show "k <[ w'"
              using is_ubE[OF Ub1, of "Some k"] Some'' K'
              unfolding Some_map3
              by(auto simp add: option_pleq)
          qed

          show ?thesis
            using is_supD2[OF Conc' Ub2] Some'' Some'
            by(auto simp add: option_l_def option_pleq)
        qed
      qed
    qed
  qed
*)

locale option_l_ortho_ok_ext =
  option_l_ortho + l_ortho_ok_ext

sublocale option_l_ortho_ok_ext \<subseteq> out : l_ortho_ok_ext "option_l l1" "option_l l2" .

locale option_l_valid_oc_ext =
  lifting_valid_oc_ext

sublocale option_l_valid_oc_ext \<subseteq> out : lifting_valid_oc_ext "option_l l" "option_l_S S"
proof
  fix Xs :: "('c :: Pord_Weak) option set"
  fix supr :: "'c option"
  fix s :: 'a
  fix r :: 'b
  fix w :: "'c option"
  assume W: "w \<in> Xs"
  assume Supr : "is_sup Xs supr"
  assume Compat :
    "(\<And>x. x \<in> Xs \<Longrightarrow>
             LOut (option_l l) s x = r)"

  show "LOut (option_l l) s supr = r"
  proof(cases supr)
    case None

    then have "w = None"
      using is_supD1[OF Supr W]
      by(cases w; auto simp add: option_pleq)

    then have "r = LOut l s (LBase l s)"
      using Compat[OF W]
      by(auto simp add: option_l_def)

    then show ?thesis using None
      by(auto simp add: option_l_def)
  next
    case (Some supr')

    show ?thesis
    proof(cases "Xs = {None}")
      case True

      have Ub' : "is_ub {None} None"
        by(auto simp add: is_ub_def leq_refl)

      then have False using is_supD2[OF Supr[unfolded True] Ub'] True Some
        by(auto simp add: option_pleq)

      then show ?thesis by auto
    next
      case False

      show ?thesis
      proof(cases "\<exists> y . y \<in> Xs \<and> y \<noteq> None")
        case Y_false : False

        then have "Xs = {}" using False
          by(auto)

        then have False using W by auto

        then show ?thesis by auto
      next
        case Y_true : True

        then obtain y' where Y' : "Some y' \<in> Xs"
          by auto

        obtain Xs' where Xs' : "Xs' = {x . (Some x \<in> Xs)}"
          by simp

        then have Y'_in : "y' \<in> Xs'" using Y' by auto

        have Sup_some : "is_sup (Some ` Xs') (Some supr')"
        proof(rule is_supI)
          fix x
          assume "x \<in> Some ` Xs'"

          then have X_orig : "x \<in> Xs"
            using Xs'
            by auto

          show "x <[ Some supr'"
            using is_supD1[OF Supr X_orig] Some
            by auto
        next
          fix x'
          assume Ub: "is_ub (Some ` Xs') x'"

          have Ub' : "is_ub Xs x'"
          proof(rule is_ubI)
            fix z
            assume Z: "z \<in> Xs"

            show "z <[ x'"
            proof(cases z)
              case None' : None
              then show "z <[ x'"
                by(auto simp add: option_pleq)
            next
              case Some' : (Some z')

              then have Z'_in1 : "z' \<in> Xs'"
                using Xs' Z
                by(auto)

              then have Z'_in2 : "Some z' \<in> (Some ` Xs')"
                by auto

              then show ?thesis using is_ubE[OF Ub Z'_in2] Some'
                by auto
            qed
          qed

          show "Some supr' <[ x'"
            using is_supD2[OF Supr Ub']
              Some
            by auto
        qed

        then have Sup_xs' : "is_sup Xs' supr'"
          using is_sup_Some'[OF Y'_in Sup_some]
          by auto

        have Xs'_compat :
          "(\<And>x. x \<in> Xs' \<Longrightarrow> LOut l s x = r)"
        proof-
          fix k
          assume K : "k \<in> Xs'"

          then have K1 : "Some k \<in> Xs"
            using Xs'
            by auto

          show "LOut l s k = r"
            using Compat[OF K1]
            by(auto simp add: option_l_def)
        qed

        show "LOut (option_l l) s supr = r"
          using output_consistent[OF Y'_in Sup_xs' Xs'_compat]
            Some
          by(auto simp add: option_l_def)
      qed
    qed
  qed
qed

lemma (in option_l_valid_oc_ext) ax :
  shows "lifting_valid_oc_ext (option_l l)"
  using out.lifting_valid_oc_ext_axioms
  by auto

end


theory flash92Bra  imports flash92Rev

  begin
lemma onInv92:

   assumes

     b1:"r \<in> rules N" and b2:"invf=inv92 "
   shows  "invHoldForRule' s invf r (invariants   N)"
   proof -
have c1:"ex1P N (% iRule1 .  r=NI_Local_GetX_PutX1 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_GetX  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Replace  iRule1 )\<or>ex0P N (  r=NI_ShWb N )\<or>ex0P N (  r=PI_Local_GetX_GetX2 )\<or>ex0P N (  r=NI_Local_PutXAcksDone )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX7 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak2  iRule1 )\<or>ex0P N (  r=NI_ReplaceHomeShrVld )\<or>ex1P N (% iRule1 .  r=NI_Remote_Put  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX5 N  iRule1 )\<or>ex0P N (  r=NI_Wb )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Get  iRule1 )\<or>ex0P N (  r=PI_Local_Replace )\<or>ex1P N (% iRule1 .  r=NI_ReplaceShrVld  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX8 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_InvAck_2 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Nak2  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Replace  iRule1 )\<or>ex0P N (  r=NI_Nak_Home )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put2  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_InvAck_1  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX11 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX6 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Put2  iRule1  iRule2 )\<or>ex0P N (  r=PI_Local_Get_Put )\<or>ex0P N (  r=PI_Local_GetX_PutX1 N )\<or>ex1P N (% iRule1 .  r=NI_InvAck_1_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak2  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX10_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Get  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak3  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX10 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX2 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Put1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_PutX  iRule1 )\<or>ex1P N (% iRule1 .  r=Store  iRule1 )\<or>ex0P N (  r=NI_FAck )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX3 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX3 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_PutX  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX8_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put1 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_GetX1 )\<or>ex0P N (  r=StoreHome )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_Nak  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Inv  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_PutX  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX4 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX4 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Nak  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX2 N )\<or>ex0P N (  r=NI_Local_Put )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak1  iRule1 )\<or>ex0P N (  r=NI_Nak_Clear )\<or>ex0P N (  r=PI_Local_PutX )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak3  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_Nak_Home  iRule1 )\<or>ex0P N (  r=PI_Local_Get_Get )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX9 N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_GetX  iRule1 )\<or>ex0P N (  r=NI_ReplaceHome )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_PutX_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put3  iRule1 )"

        apply(cut_tac  b1)
        apply auto
        done      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_GetXVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ShWb N )
"

         from c1 have c2:" r= NI_ShWb N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ShWbVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX2 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX2 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_PutXAcksDone )
"

         from c1 have c2:" r= NI_Local_PutXAcksDone "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX7 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX7 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX7VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHomeShrVld )
"

         from c1 have c2:" r= NI_ReplaceHomeShrVld "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Put  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Put  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX5 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX5 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX5VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Wb )
"

         from c1 have c2:" r= NI_Wb "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_Wb ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_WbVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_GetVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Replace )
"

         from c1 have c2:" r= PI_Local_Replace "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_ReplaceVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_ReplaceShrVld  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_ReplaceShrVld  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceShrVldVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Nak2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Nak2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_ReplaceVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Home )
"

         from c1 have c2:" r= NI_Nak_Home "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_HomeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_InvAck_1  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_InvAck_1  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX11 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX11 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX11VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX6 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX6 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX6VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Put2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Put2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Put )
"

         from c1 have c2:" r= PI_Local_Get_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_PutVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX1 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX1 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_1_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_1_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1_HomeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX10_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX10_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10_homeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak3VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Put1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Put1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutXVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= Store  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= Store  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis StoreVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_FAck )
"

         from c1 have c2:" r= NI_FAck "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_FAck ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_FAckVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX3 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX3 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX3VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX3 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX3 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_PutX  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_PutX  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutXVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX8_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX8_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8_homeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX1 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX1 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= StoreHome )
"

         from c1 have c2:" r= StoreHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (StoreHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis StoreHomeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_Nak  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_Nak  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_NakVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Inv  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Inv  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_PutXVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX4 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX4 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX4 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX4 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX4VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Nak  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Nak  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_NakVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX2 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX2 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_Put )
"

         from c1 have c2:" r= NI_Local_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak1VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Clear )
"

         from c1 have c2:" r= NI_Nak_Clear "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_ClearVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_PutX )
"

         from c1 have c2:" r= PI_Local_PutX "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_PutXVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak3VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_Nak_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_Nak_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_Nak_HomeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Get )
"

         from c1 have c2:" r= PI_Local_Get_Get "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_GetVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX9 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX9 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX9VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetXVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHome )
"

         from c1 have c2:" r= NI_ReplaceHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv92 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_PutX_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_PutX_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutX_HomeVsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv92 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put3VsInv92 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }ultimately show "invHoldForRule' s invf r (invariants N) "
          by blast
     qed
end


(*  Title:      ZF/Induct/Datatypes.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section \<open>Sample datatype definitions\<close>

theory Datatypes imports ZF begin

subsection \<open>A type with four constructors\<close>

text \<open>
  It has four contructors, of arities 0--3, and two parameters \<open>A\<close> and \<open>B\<close>.
\<close>

consts
  data :: "[i, i] \<Rightarrow> i"

datatype "data(A, B)" =
    Con0
  | Con1 ("a \<in> A")
  | Con2 ("a \<in> A", "b \<in> B")
  | Con3 ("a \<in> A", "b \<in> B", "d \<in> data(A, B)")

lemma data_unfold: "data(A, B) = ({0} + A) + (A \<times> B + A \<times> B \<times> data(A, B))"
  by (fast intro!: data.intros [unfolded data.con_defs]
    elim: data.cases [unfolded data.con_defs])

text \<open>
  \medskip Lemmas to justify using \<^term>\<open>data\<close> in other recursive
  type definitions.
\<close>

lemma data_mono: "\<lbrakk>A \<subseteq> C; B \<subseteq> D\<rbrakk> \<Longrightarrow> data(A, B) \<subseteq> data(C, D)"
    unfolding data.defs
  apply (rule lfp_mono)
   apply (rule data.bnd_mono)+
  apply (rule univ_mono Un_mono basic_monos | assumption)+
  done

lemma data_univ: "data(univ(A), univ(A)) \<subseteq> univ(A)"
    unfolding data.defs data.con_defs
  apply (rule lfp_lowerbound)
   apply (rule_tac [2] subset_trans [OF A_subset_univ Un_upper1, THEN univ_mono])
  apply (fast intro!: zero_in_univ Inl_in_univ Inr_in_univ Pair_in_univ)
  done

lemma data_subset_univ:
    "\<lbrakk>A \<subseteq> univ(C); B \<subseteq> univ(C)\<rbrakk> \<Longrightarrow> data(A, B) \<subseteq> univ(C)"
  by (rule subset_trans [OF data_mono data_univ])

subsection \<open>Example of a big enumeration type\<close>

text \<open>
  Can go up to at least 100 constructors, but it takes nearly 7
  minutes \dots\ (back in 1994 that is).
\<close>

consts
  enum :: i

datatype enum =
    C00 | C01 | C02 | C03 | C04 | C05 | C06 | C07 | C08 | C09
  | C10 | C11 | C12 | C13 | C14 | C15 | C16 | C17 | C18 | C19
  | C20 | C21 | C22 | C23 | C24 | C25 | C26 | C27 | C28 | C29
  | C30 | C31 | C32 | C33 | C34 | C35 | C36 | C37 | C38 | C39
  | C40 | C41 | C42 | C43 | C44 | C45 | C46 | C47 | C48 | C49
  | C50 | C51 | C52 | C53 | C54 | C55 | C56 | C57 | C58 | C59

end