theory SharedWrite
  imports Simpl.Vcg "Rust-Verification.Rust_Semantics"
begin

text \<open>In this section, we explore how we can express shared read write references (raw pointers)
in this framework.\<close>

text \<open>Consider the following Rust program:

fn main() {
  let root = &mut 100;

  let ptr1 = root as *mut i32;
  let ptr2 = ptr1;

  unsafe {
    *ptr1 = 200;
    *ptr2 = 300;
    *ptr1 = 400;
  }
}

Since the raw pointers occupy the same slot of the borrow stack,
they do not invalidate each other. Therefore, the program is valid.

We formulate this program using Isabelle/Simpl below.
\<close>

record shared_env = globals_ram +
  root :: tagged_ref
  ptr1 :: tagged_ref
  ptr2 :: tagged_ref

definition shared_body :: "(shared_env, 'p, rust_error) com" where
  "shared_body ==
    Basic (\<lambda>s. (let (r, s') = heap_new (int_val 100) s in s'\<lparr> root := r \<rparr>));;

    reborrow_stmt SharedReadWrite root (\<lambda>s r. s\<lparr> ptr1 := r \<rparr>);;
    reborrow_stmt SharedReadWrite ptr1 (\<lambda>s r. s\<lparr> ptr2 := r \<rparr>);;

    write_imm ptr1 (int_val 200);;
    write_imm ptr2 (int_val 300);;
    write_imm ptr1 (int_val 400)"

text \<open>Proof of safety (the program doesn't stuck due to alias semantics violation)\<close>

lemma "\<Gamma> \<turnstile>\<^sub>t {s. wf_heap s} shared_body {s. True}"
  unfolding shared_body_def
  apply vcg
  by (auto simp add: Let_def)

lemma "\<Gamma> \<turnstile>\<^sub>t {s. wf_heap s} shared_body {s. wf_heap s}"
  unfolding shared_body_def
  apply vcg
  by (auto simp add: Let_def wf_tags_spec)

lemma "\<Gamma> \<turnstile>\<^sub>t
  {s. wf_heap s}
  shared_body
  {s. memory s ! (the_ptr (pointer (root s))) = int_val 400 \<and>
    writable (root s) s \<and>
    writable (ptr1 s) s \<and>
    writable (ptr2 s) s}"
  unfolding shared_body_def
  apply vcg
  by (auto simp add: Let_def)

end


theory ResMapValid
  imports GenSubEnv AltNormEnv ResMapDisj
begin

definition super_drop_use_env where
  "super_drop_use_env r_s = (\<lambda> x. if r_s x = OwnPerm then NoPerm else r_s x)"

lemma self_sdrop_leq_use_env: "leq_use_env (super_drop_use_env r_s) r_s"
  apply (simp add: super_drop_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (auto)
  apply (case_tac "r_s x")
    apply (auto)
  done

lemma sdrop_leq_use_env: "\<lbrakk> leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> leq_use_env (super_drop_use_env r_x) r_s"
  apply (rule_tac r_sb="r_x" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac self_sdrop_leq_use_env)
  done

lemma diff_sdrop_leq_use_env: "leq_use_env (diff_use_env r_s r_s) (super_drop_use_env r_s)"
  apply (simp add: leq_use_env_def)
  apply (simp add: super_drop_use_env_def)
  apply (simp add: diff_use_env_def)
  apply (auto)
  apply (case_tac "r_s x")
    apply (auto)
  done

definition valid_use_entry where
  "valid_use_entry r_c r_s r_x = (leq_use_env r_x r_c \<and> strong_disj_use_env r_x r_s)"

    (* ######### NRES map validity *)

definition valid_nres_map where
  "valid_nres_map s s_map = (full_nres_map s s_map \<and> disj_nres_map s_map \<and> sub_nres_map s s_map)"

definition valid_exp_use_env where
  "valid_exp_use_env s s_map r_s = (sub_use_env s r_s \<and> sep_nres_map r_s s_map)"

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory RWHelper_DP
imports ProofHelpers_DP KHeap_DP
begin

definition eq_on :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b option) \<Rightarrow> ('a \<Rightarrow> 'b option) \<Rightarrow> bool"
where "eq_on m s s' \<equiv> \<forall>ptr\<in> m. s ptr = s' ptr"

lemma eq_on_subset:
  "\<lbrakk>B \<subseteq> A ; eq_on A s s' \<rbrakk> \<Longrightarrow> eq_on B s s'"
  by (auto simp:eq_on_def)

definition WritingOf :: "(('a \<Rightarrow>'b option) \<Rightarrow> ('a \<Rightarrow> 'b option)) \<Rightarrow> 'a set"
where "WritingOf f \<equiv> SUP s:UNIV. {ptr. (f s) ptr \<noteq> s ptr} "

definition IsReadingEstimateOf :: "'a set \<Rightarrow> (('a \<Rightarrow> 'b option) \<Rightarrow> ('a \<Rightarrow> 'b option)) \<Rightarrow> 'a set \<Rightarrow> bool"
  where "IsReadingEstimateOf m f estimate \<equiv> (\<forall>s s'. (eq_on m s s') \<longrightarrow> (eq_on estimate (f s) (f s')))"

definition ReadingEstimateOf :: "(('a \<Rightarrow>'b option) \<Rightarrow> ('a \<Rightarrow> 'b option)) \<Rightarrow> ('a set) \<Rightarrow> ('a set)"
where "ReadingEstimateOf f estimate \<equiv> Inter {m. IsReadingEstimateOf m f estimate }"

abbreviation ReadingOf :: "(('a \<Rightarrow>'b option) \<Rightarrow> ('a \<Rightarrow> 'b option)) \<Rightarrow> 'a set"
where "ReadingOf f \<equiv>  ReadingEstimateOf f (WritingOf f)"

lemma eq_on_trans:
  "\<lbrakk>eq_on a s sa ; eq_on a sa sb\<rbrakk> \<Longrightarrow> eq_on a s sb"
  by (simp add:eq_on_def)

lemma ReadingEstimateOf_inter:
  "\<lbrakk>IsReadingEstimateOf a f r; IsReadingEstimateOf b f r \<rbrakk> \<Longrightarrow> IsReadingEstimateOf (a \<inter> b) f r"
  apply (clarsimp simp:IsReadingEstimateOf_def)
  apply (drule_tac x = s in spec)
  apply (drule_tac x = "(\<lambda>ptr. if ptr\<in>(b - a) then (s' ptr) else (s ptr))" in spec)
  apply (drule_tac x = "(\<lambda>ptr. if ptr\<in>(b - a) then (s' ptr) else (s ptr))" in spec)
  apply (drule_tac x = s' in spec)
  apply (erule impE)
   apply (simp add:eq_on_def)
  apply (erule impE)
   apply (simp add:eq_on_def)
  apply (rule eq_on_trans)
  apply simp+
  done

lemma ReadingEstimateOf_read_subset:
  "\<lbrakk>IsReadingEstimateOf a f w;  a \<subseteq> b\<rbrakk> \<Longrightarrow> IsReadingEstimateOf b f w"
  by (auto simp add:IsReadingEstimateOf_def eq_on_def)

lemma ReadingEstimateOf_write_subset:
  "\<lbrakk>IsReadingEstimateOf a f w;  w' \<subseteq> w\<rbrakk> \<Longrightarrow> IsReadingEstimateOf a f w'"
  by (auto simp add:IsReadingEstimateOf_def eq_on_def)

lemma reading_estimateD:
  "\<lbrakk>IsReadingEstimateOf a f w; eq_on a s s'\<rbrakk> \<Longrightarrow> eq_on w (f s) (f s')"
  by (auto simp:IsReadingEstimateOf_def)

lemma not_writingD:
  "ptr \<notin> WritingOf f \<Longrightarrow> (f s) ptr = s ptr"
  by (auto simp:WritingOf_def)

lemma well_ordered_estimate:
  "WritingOf f \<subseteq> writing_estimate \<Longrightarrow>
    ReadingOf f \<subseteq> ReadingEstimateOf f writing_estimate"
  by (auto simp add:IsReadingEstimateOf_def ReadingEstimateOf_def eq_on_subset)

lemma writing_estimate_pipe:
  "\<lbrakk>WritingOf f \<subseteq> Q; WritingOf g \<subseteq> Q\<rbrakk> \<Longrightarrow> WritingOf (f\<circ>g) \<subseteq> Q"
  apply (subst WritingOf_def)
  apply clarsimp
  apply (rule ccontr)
  apply (drule(1) contra_subsetD)+
  apply (drule_tac s = "g xa" in not_writingD)
  apply (drule_tac s = xa in not_writingD)
  apply simp
  done

lemma reading_writing_estimate:
  "\<lbrakk>eq_on R s s'; IsReadingEstimateOf R g (WritingOf g)\<rbrakk> \<Longrightarrow> eq_on R (g s) (g s')"
  apply (subst eq_on_def)
  apply clarsimp
  apply (case_tac "ptr \<in> WritingOf g")
   apply (clarsimp simp:IsReadingEstimateOf_def)
   apply (elim impE allE)
    apply simp
   apply (clarsimp simp:eq_on_def)
  apply (clarsimp simp:WritingOf_def eq_on_def)
  done

lemma reading_estimate_pipe:
  assumes reg: "IsReadingEstimateOf R g M"
  and ref: " IsReadingEstimateOf R f M"
  and wg: "WritingOf g \<subseteq> M"
  and wf: "WritingOf f \<subseteq> M"
  shows "IsReadingEstimateOf R (f \<circ> g) M"
  apply (clarsimp simp: IsReadingEstimateOf_def)
  apply (cut_tac ReadingEstimateOf_write_subset[OF reg wg])
  apply (drule(1) reading_writing_estimate[rotated])
  apply (erule reading_estimateD[OF ref])
  done

definition
  "IsSepWritingEstimateOf f P proj m \<equiv> \<forall>ptr v.
  \<lbrace>\<lambda>s. (proj s) ptr = v \<and> P s \<and> ptr \<in> (UNIV - m) \<rbrace> f \<lbrace>\<lambda>r s. (proj s) ptr = v \<rbrace>"

definition
  "IsStrongSepWritingEstimateOf f P proj m g \<equiv> \<forall>state.
  \<lbrace>\<lambda>s. (proj s) = state \<and> P s \<rbrace> f
  \<lbrace>\<lambda>r s. (proj s) |` m = (g state) \<and> (proj s) |` (UNIV - m) = state |` (UNIV - m)\<rbrace>"

definition
  "IsSepReadingEstimateOf r f P proj m \<equiv> \<forall>substate. \<exists>g.
  \<lbrace>\<lambda>s. (proj s) |` r = substate \<and> P s  \<rbrace> f \<lbrace>\<lambda>r s. (proj s) |` m = g substate\<rbrace>"

lemma sep_writing_estimateD:
  "\<lbrakk>IsSepWritingEstimateOf f P proj m; (r, s') \<in> fst (f s);P s \<rbrakk>
  \<Longrightarrow> proj s |` (UNIV - m) = proj s' |` (UNIV - m)"
  apply (rule ext)
  apply (clarsimp simp: restrict_map_def
    IsSepWritingEstimateOf_def)
  apply (drule_tac x = x in spec)
  apply (drule_tac x = "proj s x" in spec)
  apply (drule(1) use_valid)
   apply simp+
  done

lemma sep_writing_estimate_imp:
  "\<lbrakk>IsSepWritingEstimateOf f P' proj m; \<And>s. P s \<Longrightarrow> P' s\<rbrakk>
  \<Longrightarrow> IsSepWritingEstimateOf f P proj m"
  apply (clarsimp simp:IsSepWritingEstimateOf_def)
  apply (drule_tac x = ptr in spec)
  apply (drule_tac x = v in spec)
  apply (erule hoare_pre)
  apply clarsimp
  done

lemma sep_strong_writing_estimateD:
  "\<lbrakk>IsStrongSepWritingEstimateOf f P proj m g; (r, s') \<in> fst (f s);P s \<rbrakk>
  \<Longrightarrow> proj s' |` m = g (proj s) \<and> proj s' |` (UNIV - m) = proj s |` (UNIV - m)"
  apply (simp add:
    IsStrongSepWritingEstimateOf_def)
  apply (drule_tac x = "proj s " in spec)
  apply (drule use_valid)
   apply assumption
   apply simp+
  done

lemma intent_reset_twice[simp]:
 "intent_reset (intent_reset z) = intent_reset z"
  apply (case_tac z)
  apply (simp_all add:intent_reset_def)
  done

lemma largest_set:
  "UNIV \<subseteq> cmps \<Longrightarrow> cmps = UNIV"
  by auto

definition "sep_map_predicate p P cmps \<equiv> \<lambda>s. \<exists>obj. (sep_map_general p obj cmps s \<and> P obj)"

definition "sep_heap_dom P m = (\<forall>s. P s \<longrightarrow> dom (sep_heap s) = m)"
definition "sep_irq_node_dom P m = (\<forall>s. P s \<longrightarrow> dom (sep_irq_node s) = m)"

definition "sep_map_spec P s =  (\<forall>s'. P s' \<longrightarrow> s' =  s)"

lemma sep_heap_domD:
  "\<lbrakk>sep_heap_dom P m; P s ; p \<notin> m\<rbrakk>
   \<Longrightarrow> p \<notin> dom (sep_heap s)"
  by (fastforce simp:sep_heap_dom_def)

lemma sep_heap_domD':
  "\<lbrakk>sep_heap_dom P m;P s\<rbrakk>
   \<Longrightarrow> m = dom (sep_heap s)"
  by (fastforce simp:sep_heap_dom_def)

lemma sep_irq_node_domD':
  "\<lbrakk>sep_irq_node_dom P m; P s\<rbrakk>
   \<Longrightarrow> m = dom (sep_irq_node s)"
  by (fastforce simp: sep_irq_node_dom_def)

lemma sep_specD:
  "\<lbrakk>sep_map_spec P s; P s'\<rbrakk> \<Longrightarrow> s = s'"
  by (clarsimp simp: sep_map_spec_def)

lemma sep_heap_dom_sep_map_predicate:
  "m = {ptr}\<times> cmps \<Longrightarrow>
  sep_heap_dom (sep_map_predicate ptr P cmps) m"
  apply (clarsimp simp: sep_map_general_def
    object_to_sep_state_def
    sep_heap_dom_def sep_map_predicate_def
    split:sep_state.splits if_splits)
  apply (rule set_eqI)
  apply (clarsimp simp:dom_def object_project_def split:cdl_component_id.splits)
  done

lemma sep_irq_node_dom_sep_map_predicate:
  "sep_irq_node_dom (sep_map_predicate ptr P cmps) {}"
  apply (clarsimp simp: sep_map_general_def object_to_sep_state_def
    sep_irq_node_dom_def sep_map_predicate_def
    split:sep_state.splits if_split_asm)
  done

lemma sep_map_rewrite_spec:
  "sep_map_general = (\<lambda>p obj cmps.  sep_map_predicate p ((=) obj) cmps)"
  "sep_map_o = (\<lambda>p obj. sep_map_predicate p ((=) obj) UNIV)"
  "sep_map_f = (\<lambda>p obj. sep_map_predicate p ((=) obj) {Fields})"
  "sep_map_c = (\<lambda>p cap. let (ptr,slot) = p in
   sep_map_predicate ptr (\<lambda>obj. object_slots obj = [ slot \<mapsto> cap]) {Slot slot})"
  by (fastforce simp: sep_map_predicate_def sep_any_def sep_map_general_def
                      sep_map_o_def sep_map_f_def sep_map_c_def split_def
               split: sep_state.splits)+

lemma sep_map_rewrite_any:
  "sep_any_map_c = (\<lambda>ptr state.
   sep_map_predicate (fst ptr) (\<lambda>obj. \<exists>cap. object_slots obj = [(snd ptr) \<mapsto> cap]) {Slot (snd ptr)} state)"
  by (fastforce simp: sep_map_predicate_def sep_map_general_def sep_any_def
                      sep_map_o_def sep_map_f_def sep_map_c_def split_def
               split: sep_state.splits)

lemma sep_heap_dom_conj:
  "\<lbrakk>sep_heap_dom P m;sep_heap_dom P' m'\<rbrakk> \<Longrightarrow> sep_heap_dom (P \<and>* P') (m \<union> m')"
  apply (clarsimp simp: sep_heap_dom_def sep_conj_def
                        sep_disj_sep_state_def sep_state_disj_def)
  apply (auto simp: map_disj_def plus_sep_state_def sep_state_add_def)
  done

lemma sep_heap_dom_simps:
  "sep_heap_dom (slot \<mapsto>c -) ({(fst slot,Slot (snd slot))})"
  "sep_heap_dom (slot \<mapsto>c cap) ({(fst slot,Slot (snd slot))})"
  apply (simp add:sep_map_rewrite_any sep_heap_dom_sep_map_predicate)
  apply (simp add:sep_map_rewrite_spec sep_heap_dom_sep_map_predicate split_def)
  done

lemma sep_irq_node_dom_simps:
  "sep_irq_node_dom (slot \<mapsto>c -) {}"
  "sep_irq_node_dom (slot \<mapsto>c cap) {}"
  apply (simp add:sep_map_rewrite_any sep_irq_node_dom_sep_map_predicate)
  apply (simp add:sep_map_rewrite_spec sep_irq_node_dom_sep_map_predicate split_def)
  done

lemma sep_map_spec_conj:
  "\<lbrakk>sep_map_spec P s; sep_map_spec P' s'\<rbrakk>
    \<Longrightarrow> sep_map_spec (P \<and>* P')
                     (SepState (sep_heap s ++ sep_heap s')
                               (sep_irq_node s ++ sep_irq_node s'))"
  by (clarsimp simp: sep_map_spec_def sep_conj_def
                     plus_sep_state_def sep_state_add_def)

lemma sep_spec_simps:
  "sep_map_spec (slot \<mapsto>c cap)
  (SepState [(fst slot,Slot (snd slot)) \<mapsto> (CDL_Cap (Some (reset_cap_asid cap)))]
            Map.empty)"
  apply (clarsimp simp:sep_map_spec_def sep_map_c_def sep_map_general_def)
  apply (case_tac s')
  apply (clarsimp simp:object_to_sep_state_def)
  apply (rule ext)
  apply (clarsimp simp: object_project_def object_slots_object_clean
                 split: if_split_asm)
  done

lemma sep_conj_spec:
  "\<lbrakk> < P \<and>* Q > s\<rbrakk>
   \<Longrightarrow> \<exists>s'. < P \<and>* (=) s' > s"
  by (auto simp:sep_state_projection_def sep_conj_def
    sep_disj_sep_state_def sep_state_disj_def)

lemma sep_conj_spec_value:
  "\<lbrakk> < P \<and>* (=) s' > s; sep_heap_dom P m; p \<notin> m\<rbrakk>
  \<Longrightarrow> (sep_heap s') p = (sep_heap (sep_state_projection s) |` (UNIV - m)) p"
  apply (clarsimp simp:sep_state_projection_def sep_conj_def
    sep_disj_sep_state_def sep_state_disj_def)
  apply (drule(2) sep_heap_domD)
  apply (simp add: plus_sep_state_def sep_state_add_def
            split: sep_state.splits)
  apply (clarsimp simp: map_add_def split:option.splits)
  done

lemma write_estimate_via_sep:
  assumes sep_valid: "\<And>obj Q. \<lbrace>\<lambda>s. < P \<and>* Q > s \<rbrace>
    f \<lbrace>\<lambda>r s. < P' \<and>* Q > s \<rbrace>"
  and sep_heap_dom: "sep_heap_dom P m"
  and sep_heap_dom': "sep_heap_dom P' m"
  shows "IsSepWritingEstimateOf f (\<lambda>s. < P \<and>* Q> s)
    (\<lambda>s.  sep_heap (sep_state_projection s)) m"
  apply (clarsimp simp: valid_def IsSepWritingEstimateOf_def)
  apply (drule sep_conj_spec)
  apply clarsimp
  apply (drule use_valid[OF _ sep_valid])
   apply simp
  apply (drule(1) sep_conj_spec_value[OF _ sep_heap_dom])
  apply (drule(1) sep_conj_spec_value[OF _ sep_heap_dom'])
  apply simp
  done

lemma sep_map_dom_predicate:
  "\<lbrakk>sep_heap_dom P m; sep_irq_node_dom P m';
    <P \<and>* P'> b\<rbrakk>
  \<Longrightarrow> P (SepState (sep_heap (sep_state_projection b) |` m)
                  (sep_irq_node (sep_state_projection b) |` m'))"
  apply (clarsimp simp: sep_state_projection_def sep_conj_def
                        plus_sep_state_def sep_state_add_def)
  apply (drule(1) sep_heap_domD')
  apply (drule(1) sep_irq_node_domD')
  apply simp
  apply (case_tac x,case_tac y)
  apply (clarsimp simp: sep_state_projection_def sep_conj_def
                        sep_disj_sep_state_def sep_state_disj_def)
  apply (simp add: map_add_restrict_dom_left)
  done

lemma strong_write_estimate_via_sep:
  assumes sep_valid: "\<And>obj Q. \<lbrace>\<lambda>s. < P \<and>* Q > s \<rbrace>
    f \<lbrace>\<lambda>r s. < P' \<and>* Q > s \<rbrace>"
  and sep_heap_dom: "sep_heap_dom P m"
  and sep_heap_dom': "sep_heap_dom P' m"
  and sep_irq_node_dom' : "sep_irq_node_dom P' m'"
  and sep_spec: "sep_map_spec P' state"
  shows "IsStrongSepWritingEstimateOf f (\<lambda>s. < P \<and>* Q> s)
    (\<lambda>s.  sep_heap (sep_state_projection s)) m (\<lambda>s. sep_heap state)"
  apply (clarsimp simp: valid_def IsStrongSepWritingEstimateOf_def)
  apply (drule sep_conj_spec)
  apply clarsimp
  apply (drule use_valid[OF _ sep_valid])
   apply simp
  apply (rule conjI)
   apply simp
   apply (drule sep_map_dom_predicate[OF sep_heap_dom' sep_irq_node_dom'])
   apply (drule sep_specD[OF sep_spec])
   apply (case_tac state,simp)
  apply (rule ext,clarsimp simp:restrict_map_def)
  apply (drule sep_conj_spec_value)
    apply (rule sep_heap_dom)
   apply simp
  apply (drule(1) sep_conj_spec_value[OF _ sep_heap_dom'])
  apply simp
  done

lemma map_eqI:
  "\<lbrakk>a |` m = b |` m;a |` (UNIV - m)  = b |` (UNIV - m)\<rbrakk> \<Longrightarrow> a = b"
  apply (rule ext)
  apply (drule_tac x = x in fun_cong)+
  apply (auto simp:restrict_map_def split:if_splits)
  done

lemma using_writing_estimate:
  assumes we: "IsSepWritingEstimateOf f P proj m"
  shows "\<lbrace>\<lambda>s. P s \<and> Q ((proj s) |` (UNIV - m)) \<rbrace> f \<lbrace>\<lambda>r s. Q ((proj s) |` (UNIV - m))\<rbrace>"
  apply (clarsimp simp:valid_def)
  apply (erule arg_cong[where f = Q,THEN iffD1,rotated])
  apply (erule sep_writing_estimateD[OF we])
  apply simp
  done

lemma using_strong_writing_estimate:
  assumes we: "IsStrongSepWritingEstimateOf f P proj m g"
  shows
  "\<lbrace>\<lambda>s. P s \<and> Q ((proj s) |` (UNIV - m) ++ g (proj s))  \<rbrace> f \<lbrace>\<lambda>r s. Q (proj s)\<rbrace>"
  apply (clarsimp simp:valid_def)
  apply (erule arg_cong[where f = Q,THEN iffD1,rotated])
  apply (rule map_eqI[where m = m])
   apply (drule(1) sep_strong_writing_estimateD[OF we,THEN conjunct1,symmetric])
   apply (rule ext)
   apply (clarsimp simp:restrict_map_def
     map_add_def split:option.splits)
  apply (frule(1) sep_strong_writing_estimateD[OF we,THEN conjunct1,symmetric])
  apply (drule(1) sep_strong_writing_estimateD[OF we,THEN conjunct2,symmetric])
  apply (rule ext)
  apply simp
  done

(* Here are some examples that we get valid rules from existing sep_logical rules *)

(* 1.  We need some predicates in the furture to make sure schedule will do the right thing *)

definition "scheduable_cap cap \<equiv> case cap of
  RunningCap \<Rightarrow> True | RestartCap \<Rightarrow> True | _ \<Rightarrow> False"

definition tcb_scheduable :: "cdl_tcb \<Rightarrow> bool"
  where "tcb_scheduable \<equiv> \<lambda>tcb. (cdl_tcb_caps tcb) tcb_pending_op_slot
  = Some RunningCap \<or> (cdl_tcb_caps tcb) tcb_pending_op_slot = Some RestartCap"

abbreviation "tcb_at_heap \<equiv> \<lambda>P ptr heap.
  object_at_heap (\<lambda>obj. \<exists>tcb. obj = Tcb tcb  \<and>  P tcb)  ptr heap"

definition all_scheduable_tcbs :: "(word32 \<Rightarrow> cdl_object option) \<Rightarrow> cdl_object_id set"
where  "all_scheduable_tcbs \<equiv> \<lambda>m. {ptr. tcb_at_heap tcb_scheduable ptr m}"

definition sep_all_scheduable_tcbs :: "(32 word \<times> cdl_component_id \<Rightarrow> cdl_component option) \<Rightarrow> cdl_object_id set"
where "sep_all_scheduable_tcbs m \<equiv> {ptr. \<exists>obj cap. m (ptr,Fields) = Some (CDL_Object obj) \<and> is_tcb obj
  \<and> m (ptr,Slot tcb_pending_op_slot) = Some (CDL_Cap (Some cap)) \<and> scheduable_cap cap}"

lemma is_tcb_obj_type:
  "is_tcb = (\<lambda>x. object_type x = TcbType)"
  by (auto simp:is_tcb_def object_type_def split:cdl_object.splits)

lemma all_scheduable_tcbs_rewrite:
  "all_scheduable_tcbs (cdl_objects s) =
  sep_all_scheduable_tcbs (sep_heap (sep_state_projection s))"
 apply (intro set_eqI iffI)
  apply (clarsimp simp:all_scheduable_tcbs_def sep_state_projection_def
    sep_all_scheduable_tcbs_def object_at_heap_def object_project_def
    is_tcb_obj_type)
  apply (clarsimp simp:object_type_def object_slots_object_clean
    tcb_scheduable_def object_slots_def scheduable_cap_def)
  apply (fastforce simp:object_clean_def asid_reset_def update_slots_def
    reset_cap_asid_def intent_reset_def object_slots_def
    split:if_splits)
 apply (clarsimp simp:all_scheduable_tcbs_def sep_state_projection_def
    sep_all_scheduable_tcbs_def object_at_heap_def object_project_def
    is_tcb_obj_type split:option.splits)
 apply (clarsimp simp:object_type_def tcb_scheduable_def
   scheduable_cap_def object_slots_def object_clean_def asid_reset_def
   update_slots_def intent_reset_def reset_cap_asid_def
   split:cdl_object.splits cdl_cap.splits option.splits)
 done

lemma update_slots_rev:
  "update_slots slots obj = obj' \<Longrightarrow>
  obj = update_slots (object_slots obj) obj'"
  by (clarsimp simp:update_slots_def object_slots_def
    split:cdl_object.splits)

lemma all_scheduable_tcbsD:
  "ptr \<in> all_scheduable_tcbs (cdl_objects s)
  \<Longrightarrow> tcb_at_heap tcb_scheduable ptr (cdl_objects s)"
  by (simp add:all_scheduable_tcbs_def)

lemma all_scheduable_tcbsD':
  "ptr \<notin> all_scheduable_tcbs (cdl_objects s)
  \<Longrightarrow> \<not> tcb_at_heap tcb_scheduable ptr (cdl_objects s)"
  by (simp add:all_scheduable_tcbs_def)

lemma scheduable_cap_reset_cap_asid[simp]:
  "scheduable_cap (reset_cap_asid cap) = scheduable_cap cap"
  by (case_tac cap,simp_all add: reset_cap_asid_def scheduable_cap_def)

lemma set_cap_all_scheduable_tcbs:
  "\<lbrace>\<lambda>s. all_scheduable_tcbs (cdl_objects s) = {cur_thread} \<and> (cap = RunningCap \<or> cap = RestartCap) \<rbrace>
    set_cap (cur_thread,tcb_pending_op_slot) cap
  \<lbrace>\<lambda>rv s. all_scheduable_tcbs (cdl_objects s) = {cur_thread} \<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (cut_tac all_scheduable_tcbsD[where ptr = cur_thread])
   prefer 2
   apply fastforce
  apply (clarsimp simp:all_scheduable_tcbs_rewrite)
  apply (rule hoare_pre)
   apply (rule using_strong_writing_estimate
     [where proj = "(\<lambda>a. sep_heap (sep_state_projection a))"])
   apply (rule strong_write_estimate_via_sep[OF set_cap_wp])
     apply (rule sep_heap_dom_simps sep_irq_node_dom_simps sep_spec_simps)+
  apply (rule conjI)
   apply (clarsimp simp:sep_map_c_conj
     Let_def sep_any_exist all_scheduable_tcbs_rewrite[symmetric]
     dest!:in_singleton)
   apply (clarsimp simp:object_at_heap_def tcb_scheduable_def
     sep_state_projection_def object_project_def)
   apply (rule conjI)
    apply (clarsimp simp:object_slots_def object_clean_def
      update_slots_def intent_reset_def asid_reset_def
      split:option.splits)
    apply fastforce+
  apply (rule subst,assumption)
  apply (drule in_singleton)
  apply (intro set_eqI iffI)
   apply (clarsimp simp: sep_all_scheduable_tcbs_def sep_state_projection_def
                  split: if_split_asm option.splits)
  apply (fastforce simp: sep_all_scheduable_tcbs_def map_add_def
                         sep_state_projection_def scheduable_cap_def
                 split: option.splits)
  done

lemma sep_inv_to_all_scheduable_tcbs:
  assumes sep: "\<And>P. \<lbrace><P>\<rbrace> f \<lbrace>\<lambda>r. <P>\<rbrace>"
  shows "\<lbrace>\<lambda>s. P (all_scheduable_tcbs (cdl_objects s))\<rbrace> f
   \<lbrace>\<lambda>r s. P (all_scheduable_tcbs (cdl_objects s))\<rbrace>"
  apply (clarsimp simp:valid_def all_scheduable_tcbs_rewrite)
  apply (erule use_valid)
   apply (rule hoare_strengthen_post)
    apply (rule sep)
   apply assumption
  apply simp
  done

lemma validE_to_valid:
  assumes validE:"\<And>E. \<lbrace>P\<rbrace>f\<lbrace>\<lambda>r. Q\<rbrace>,\<lbrace>\<lambda>r s. E\<rbrace>"
  shows "\<lbrace>P\<rbrace>f\<lbrace>\<lambda>r. Q\<rbrace>"
  using validE[where E = False]
  apply (clarsimp simp:validE_def valid_def)
  apply (drule_tac spec)
  apply (erule(1) impE)
  apply (drule_tac bspec)
   apply assumption
  apply (auto split:sum.splits)
  done

end


(* Author: Joshua Schneider, ETH Zurich *)

subsection \<open>Set with Cartesian product\<close>

theory Applicative_Set imports
  Applicative
  "HOL-Library.Adhoc_Overloading"
begin

definition ap_set :: "('a \<Rightarrow> 'b) set \<Rightarrow> 'a set \<Rightarrow> 'b set"
  where "ap_set F X = {f x | f x. f \<in> F \<and> x \<in> X}"

adhoc_overloading Applicative.ap ap_set

lemma ap_set_transfer[transfer_rule]:
  "rel_fun (rel_set (rel_fun A B)) (rel_fun (rel_set A) (rel_set B)) ap_set ap_set"
unfolding ap_set_def[abs_def] rel_set_def
by (fastforce elim: rel_funE)

applicative set (C)
for
  pure: "\<lambda>x. {x}"
  ap: ap_set
  rel: rel_set
  set: "\<lambda>x. x"
proof -
  fix R :: "'a \<Rightarrow> 'b \<Rightarrow> bool"
  show "rel_fun R (rel_set R) (\<lambda>x. {x}) (\<lambda>x. {x})" by (auto intro: rel_setI)
next
  fix R and f :: "('a \<Rightarrow> 'b) set" and g :: "('a \<Rightarrow> 'c) set" and x
  assume [transfer_rule]: "rel_set (rel_fun (eq_on x) R) f g"
  have [transfer_rule]: "rel_set (eq_on x) x x" by (auto intro: rel_setI)
  show "rel_set R (ap_set f x) (ap_set g x)" by transfer_prover
qed (unfold ap_set_def, fast+)

end


(*  Title:      HOL/Induct/Term.thy
    Author:     Stefan Berghofer,  TU Muenchen
*)

section \<open>Terms over a given alphabet\<close>

theory Term
imports Main
begin

datatype ('a, 'b) "term" =
    Var 'a
  | App 'b "('a, 'b) term list"

text \<open>\medskip Substitution function on terms\<close>

primrec subst_term :: "('a \<Rightarrow> ('a, 'b) term) \<Rightarrow> ('a, 'b) term \<Rightarrow> ('a, 'b) term"
  and subst_term_list :: "('a \<Rightarrow> ('a, 'b) term) \<Rightarrow> ('a, 'b) term list \<Rightarrow> ('a, 'b) term list"
where
  "subst_term f (Var a) = f a"
| "subst_term f (App b ts) = App b (subst_term_list f ts)"
| "subst_term_list f [] = []"
| "subst_term_list f (t # ts) = subst_term f t # subst_term_list f ts"

text \<open>\medskip A simple theorem about composition of substitutions\<close>

lemma subst_comp:
  "subst_term (subst_term f1 \<circ> f2) t =
    subst_term f1 (subst_term f2 t)"
and "subst_term_list (subst_term f1 \<circ> f2) ts =
    subst_term_list f1 (subst_term_list f2 ts)"
  by (induct t and ts rule: subst_term.induct subst_term_list.induct) simp_all

text \<open>\medskip Alternative induction rule\<close>

lemma
  assumes var: "\<And>v. P (Var v)"
    and app: "\<And>f ts. (\<forall>t \<in> set ts. P t) \<Longrightarrow> P (App f ts)"
  shows term_induct2: "P t"
    and "\<forall>t \<in> set ts. P t"
  apply (induct t and ts rule: subst_term.induct subst_term_list.induct)
     apply (rule var)
    apply (rule app)
    apply assumption
   apply simp_all
  done

end


theory LazyPrelude_ListNoNumbers
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"Comp1\", \"IdDef\", \"FlipDef\", \"FstDef\", \"SndDef\",
     \"CurryDef\", \"UncurryDef\", \"NotFalse\", \"NotTrue\",
     \"AndFalse\", \"AndTrue\", \"AndSym\", \"OrDef\", \"OtherwiseDef\",
     \"NotFalse1\", \"NotTrue1\", \"notNot1\", \"notNot2\",
     \"EqualTDef\", \"EqualSymDef\", \"EqualReflex\", \"EqualTransT\",
     \"DiffDef\", \"DiffSymDef\", \"DiffTDef\", \"DiffFDef\", \"TE1\",
     \"TE2\", \"TE3\", \"TE4\", \"IUE1\", \"IUE2\", \"IBE1\", \"IBE2\",
     \"IBE3\", \"IBE4\", \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\",
     \"IOE01\", \"IOE02\", \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\",
     \"IOE07\", \"IOE08\", \"IOE09\", \"LeIrreflexivity\",
     \"LeTAsymmetry\", \"LeTTransitive\", \"LeTTotal\", \"GeDef\",
     \"GeIrreflexivity\", \"GeTAsymmetry\", \"GeTTransitive\",
     \"GeTTotal\", \"LeqDef\", \"LeqReflexivity\", \"LeqTTransitive\",
     \"LeqTTotal\", \"GeqDef\", \"GeqReflexivity\", \"GeqTTransitive\",
     \"GeqTTotal\", \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\",
     \"EqFOrdRel\", \"EqTOrdTSubstE\", \"EqTOrdFSubstE\",
     \"EqTOrdTSubstD\", \"EqTOrdFSubstD\", \"LeTGeFEqFRel\",
     \"LeFGeTEqTRel\", \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\",
     \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\",
     \"GeqFLeqFRel\", \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\",
     \"GeFLeTEqTRel\", \"GeqTLeFRel\", \"GeqFLeTRel\",
     \"LeqTLeTEqTRel\", \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\",
     \"GeqFGeFEqFRel\", \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\",
     \"CmpLTDef\", \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\",
     \"MinXDef\", \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\",
     \"TO3\", \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IUO01\", \"IUO02\",
     \"IUO03\", \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"IOO13\",
     \"IOO14\", \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\",
     \"IOO20\", \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\",
     \"IOO26\", \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\",
     \"IOO32\", \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\",
     \"IBO9\", \"IBO10\", \"IBO11\", \"IBO12\", \"NotDefHead\",
     \"HeadDef\", \"NotDefTail\", \"TailDef\", \"FoldrNil\",
     \"FoldrCons\", \"FoldlNil\", \"FoldlCons\", \"MapNil\",
     \"MapCons\", \"XPlusXPlusNil\", \"XPlusXPlusCons\", \"FilterNil\",
     \"FilterConsT\", \"FilterConsF\", \"ZipNil\", \"ZipConsNil\",
     \"ZipConsCons\", \"UnzipNil\", \"UnzipCons\", \"ILE01\", \"ILE02\",
     \"ILO01\", \"ILO02\", \"ILO03\", \"ILO04\", \"ILO05\", \"ILO06\",
     \"ILO07\", \"ILO08\", \"ILO09\", \"ILO10\", \"ILO11\", \"ILO12\",
     \"ILO13\", \"ILO14\", \"ILO15\", \"ILO16\", \"ILO17\", \"ILO18\",
     \"ILO19\", \"ILO20\", \"ILO21\", \"ILO22\", \"FoldlDecomp\",
     \"MapDecomp\", \"MapFunctor\", \"FilterProm\", \"InitNil\",
     \"InitConsNil\", \"InitConsCons\", \"LastNil\", \"LastConsNil\",
     \"LastConsCons\", \"NullNil\", \"NullCons\", \"ReverseNil\",
     \"ReverseCons\", \"Foldr1Nil\", \"Foldr1ConsNil\",
     \"Foldr1ConsCons\", \"Foldl1Nil\", \"Foldl1ConsNil\",
     \"Foldl1ConsCons\", \"ScanlNil\", \"ScanlCons\", \"Scanl1Nil\",
     \"Scanl1Cons\", \"ScanrNil\", \"ScanrCons\", \"Scanr1Nil\",
     \"Scanr1ConsNil\", \"Scanr1ConsCons\", \"ScanlProperty\",
     \"ScanrProperty\", \"ConcatDef\", \"ConcatMapDef\", \"MaximunNil\",
     \"MaximumDef\", \"MinimunNil\", \"MinimumDef\", \"TakeWhileNil\",
     \"TakeWhileConsT\", \"TakeWhileConsF\", \"DropWhileNil\",
     \"DropWhileConsT\", \"DropWhileConsF\", \"SpanNil\", \"SpanConsT\",
     \"SpanConsF\", \"SpanThm\", \"BreakDef\", \"BreakThm\",
     \"InsertNil\", \"InsertCons1\", \"InsertCons2\", \"DeleteNil\",
     \"DeleteConsT\", \"DeleteConsF\", \"SelectT\", \"SelectF\",
     \"Partition\", \"PartitionProp\"]"

typedecl Bool
typedecl ('a1) DList
typedecl Unit
typedecl X_Nat

datatype Ordering = EQ | GT | LT
datatype 'a List = X_Cons "'a partial" "'a List partial" | X_Nil ("Nil''")

consts
Not__X :: "bool => bool" ("(Not''/ _)" [56] 56)
X__XAmpXAmp__X :: "bool => bool => bool" ("(_/ &&/ _)" [54,54] 52)
X__XEqXEq__X :: "'a partial => 'a partial => bool" ("(_/ ==''/ _)" [54,54] 52)
X__XGtXEq__X :: "'a partial => 'a partial => bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a partial => 'a partial => bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a partial => 'a partial => bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a partial => 'a partial => bool" ("(_/ <''/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List partial => 'a List partial => 'a List partial" ("(_/ ++''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a partial => 'a partial => bool" ("(_/ '/=/ _)" [54,54] 52)
X__XVBarXVBar__X :: "bool => bool => bool" ("(_/ ||/ _)" [54,54] 52)
X__o__X :: "('b partial => 'c partial) * ('a partial => 'b partial) => 'a partial => 'c partial"
X_concat :: "'a List List partial => 'a List partial" ("concat''/'(_')" [3] 999)
X_curry :: "('a partial * 'b partial => 'c partial) => 'a partial => 'b partial => 'c partial"
X_dropWhile :: "('a partial => bool) => 'a List partial => 'a List partial"
X_filter :: "('a partial => bool) => 'a List partial => 'a List partial"
X_flip :: "('a partial => 'b partial => 'c partial) => 'b partial => 'a partial => 'c partial"
X_foldl :: "('a partial => 'b partial => 'a partial) => 'a partial => 'b List partial => 'a partial"
X_foldr :: "('a partial => 'b partial => 'b partial) => 'b partial => 'a List partial => 'b partial"
X_fst :: "'a partial => 'b partial => 'a partial" ("fst''/'(_,/ _')" [3,3] 999)
X_head :: "'a List partial => 'a partial" ("head/'(_')" [3] 999)
X_id :: "'a partial => 'a partial" ("id''/'(_')" [3] 999)
X_init :: "'a List partial => 'a List partial" ("init/'(_')" [3] 999)
X_insert :: "'d partial => 'd List partial => 'd List partial"
X_last :: "'a List partial => 'a partial" ("last''/'(_')" [3] 999)
X_map :: "('a partial => 'b partial) => 'a List partial => 'b List partial"
X_max :: "'a partial => 'a partial => 'a partial"
X_maximum :: "'d List partial => 'd partial" ("maximum/'(_')" [3] 999)
X_min :: "'a partial => 'a partial => 'a partial"
X_minimum :: "'d List partial => 'd partial" ("minimum/'(_')" [3] 999)
X_null :: "'a List partial => bool" ("null''/'(_')" [3] 999)
X_reverse :: "'a List partial => 'a List partial" ("reverse/'(_')" [3] 999)
X_snd :: "'a partial => 'b partial => 'b partial" ("snd''/'(_,/ _')" [3,3] 999)
X_tail :: "'a List partial => 'a List partial" ("tail/'(_')" [3] 999)
X_takeWhile :: "('a partial => bool) => 'a List partial => 'a List partial"
X_unzip :: "('a * 'b) List partial => 'a List partial * 'b List partial" ("unzip/'(_')" [3] 999)
X_zip :: "'a List partial => 'b List partial => ('a * 'b) List partial"
break :: "('a partial => bool) => 'a List partial => 'a List partial * 'a List partial"
compare :: "'a partial => 'a partial => Ordering partial"
concatMap :: "('a partial => 'b List partial) => 'a List partial => 'b List partial"
delete :: "'e partial => 'e List partial => 'e List partial"
foldl1 :: "('a partial => 'a partial => 'a partial) => 'a List partial => 'a partial"
foldr1 :: "('a partial => 'a partial => 'a partial) => 'a List partial => 'a partial"
otherwiseH :: "bool"
partition :: "('a partial => bool) => 'a List partial => 'a List partial * 'a List partial"
scanl :: "('a partial => 'b partial => 'a partial) => 'a partial => 'b List partial => 'a List partial"
scanl1 :: "('a partial => 'a partial => 'a partial) => 'a List partial => 'a List partial"
scanr :: "('a partial => 'b partial => 'b partial) => 'b partial => 'a List partial => 'b List partial"
scanr1 :: "('a partial => 'a partial => 'a partial) => 'a List partial => 'a List partial"
select :: "('a partial => bool) => 'a partial => 'a List partial * 'a List partial => 'a List partial * 'a List partial"
span :: "('a partial => bool) => 'a List partial => 'a List partial * 'a List partial"
uncurry :: "('a partial => 'b partial => 'c partial) => 'a partial * 'b partial => 'c partial"

axioms
Comp1 [rule_format] :
"ALL f. ALL g. ALL y. X__o__X (f, g) y = f (g y)"

IdDef [rule_format] : "ALL x. id'(x) = x"

FlipDef [rule_format] : "ALL f. ALL x. ALL y. X_flip f y x = f x y"

FstDef [rule_format] : "ALL x. ALL y. fst'(x, y) = x"

SndDef [rule_format] : "ALL x. ALL y. snd'(x, y) = y"

CurryDef [rule_format] :
"ALL g. ALL x. ALL y. X_curry g x y = g (x, y)"

UncurryDef [rule_format] :
"ALL f. ALL x. ALL y. uncurry f (x, y) = f x y"

NotFalse [rule_format] : "Not' False"

NotTrue [rule_format] : "~ Not' True"

AndFalse [rule_format] : "ALL x. ~ False && x"

AndTrue [rule_format] : "ALL x. True && x = x"

AndSym [rule_format] : "ALL x. ALL y. x && y = y && x"

OrDef [rule_format] :
"ALL x. ALL y. x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH"

NotFalse1 [rule_format] : "ALL x. Not' x = (~ x)"

NotTrue1 [rule_format] : "ALL x. ~ Not' x = x"

notNot1 [rule_format] : "ALL x. (~ x) = Not' x"

notNot2 [rule_format] : "ALL x. (~ ~ x) = (~ Not' x)"

EqualTDef [rule_format] : "ALL x. ALL y. x = y --> x ==' y"

EqualSymDef [rule_format] : "ALL x. ALL y. x ==' y = y ==' x"

EqualReflex [rule_format] : "ALL x. x ==' x"

EqualTransT [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & y ==' z --> x ==' z"

DiffDef [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

DiffSymDef [rule_format] : "ALL x. ALL y. x /= y = y /= x"

DiffTDef [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

DiffFDef [rule_format] : "ALL x. ALL y. (~ x /= y) = x ==' y"

TE1 [rule_format] : "ALL x. ALL y. ~ x ==' y --> ~ x = y"

TE2 [rule_format] : "ALL x. ALL y. Not' (x ==' y) = (~ x ==' y)"

TE3 [rule_format] : "ALL x. ALL y. (~ Not' (x ==' y)) = x ==' y"

TE4 [rule_format] : "ALL x. ALL y. (~ x ==' y) = (~ x ==' y)"

IUE1 [rule_format] : "makePartial () ==' makePartial ()"

IUE2 [rule_format] : "~ makePartial () /= makePartial ()"

IBE1 [rule_format] : "makePartial () ==' makePartial ()"

IBE2 [rule_format] : "undefinedOp ==' undefinedOp"

IBE3 [rule_format] : "~ undefinedOp ==' makePartial ()"

IBE4 [rule_format] : "~ makePartial () ==' undefinedOp"

IBE5 [rule_format] : "makePartial () /= undefinedOp"

IBE6 [rule_format] : "undefinedOp /= makePartial ()"

IBE7 [rule_format] : "Not' (makePartial () ==' undefinedOp)"

IBE8 [rule_format] : "~ Not' Not' (makePartial () ==' undefinedOp)"

IOE01 [rule_format] : "makePartial LT ==' makePartial LT"

IOE02 [rule_format] : "makePartial EQ ==' makePartial EQ"

IOE03 [rule_format] : "makePartial GT ==' makePartial GT"

IOE04 [rule_format] : "~ makePartial LT ==' makePartial EQ"

IOE05 [rule_format] : "~ makePartial LT ==' makePartial GT"

IOE06 [rule_format] : "~ makePartial EQ ==' makePartial GT"

IOE07 [rule_format] : "makePartial LT /= makePartial EQ"

IOE08 [rule_format] : "makePartial LT /= makePartial GT"

IOE09 [rule_format] : "makePartial EQ /= makePartial GT"

LeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y --> ~ x <' y"

LeTAsymmetry [rule_format] : "ALL x. ALL y. x <' y --> ~ y <' x"

LeTTransitive [rule_format] :
"ALL x. ALL y. ALL z. x <' y & y <' z --> x <' z"

LeTTotal [rule_format] :
"ALL x. ALL y. (x <' y | y <' x) | x ==' y"

GeDef [rule_format] : "ALL x. ALL y. x >' y = y <' x"

GeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y --> ~ x >' y"

GeTAsymmetry [rule_format] : "ALL x. ALL y. x >' y --> ~ y >' x"

GeTTransitive [rule_format] :
"ALL x. ALL y. ALL z. (x >' y) && (y >' z) --> x >' z"

GeTTotal [rule_format] :
"ALL x. ALL y. ((x >' y) || (y >' x)) || (x ==' y)"

LeqDef [rule_format] :
"ALL x. ALL y. x <=' y = (x <' y) || (x ==' y)"

LeqReflexivity [rule_format] : "ALL x. x <=' x"

LeqTTransitive [rule_format] :
"ALL x. ALL y. ALL z. (x <=' y) && (y <=' z) --> x <=' z"

LeqTTotal [rule_format] :
"ALL x. ALL y. (x <=' y) && (y <=' x) = x ==' y"

GeqDef [rule_format] :
"ALL x. ALL y. x >=' y = (x >' y) || (x ==' y)"

GeqReflexivity [rule_format] : "ALL x. x >=' x"

GeqTTransitive [rule_format] :
"ALL x. ALL y. ALL z. (x >=' y) && (y >=' z) --> x >=' z"

GeqTTotal [rule_format] :
"ALL x. ALL y. (x >=' y) && (y >=' x) = x ==' y"

EqTSOrdRel [rule_format] :
"ALL x. ALL y. x ==' y = (~ x <' y & ~ x >' y)"

EqFSOrdRel [rule_format] :
"ALL x. ALL y. (~ x ==' y) = (x <' y | x >' y)"

EqTOrdRel [rule_format] :
"ALL x. ALL y. x ==' y = (x <=' y & x >=' y)"

EqFOrdRel [rule_format] :
"ALL x. ALL y. (~ x ==' y) = (x <=' y | x >=' y)"

EqTOrdTSubstE [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & y <' z --> x <' z"

EqTOrdFSubstE [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & ~ y <' z --> ~ x <' z"

EqTOrdTSubstD [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & z <' y --> z <' x"

EqTOrdFSubstD [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & ~ z <' y --> ~ z <' x"

LeTGeFEqFRel [rule_format] :
"ALL x. ALL y. x <' y = (~ x >' y & ~ x ==' y)"

LeFGeTEqTRel [rule_format] :
"ALL x. ALL y. (~ x <' y) = (x >' y | x ==' y)"

LeTGeTRel [rule_format] : "ALL x. ALL y. x <' y = y >' x"

LeFGeFRel [rule_format] : "ALL x. ALL y. (~ x <' y) = (~ y >' x)"

LeqTGetTRel [rule_format] : "ALL x. ALL y. x <=' y = y >=' x"

LeqFGetFRel [rule_format] :
"ALL x. ALL y. (~ x <=' y) = (~ y >=' x)"

GeTLeTRel [rule_format] : "ALL x. ALL y. x >' y = y <' x"

GeFLeFRel [rule_format] : "ALL x. ALL y. (~ x >' y) = (~ y <' x)"

GeqTLeqTRel [rule_format] : "ALL x. ALL y. x >=' y = y <=' x"

GeqFLeqFRel [rule_format] :
"ALL x. ALL y. (~ x >=' y) = (~ y <=' x)"

LeqTGeFRel [rule_format] : "ALL x. ALL y. x <=' y = (~ x >' y)"

LeqFGeTRel [rule_format] : "ALL x. ALL y. (~ x <=' y) = x >' y"

GeTLeFEqFRel [rule_format] :
"ALL x. ALL y. x >' y = (~ x <' y & ~ x ==' y)"

GeFLeTEqTRel [rule_format] :
"ALL x. ALL y. (~ x >' y) = (x <' y | x ==' y)"

GeqTLeFRel [rule_format] : "ALL x. ALL y. x >=' y = (~ x <' y)"

GeqFLeTRel [rule_format] : "ALL x. ALL y. (~ x >=' y) = x <' y"

LeqTLeTEqTRel [rule_format] :
"ALL x. ALL y. x <=' y = (x <' y | x ==' y)"

LeqFLeFEqFRel [rule_format] :
"ALL x. ALL y. (~ x <=' y) = (~ x <' y & ~ x ==' y)"

GeqTGeTEqTRel [rule_format] :
"ALL x. ALL y. x >=' y = (x >' y | x ==' y)"

GeqFGeFEqFRel [rule_format] :
"ALL x. ALL y. (~ x >=' y) = (~ x >' y & ~ x ==' y)"

LeTGeqFRel [rule_format] : "ALL x. ALL y. x <' y = (~ x >=' y)"

GeTLeqFRel [rule_format] : "ALL x. ALL y. x >' y = (~ x <=' y)"

LeLeqDiff [rule_format] :
"ALL x. ALL y. x <' y = (x <=' y) && (x /= y)"

CmpLTDef [rule_format] :
"ALL x. ALL y. compare x y ==' makePartial LT = x <' y"

CmpEQDef [rule_format] :
"ALL x. ALL y. compare x y ==' makePartial EQ = x ==' y"

CmpGTDef [rule_format] :
"ALL x. ALL y. compare x y ==' makePartial GT = x >' y"

MaxYDef [rule_format] : "ALL x. ALL y. X_max x y ==' y = x <=' y"

MaxXDef [rule_format] : "ALL x. ALL y. X_max x y ==' x = y <=' x"

MinXDef [rule_format] : "ALL x. ALL y. X_min x y ==' x = x <=' y"

MinYDef [rule_format] : "ALL x. ALL y. X_min x y ==' y = y <=' x"

MaxSym [rule_format] :
"ALL x. ALL y. X_max x y ==' y = X_max y x ==' y"

MinSym [rule_format] :
"ALL x. ALL y. X_min x y ==' y = X_min y x ==' y"

TO1 [rule_format] : "ALL x. ALL y. (x ==' y | x <' y) = x <=' y"

TO2 [rule_format] : "ALL x. ALL y. x ==' y --> ~ x <' y"

TO3 [rule_format] :
"ALL x. ALL y. Not' Not' (x <' y) | Not' (x <' y)"

TO4 [rule_format] : "ALL x. ALL y. x <' y --> Not' (x ==' y)"

TO5 [rule_format] :
"ALL w. ALL x. ALL y. ALL z. (x <' y & y <' z) & z <' w --> x <' w"

TO6 [rule_format] : "ALL x. ALL z. z <' x --> Not' (x <' z)"

TO7 [rule_format] : "ALL x. ALL y. x <' y = y >' x"

IUO01 [rule_format] : "makePartial () <=' makePartial ()"

IUO02 [rule_format] : "~ makePartial () <' makePartial ()"

IUO03 [rule_format] : "makePartial () >=' makePartial ()"

IUO04 [rule_format] : "~ makePartial () >' makePartial ()"

IUO05 [rule_format] :
"X_max (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO06 [rule_format] :
"X_min (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO07 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IOO13 [rule_format] : "makePartial LT <' makePartial EQ"

IOO14 [rule_format] : "makePartial EQ <' makePartial GT"

IOO15 [rule_format] : "makePartial LT <' makePartial GT"

IOO16 [rule_format] : "makePartial LT <=' makePartial EQ"

IOO17 [rule_format] : "makePartial EQ <=' makePartial GT"

IOO18 [rule_format] : "makePartial LT <=' makePartial GT"

IOO19 [rule_format] : "makePartial EQ >=' makePartial LT"

IOO20 [rule_format] : "makePartial GT >=' makePartial EQ"

IOO21 [rule_format] : "makePartial GT >=' makePartial LT"

IOO22 [rule_format] : "makePartial EQ >' makePartial LT"

IOO23 [rule_format] : "makePartial GT >' makePartial EQ"

IOO24 [rule_format] : "makePartial GT >' makePartial LT"

IOO25 [rule_format] :
"X_max (makePartial LT) (makePartial EQ) ==' makePartial EQ"

IOO26 [rule_format] :
"X_max (makePartial EQ) (makePartial GT) ==' makePartial GT"

IOO27 [rule_format] :
"X_max (makePartial LT) (makePartial GT) ==' makePartial GT"

IOO28 [rule_format] :
"X_min (makePartial LT) (makePartial EQ) ==' makePartial LT"

IOO29 [rule_format] :
"X_min (makePartial EQ) (makePartial GT) ==' makePartial EQ"

IOO30 [rule_format] :
"X_min (makePartial LT) (makePartial GT) ==' makePartial LT"

IOO31 [rule_format] :
"compare (makePartial LT) (makePartial LT) ==' makePartial EQ"

IOO32 [rule_format] :
"compare (makePartial EQ) (makePartial EQ) ==' makePartial EQ"

IOO33 [rule_format] :
"compare (makePartial GT) (makePartial GT) ==' makePartial EQ"

IBO5 [rule_format] : "undefinedOp <' makePartial ()"

IBO6 [rule_format] : "~ undefinedOp >=' makePartial ()"

IBO7 [rule_format] : "makePartial () >=' undefinedOp"

IBO8 [rule_format] : "~ makePartial () <' undefinedOp"

IBO9 [rule_format] :
"X_max undefinedOp (makePartial ()) ==' makePartial ()"

IBO10 [rule_format] :
"X_min undefinedOp (makePartial ()) ==' undefinedOp"

IBO11 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IBO12 [rule_format] :
"compare undefinedOp undefinedOp ==' makePartial EQ"

NotDefHead [rule_format] : "~ defOp (head(makePartial Nil'))"

HeadDef [rule_format] :
"ALL x. ALL xs. head(makePartial (X_Cons x xs)) = x"

NotDefTail [rule_format] : "~ defOp (tail(makePartial Nil'))"

TailDef [rule_format] :
"ALL x. ALL xs. tail(makePartial (X_Cons x xs)) = xs"

FoldrNil [rule_format] :
"ALL f. ALL s. X_foldr f s (makePartial Nil') = s"

FoldrCons [rule_format] :
"ALL f.
 ALL s.
 ALL x.
 ALL xs.
 X_foldr f s (makePartial (X_Cons x xs)) = f x (X_foldr f s xs)"

FoldlNil [rule_format] :
"ALL g. ALL t. X_foldl g t (makePartial Nil') = t"

FoldlCons [rule_format] :
"ALL g.
 ALL t.
 ALL z.
 ALL zs.
 X_foldl g t (makePartial (X_Cons z zs)) = X_foldl g (g t z) zs"

MapNil [rule_format] :
"ALL h. X_map h (makePartial Nil') = makePartial Nil'"

MapCons [rule_format] :
"ALL h.
 ALL x.
 ALL xs.
 X_map h (makePartial (X_Cons x xs)) =
 makePartial (X_Cons (h x) (X_map h xs))"

XPlusXPlusNil [rule_format] : "ALL l. makePartial Nil' ++' l = l"

XPlusXPlusCons [rule_format] :
"ALL l.
 ALL x.
 ALL xs.
 makePartial (X_Cons x xs) ++' l =
 makePartial (X_Cons x (xs ++' l))"

FilterNil [rule_format] :
"ALL p. X_filter p (makePartial Nil') = makePartial Nil'"

FilterConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x -->
 X_filter p (makePartial (X_Cons x xs)) =
 makePartial (X_Cons x (X_filter p xs))"

FilterConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ~ p x --> X_filter p (makePartial (X_Cons x xs)) = X_filter p xs"

ZipNil [rule_format] :
"ALL l. X_zip (makePartial Nil') l = makePartial Nil'"

ZipConsNil [rule_format] :
"ALL l.
 ALL x.
 ALL xs.
 l = makePartial Nil' -->
 X_zip (makePartial (X_Cons x xs)) l = makePartial Nil'"

ZipConsCons [rule_format] :
"ALL l.
 ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 l = makePartial (X_Cons y ys) -->
 X_zip (makePartial (X_Cons x xs)) l =
 makePartial
 (X_Cons
  (restrictOp (makePartial (makeTotal x, makeTotal y))
   (defOp x & defOp y))
  (X_zip xs ys))"

UnzipNil [rule_format] :
"mapSnd makeTotal (mapFst makeTotal (unzip(makePartial Nil'))) =
 (Nil', Nil')"

UnzipCons [rule_format] :
"ALL ps.
 ALL x.
 ALL z.
 mapSnd makeTotal
 (mapFst makeTotal
  (unzip(makePartial
         (X_Cons
          (restrictOp (makePartial (makeTotal x, makeTotal z))
           (defOp x & defOp z))
          ps)))) =
 (let (ys, zs) = unzip(ps) in (X_Cons x ys, X_Cons z zs))"

ILE01 [rule_format] : "makePartial Nil' ==' makePartial Nil'"

ILE02 [rule_format] :
"ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 makePartial (X_Cons x xs) ==' makePartial (X_Cons y ys) =
 (x ==' y) && (xs ==' ys)"

ILO01 [rule_format] : "~ makePartial Nil' <' makePartial Nil'"

ILO02 [rule_format] : "makePartial Nil' <=' makePartial Nil'"

ILO03 [rule_format] : "~ makePartial Nil' >' makePartial Nil'"

ILO04 [rule_format] : "makePartial Nil' >=' makePartial Nil'"

ILO05 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 z <' w --> makePartial (X_Cons z zs) <' makePartial (X_Cons w ws)"

ILO06 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 z ==' w -->
 makePartial (X_Cons z zs) <' makePartial (X_Cons w ws) = zs <' ws"

ILO07 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 ~ z <' w & ~ z ==' w -->
 ~ makePartial (X_Cons z zs) <' makePartial (X_Cons w ws)"

ILO08 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons z zs) <=' makePartial (X_Cons w ws) =
 (makePartial (X_Cons z zs) <' makePartial (X_Cons w ws)) ||
 (makePartial (X_Cons z zs) ==' makePartial (X_Cons w ws))"

ILO09 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons z zs) >' makePartial (X_Cons w ws) =
 makePartial (X_Cons w ws) <' makePartial (X_Cons z zs)"

ILO10 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons z zs) >=' makePartial (X_Cons w ws) =
 (makePartial (X_Cons z zs) >' makePartial (X_Cons w ws)) ||
 (makePartial (X_Cons z zs) ==' makePartial (X_Cons w ws))"

ILO11 [rule_format] :
"compare (makePartial Nil') (makePartial Nil') ==' makePartial EQ =
 makePartial Nil' ==' makePartial Nil'"

ILO12 [rule_format] :
"compare (makePartial Nil') (makePartial Nil') ==' makePartial LT =
 makePartial Nil' <' makePartial Nil'"

ILO13 [rule_format] :
"compare (makePartial Nil') (makePartial Nil') ==' makePartial GT =
 makePartial Nil' >' makePartial Nil'"

ILO14 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 compare (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial EQ =
 makePartial (X_Cons z zs) ==' makePartial (X_Cons w ws)"

ILO15 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 compare (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial LT =
 makePartial (X_Cons z zs) <' makePartial (X_Cons w ws)"

ILO16 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 compare (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial GT =
 makePartial (X_Cons z zs) >' makePartial (X_Cons w ws)"

ILO17 [rule_format] :
"X_max (makePartial Nil') (makePartial Nil') ==' makePartial Nil' =
 makePartial Nil' <=' makePartial Nil'"

ILO18 [rule_format] :
"X_min (makePartial Nil') (makePartial Nil') ==' makePartial Nil' =
 makePartial Nil' <=' makePartial Nil'"

ILO19 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons z zs) <=' makePartial (X_Cons w ws) =
 X_max (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial (X_Cons w ws)"

ILO20 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons w ws) <=' makePartial (X_Cons z zs) =
 X_max (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial (X_Cons z zs)"

ILO21 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons z zs) <=' makePartial (X_Cons w ws) =
 X_min (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial (X_Cons z zs)"

ILO22 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 makePartial (X_Cons w ws) <=' makePartial (X_Cons z zs) =
 X_min (makePartial (X_Cons z zs)) (makePartial (X_Cons w ws)) =='
 makePartial (X_Cons w ws)"

FoldlDecomp [rule_format] :
"ALL e.
 ALL i.
 ALL ts.
 ALL ys. X_foldl i e (ys ++' ts) = X_foldl i (X_foldl i e ys) ts"

MapDecomp [rule_format] :
"ALL f.
 ALL xs. ALL zs. X_map f (xs ++' zs) = X_map f xs ++' X_map f zs"

MapFunctor [rule_format] :
"ALL f.
 ALL g. ALL xs. X_map (X__o__X (g, f)) xs = X_map g (X_map f xs)"

FilterProm [rule_format] :
"ALL f.
 ALL p.
 ALL xs.
 X_filter p (X_map f xs) =
 X_map f (X_filter (id o defOp o X__o__X (bool2partial o p, f)) xs)"

InitNil [rule_format] : "~ defOp (init(makePartial Nil'))"

InitConsNil [rule_format] :
"ALL x.
 init(makePartial (X_Cons x (makePartial Nil'))) = makePartial Nil'"

InitConsCons [rule_format] :
"ALL x.
 ALL xs.
 init(makePartial (X_Cons x xs)) =
 makePartial (X_Cons x (init(xs)))"

LastNil [rule_format] : "~ defOp (last'(makePartial Nil'))"

LastConsNil [rule_format] :
"ALL x. last'(makePartial (X_Cons x (makePartial Nil'))) = x"

LastConsCons [rule_format] :
"ALL x. ALL xs. last'(makePartial (X_Cons x xs)) = last'(xs)"

NullNil [rule_format] : "null'(makePartial Nil')"

NullCons [rule_format] :
"ALL x. ALL xs. ~ null'(makePartial (X_Cons x xs))"

ReverseNil [rule_format] :
"reverse(makePartial Nil') = makePartial Nil'"

ReverseCons [rule_format] :
"ALL x.
 ALL xs.
 reverse(makePartial (X_Cons x xs)) =
 reverse(xs) ++' makePartial (X_Cons x (makePartial Nil'))"

Foldr1Nil [rule_format] :
"ALL f. ~ defOp (foldr1 f (makePartial Nil'))"

Foldr1ConsNil [rule_format] :
"ALL f.
 ALL x. foldr1 f (makePartial (X_Cons x (makePartial Nil'))) = x"

Foldr1ConsCons [rule_format] :
"ALL f.
 ALL x.
 ALL xs. foldr1 f (makePartial (X_Cons x xs)) = f x (foldr1 f xs)"

Foldl1Nil [rule_format] :
"ALL f. ~ defOp (foldl1 f (makePartial Nil'))"

Foldl1ConsNil [rule_format] :
"ALL f.
 ALL x. foldl1 f (makePartial (X_Cons x (makePartial Nil'))) = x"

Foldl1ConsCons [rule_format] :
"ALL f.
 ALL x.
 ALL xs. foldl1 f (makePartial (X_Cons x xs)) = f x (foldr1 f xs)"

ScanlNil [rule_format] :
"ALL g.
 ALL q.
 ALL xs.
 xs = makePartial Nil' -->
 scanl g q xs = makePartial (X_Cons q (makePartial Nil'))"

ScanlCons [rule_format] :
"ALL g.
 ALL q.
 ALL r.
 ALL rs.
 ALL xs.
 xs = makePartial (X_Cons r rs) -->
 scanl g q xs = makePartial (X_Cons q (scanl g (g q r) rs))"

Scanl1Nil [rule_format] :
"ALL f. scanl1 f (makePartial Nil') = makePartial Nil'"

Scanl1Cons [rule_format] :
"ALL f.
 ALL x. ALL xs. scanl1 f (makePartial (X_Cons x xs)) = scanl f x xs"

ScanrNil [rule_format] :
"ALL h.
 ALL q.
 scanr h q (makePartial Nil') =
 makePartial (X_Cons q (makePartial Nil'))"

ScanrCons [rule_format] :
"ALL h.
 ALL q.
 ALL r.
 ALL rs.
 ALL x.
 ALL xs.
 makePartial (X_Cons r rs) = scanr h q xs -->
 scanr h q (makePartial (X_Cons x xs)) =
 makePartial (X_Cons (h x r) (makePartial (X_Cons r rs)))"

Scanr1Nil [rule_format] :
"ALL f. scanr1 f (makePartial Nil') = makePartial Nil'"

Scanr1ConsNil [rule_format] :
"ALL f.
 ALL x.
 scanr1 f (makePartial (X_Cons x (makePartial Nil'))) =
 makePartial (X_Cons x (makePartial Nil'))"

Scanr1ConsCons [rule_format] :
"ALL f.
 ALL q.
 ALL qs.
 ALL x.
 ALL xs.
 makePartial (X_Cons q qs) = scanr1 f xs -->
 scanr1 f (makePartial (X_Cons x xs)) =
 makePartial (X_Cons (f x q) (makePartial (X_Cons q qs)))"

ScanlProperty [rule_format] :
"ALL g. ALL x. ALL xs. last'(scanl g x xs) = X_foldl g x xs"

ScanrProperty [rule_format] :
"ALL h. ALL x. ALL xs. head(scanr h x xs) = X_foldr h x xs"

ConcatDef [rule_format] :
"ALL xxs.
 concat'(xxs) =
 X_foldr (X_curry (uncurryOp X__XPlusXPlus__X)) (makePartial Nil')
 xxs"

ConcatMapDef [rule_format] :
"ALL g. ALL xs. concatMap g xs = concat'(X_map g xs)"

MaximunNil [rule_format] : "~ defOp (maximum(makePartial Nil'))"

MaximumDef [rule_format] : "ALL ds. maximum(ds) = foldl1 X_max ds"

MinimunNil [rule_format] : "~ defOp (minimum(makePartial Nil'))"

MinimumDef [rule_format] : "ALL ds. minimum(ds) = foldl1 X_min ds"

TakeWhileNil [rule_format] :
"ALL p. X_takeWhile p (makePartial Nil') = makePartial Nil'"

TakeWhileConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x -->
 X_takeWhile p (makePartial (X_Cons x xs)) =
 makePartial (X_Cons x (X_takeWhile p xs))"

TakeWhileConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ~ p x -->
 X_takeWhile p (makePartial (X_Cons x xs)) = makePartial Nil'"

DropWhileNil [rule_format] :
"ALL p. X_dropWhile p (makePartial Nil') = makePartial Nil'"

DropWhileConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x -->
 X_dropWhile p (makePartial (X_Cons x xs)) = X_dropWhile p xs"

DropWhileConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ~ p x -->
 X_dropWhile p (makePartial (X_Cons x xs)) =
 makePartial (X_Cons x xs)"

SpanNil [rule_format] :
"ALL p.
 mapSnd makeTotal (mapFst makeTotal (span p (makePartial Nil'))) =
 (Nil', Nil')"

SpanConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x -->
 mapSnd makeTotal
 (mapFst makeTotal (span p (makePartial (X_Cons x xs)))) =
 mapSnd makeTotal (let (ys, zs) = span p xs in (X_Cons x ys, zs))"

SpanConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ~ p x -->
 mapSnd makeTotal
 (mapFst makeTotal (span p (makePartial (X_Cons x xs)))) =
 (let (ys, zs) = span p xs in (Nil', X_Cons x xs))"

SpanThm [rule_format] :
"ALL p.
 ALL xs.
 makePartial (mapSnd makeTotal (mapFst makeTotal (span p xs))) =
 restrictOp
 (makePartial
  (makeTotal (X_takeWhile p xs), makeTotal (X_dropWhile p xs)))
 (defOp (X_takeWhile p xs) & defOp (X_dropWhile p xs))"

BreakDef [rule_format] :
"ALL p.
 ALL xs.
 mapSnd makeTotal (mapFst makeTotal (break p xs)) =
 mapSnd makeTotal
 (mapFst makeTotal
  (let q =
       id o defOp o
       X__o__X (bool2partial o Not__X o defOp, bool2partial o p)
   in span q xs))"

BreakThm [rule_format] :
"ALL p.
 ALL xs.
 mapSnd makeTotal (mapFst makeTotal (break p xs)) =
 mapSnd makeTotal
 (mapFst makeTotal
  (span
   (id o defOp o
    X__o__X (bool2partial o Not__X o defOp, bool2partial o p))
   xs))"

InsertNil [rule_format] :
"ALL q.
 X_insert q (makePartial Nil') =
 makePartial (X_Cons q (makePartial Nil'))"

InsertCons1 [rule_format] :
"ALL q.
 ALL r.
 ALL rs.
 q <=' r -->
 X_insert q (makePartial (X_Cons r rs)) =
 makePartial (X_Cons q (makePartial (X_Cons r rs)))"

InsertCons2 [rule_format] :
"ALL q.
 ALL r.
 ALL rs.
 q >' r -->
 X_insert q (makePartial (X_Cons r rs)) =
 makePartial (X_Cons r (X_insert q rs))"

DeleteNil [rule_format] :
"ALL s. delete s (makePartial Nil') = makePartial Nil'"

DeleteConsT [rule_format] :
"ALL s.
 ALL t.
 ALL ts. s ==' t --> delete s (makePartial (X_Cons t ts)) = ts"

DeleteConsF [rule_format] :
"ALL s.
 ALL t.
 ALL ts.
 ~ s ==' t -->
 delete s (makePartial (X_Cons t ts)) =
 makePartial (X_Cons t (delete s ts))"

SelectT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ALL ys.
 p x -->
 makePartial
 (mapSnd makeTotal (mapFst makeTotal (select p x (xs, ys)))) =
 restrictOp (makePartial (X_Cons x xs, makeTotal ys)) (defOp ys)"

SelectF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ALL ys.
 ~ p x -->
 makePartial
 (mapSnd makeTotal (mapFst makeTotal (select p x (xs, ys)))) =
 restrictOp (makePartial (makeTotal xs, X_Cons x ys)) (defOp xs)"

Partition [rule_format] :
"ALL p.
 ALL xs.
 makePartial
 (mapSnd makeTotal (mapFst makeTotal (partition p xs))) =
 X_foldr
 (comp (makePartial o (mapSnd makeTotal o mapFst makeTotal)) o
  flip comp (mapFst makePartial o mapSnd makePartial o makeTotal) o
  select p)
 (makePartial (Nil', Nil')) xs"

declare Comp1 [simp]
declare IdDef [simp]
declare FlipDef [simp]
declare FstDef [simp]
declare SndDef [simp]
declare CurryDef [simp]
declare UncurryDef [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare OtherwiseDef [simp]
declare NotTrue1 [simp]
declare EqualReflex [simp]
declare IUE1 [simp]
declare IUE2 [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IUO01 [simp]
declare IUO02 [simp]
declare IUO03 [simp]
declare IUO04 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare NotDefHead [simp]
declare HeadDef [simp]
declare NotDefTail [simp]
declare TailDef [simp]
declare FoldrNil [simp]
declare FoldrCons [simp]
declare FoldlNil [simp]
declare FoldlCons [simp]
declare MapNil [simp]
declare XPlusXPlusNil [simp]
declare FilterNil [simp]
declare FilterConsF [simp]
declare ZipNil [simp]
declare UnzipNil [simp]
declare ILE01 [simp]
declare ILE02 [simp]
declare ILO01 [simp]
declare ILO02 [simp]
declare ILO03 [simp]
declare ILO04 [simp]
declare ILO05 [simp]
declare ILO06 [simp]
declare ILO11 [simp]
declare ILO12 [simp]
declare ILO13 [simp]
declare ILO14 [simp]
declare ILO15 [simp]
declare ILO16 [simp]
declare ILO17 [simp]
declare ILO18 [simp]
declare InitNil [simp]
declare InitConsNil [simp]
declare LastNil [simp]
declare LastConsNil [simp]
declare LastConsCons [simp]
declare NullNil [simp]
declare NullCons [simp]
declare ReverseNil [simp]
declare Foldr1Nil [simp]
declare Foldr1ConsNil [simp]
declare Foldr1ConsCons [simp]
declare Foldl1Nil [simp]
declare Foldl1ConsNil [simp]
declare Foldl1ConsCons [simp]
declare Scanl1Nil [simp]
declare Scanl1Cons [simp]
declare Scanr1Nil [simp]
declare Scanr1ConsNil [simp]
declare ScanlProperty [simp]
declare ScanrProperty [simp]
declare MaximunNil [simp]
declare MinimunNil [simp]
declare TakeWhileNil [simp]
declare TakeWhileConsF [simp]
declare DropWhileNil [simp]
declare DropWhileConsT [simp]
declare DropWhileConsF [simp]
declare SpanNil [simp]
declare DeleteNil [simp]
declare DeleteConsT [simp]
declare SelectT [simp]
declare SelectF [simp]

theorem PartitionProp :
"ALL p.
 ALL xs.
 makePartial
 (mapSnd makeTotal (mapFst makeTotal (partition p xs))) =
 restrictOp
 (makePartial
  (makeTotal (X_filter p xs),
   makeTotal
   (X_filter
    (id o defOp o
     X__o__X (bool2partial o Not__X o defOp, bool2partial o p))
    xs)))
 (defOp (X_filter p xs) &
  defOp
  (X_filter
   (id o defOp o
    X__o__X (bool2partial o Not__X o defOp, bool2partial o p))
   xs))"
oops

ML "Header.record \"PartitionProp\""

end


chapter {* Define correspondence between two non-deterministic monads with failure *}

theory NondetCorres
imports
  CorresExtras
  NondetExtensions
begin

lemma corres_LI[dest]:
  fixes C A R I\<^sub>A I\<^sub>C nf\<^sub>C m\<^sub>A m\<^sub>C
  assumes ndA: "Run A = lift_nd m\<^sub>A"
      and ndC: "Run C = lift_nd m\<^sub>C"
      and init: "\<forall>s. Init C s \<subseteq> (R \<inter> I\<^sub>A \<times> I\<^sub>C) `` Init A s"
      and corres: "corres_underlying R False nf\<^sub>C \<top>\<top>
                  (\<lambda>s\<^sub>A. s\<^sub>A \<in> I\<^sub>A) (\<lambda>s\<^sub>C. s\<^sub>C \<in> I\<^sub>C) m\<^sub>A m\<^sub>C"
      and fin:  "\<forall>s s'. (s, s') \<in> R \<inter> I\<^sub>A \<times> I\<^sub>C \<longrightarrow> Fin C s' = Fin A s"
  shows "LI A C R (I\<^sub>A \<times> I\<^sub>C)"
proof -
  have "\<forall>s. Init C s \<subseteq> R `` Init A s" using init by auto
  moreover have "R \<inter> I\<^sub>A \<times> I\<^sub>C ;;; Run C \<subseteq> Run A ;;; R" unfolding rel_semi_def
  proof safe
    fix s\<^sub>A s\<^sub>C s\<^sub>C'
    assume "s\<^sub>A \<in> I\<^sub>A" and "s\<^sub>C \<in> I\<^sub>C" and "(s\<^sub>A, s\<^sub>C) \<in> R" and "(s\<^sub>C, s\<^sub>C') \<in> Run C"
    hence "\<forall>(r', s\<^sub>C') \<in> fst (m\<^sub>C s\<^sub>C). \<exists>(r, s\<^sub>A') \<in> fst (m\<^sub>A s\<^sub>A). (s\<^sub>A', s\<^sub>C') \<in> R"
      and "nf\<^sub>C \<longrightarrow> \<not> snd (m\<^sub>C s\<^sub>C)" using corres unfolding corres_underlying_def by auto
    moreover from ndC and `(s\<^sub>C, s\<^sub>C') \<in> Run C` have "\<exists>r. (r, s\<^sub>C') \<in> fst (m\<^sub>C s\<^sub>C)"
      unfolding lift_nd_def mresults_def by auto
    ultimately have "\<exists>(r, s\<^sub>A') \<in> fst (m\<^sub>A s\<^sub>A). (s\<^sub>A', s\<^sub>C') \<in> R" by auto
    then obtain r and s\<^sub>A' where "(r, s\<^sub>A') \<in> fst (m\<^sub>A s\<^sub>A)" and "(s\<^sub>A', s\<^sub>C') \<in> R" by auto
    with ndA have "(s\<^sub>A, s\<^sub>A') \<in> Run A" unfolding lift_nd_def mresults_def by auto
    with `(s\<^sub>A', s\<^sub>C') \<in> R` show "(s\<^sub>A, s\<^sub>C') \<in> Run A O R" by auto
  qed
  moreover have "\<forall>s s'. (s, s') \<in> R \<inter> I\<^sub>A \<times> I\<^sub>C \<longrightarrow> Fin C s' = Fin A s" using fin by auto
  ultimately show ?thesis unfolding LI_def by simp
qed

end


(*  Author: Tobias Nipkow  *)

section \<open>Comparing Enumeration and Archive\<close>

theory ArchCompAux
imports TameEnum Trie.Tries Maps Arch Worklist
begin

function qsort :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"qsort le []       = []" |
"qsort le (x#xs) = qsort le [y\<leftarrow>xs . \<not> le x y] @ [x] @
                   qsort le [y\<leftarrow>xs . le x y]"
by pat_completeness auto
termination by (relation "measure (size \<circ> snd)")
  (auto simp add: length_filter_le [THEN le_less_trans])

definition nof_vertices :: "'a fgraph \<Rightarrow> nat" where
"nof_vertices = length \<circ> remdups \<circ> concat"

definition fgraph :: "graph \<Rightarrow> nat fgraph" where
"fgraph g = map vertices (faces g)"

definition hash :: "nat fgraph \<Rightarrow> nat list" where
  "hash fs = (let n = nof_vertices fs in
     [n, size fs] @
     qsort (\<lambda>x y. y < x) (map (\<lambda>i. foldl (+) 0 (map size [f\<leftarrow>fs. i \<in> set f]))
                             [0..<n]))"
(*
definition diff2 :: "nat fgraph list \<Rightarrow> nat fgraph list
   \<Rightarrow> nat fgraph list * nat fgraph list" where
"diff2 fgs ags =
 (let tfgs = trie_of_list hash fgs;
      tags = trie_of_list hash ags in
  (filter (\<lambda>fg. \<not>list_ex (iso_test fg) (lookup_trie tags (hash fg))) fgs,
   filter (\<lambda>ag. \<not>list_ex (iso_test ag) (lookup_trie tfgs (hash ag))) ags))"
*)
definition samet :: "(nat,nat fgraph) tries option \<Rightarrow> nat fgraph list \<Rightarrow> bool"
where
  "samet fgto ags = (case fgto of None \<Rightarrow> False | Some tfgs \<Rightarrow>
   let tags = tries_of_list hash ags in
   (all_tries (\<lambda>fg. list_ex (iso_test fg) (lookup_tries tags (hash fg))) tfgs \<and>
    all_tries (\<lambda>ag. list_ex (iso_test ag) (lookup_tries tfgs (hash ag))) tags))"

definition pre_iso_test :: "vertex fgraph \<Rightarrow> bool" where
  "pre_iso_test Fs \<longleftrightarrow>
   [] \<notin> set Fs \<and> (\<forall>F\<in>set Fs. distinct F) \<and> distinct (map rotate_min Fs)"

interpretation map:
  maps "Trie None []" update_trie lookup_tries invar_trie
proof (standard, goal_cases)
  case 1 show ?case by(rule ext) simp
next
  case 2 show ?case by(rule ext) (simp add: lookup_update)
next
  case 3 show ?case by(simp)
next
  case 4 thus ?case by (simp add: invar_trie_update)
qed

lemma set_of_conv: "set_tries = maps.set_of lookup_tries"
by(rule ext) (auto simp add: set_tries_def map.set_of_def)

end