| @@ -0,0 +1,118 @@ |
| 1 | +theory Protocol |
| 2 | + imports Execution |
| 3 | +begin |
| 4 | + |
| 5 | +definition commit :: "pager \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> pager" where |
| 6 | + "commit s k offset byte = |
| 7 | + s\<lparr>physical := (physical s)(ptable s k := (view s k)(offset := byte))\<rparr>" |
| 8 | + |
| 9 | +definition attempt :: "pager \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> pager option" where |
| 10 | + "attempt s k offset byte = (if writable s k then Some (commit s k offset byte) else None)" |
| 11 | + |
| 12 | +lemma readonly_faults: |
| 13 | + "\<not> writable s k \<Longrightarrow> attempt s k offset byte = None" |
| 14 | + by (simp add: attempt_def) |
| 15 | + |
| 16 | +lemma writable_commits: |
| 17 | + "writable s k \<Longrightarrow> attempt s k offset byte = Some (store s k offset byte)" |
| 18 | + by (simp add: attempt_def commit_def store_def prepare_def) |
| 19 | + |
| 20 | +lemma resolve_preserves_memory: |
| 21 | + "invariant n s \<Longrightarrow> j < n \<Longrightarrow> view (detach s k) j = view s j" |
| 22 | + using detach_view[of n s j k] by (auto simp: invariant_def) |
| 23 | + |
| 24 | +theorem fault_retry: |
| 25 | + "\<not> writable s k \<Longrightarrow> |
| 26 | + attempt (detach s k) k offset byte = Some (store s k offset byte)" |
| 27 | + by (simp add: attempt_def commit_def store_def prepare_def detach_def) |
| 28 | + |
| 29 | +theorem fault_retry_refinement: |
| 30 | + assumes "invariant n s" "represents n s m" "k < n" "\<not> writable s k" |
| 31 | + obtains t where "attempt (detach s k) k offset byte = Some t" |
| 32 | + "invariant n t" "represents n t (reference_write m k offset byte)" |
| 33 | + using assms fault_retry write_invariant simulation by blast |
| 34 | + |
| 35 | +definition dirty :: "nat \<Rightarrow> pager \<Rightarrow> nat set" where |
| 36 | + "dirty n s = {k. k < n \<and> writable s k}" |
| 37 | + |
| 38 | +lemma finite_dirty [simp]: "finite (dirty n s)" |
| 39 | + unfolding dirty_def by (rule finite_subset[of _ "{..<n}"]) auto |
| 40 | + |
| 41 | +lemma dirty_initial [simp]: "dirty n (initial pages contents) = {}" |
| 42 | + by (auto simp: dirty_def) |
| 43 | + |
| 44 | +lemma dirty_member [simp]: "k \<in> dirty n s \<longleftrightarrow> k < n \<and> writable s k" |
| 45 | + by (simp add: dirty_def) |
| 46 | + |
| 47 | +lemma dirty_store: |
| 48 | + "k < n \<Longrightarrow> dirty n (store s k offset byte) = insert k (dirty n s)" |
| 49 | + by (auto simp: dirty_def prepare_def) |
| 50 | + |
| 51 | +definition accounted :: "nat \<Rightarrow> nat \<Rightarrow> pager \<Rightarrow> bool" where |
| 52 | + "accounted pages slots s \<longleftrightarrow> frontier s = pages + card (dirty slots s)" |
| 53 | + |
| 54 | +lemma initial_accounted: "accounted pages slots (initial pages contents)" |
| 55 | + by (simp add: accounted_def) |
| 56 | + |
| 57 | +lemma store_accounted: |
| 58 | + assumes "accounted pages slots s" "k < slots" |
| 59 | + shows "accounted pages slots (store s k offset byte)" |
| 60 | + using assms |
| 61 | + by (auto simp: accounted_def dirty_store prepare_frontier card_insert_if insert_absorb) |
| 62 | + |
| 63 | +lemma advance_accounted: |
| 64 | + "accounted pages slots s \<Longrightarrow> valid slots bytes a \<Longrightarrow> |
| 65 | + accounted pages slots (advance s a)" |
| 66 | + by (cases a; auto intro: store_accounted) |
| 67 | + |
| 68 | +theorem execute_accounted: |
| 69 | + "accounted pages slots s \<Longrightarrow> list_all (valid slots bytes) actions \<Longrightarrow> |
| 70 | + accounted pages slots (execute s actions)" |
| 71 | + by (induction actions arbitrary: s) (auto intro: advance_accounted) |
| 72 | + |
| 73 | +lemma dirty_card_bound: "card (dirty slots s) \<le> slots" |
| 74 | +proof - |
| 75 | + have "dirty slots s \<subseteq> {..<slots}" by (auto simp: dirty_def) |
| 76 | + then have "card (dirty slots s) \<le> card {..<slots}" |
| 77 | + by (intro card_mono) auto |
| 78 | + then show ?thesis by simp |
| 79 | +qed |
| 80 | + |
| 81 | +theorem allocation_bound: |
| 82 | + assumes "list_all (valid slots bytes) actions" |
| 83 | + shows "frontier (execute (initial pages contents) actions) \<le> pages + slots" |
| 84 | + using execute_accounted[OF initial_accounted assms] dirty_card_bound |
| 85 | + unfolding accounted_def by fastforce |
| 86 | + |
| 87 | +fun written :: "action list \<Rightarrow> nat set" where |
| 88 | + "written [] = {}" |
| 89 | +| "written (Read k offset # actions) = written actions" |
| 90 | +| "written (Write k offset byte # actions) = insert k (written actions)" |
| 91 | + |
| 92 | +lemma writable_advance: |
| 93 | + "writable (advance s a) k = (writable s k \<or> k \<in> written [a])" |
| 94 | + by (cases a; auto simp: prepare_def) |
| 95 | + |
| 96 | +theorem written_exactly: |
| 97 | + "writable (execute s actions) k = (writable s k \<or> k \<in> written actions)" |
| 98 | +proof (induction actions arbitrary: s) |
| 99 | + case Nil |
| 100 | + then show ?case by simp |
| 101 | +next |
| 102 | + case (Cons a actions) |
| 103 | + show ?case by (cases a) (auto simp: Cons.IH prepare_def) |
| 104 | +qed |
| 105 | + |
| 106 | +theorem copies_exactly: |
| 107 | + assumes "list_all (valid slots bytes) actions" |
| 108 | + shows "frontier (execute (initial pages contents) actions) = |
| 109 | + pages + card ({..<slots} \<inter> written actions)" |
| 110 | +proof - |
| 111 | + have "dirty slots (execute (initial pages contents) actions) = |
| 112 | + {..<slots} \<inter> written actions" |
| 113 | + by (auto simp: dirty_def written_exactly) |
| 114 | + then show ?thesis |
| 115 | + using execute_accounted[OF initial_accounted assms] by (simp add: accounted_def) |
| 116 | +qed |
| 117 | + |
| 118 | +end |