commit 8607a1f0203849a9b6c9c17c2abccc1ea56220fd Author: james Date: Mon May 4 19:14:00 2026 +0100 feat(model): formalise writable frame exclusivity diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6e08e11 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +/build/ + +/staging.txt diff --git a/Model.thy b/Model.thy new file mode 100644 index 0000000..761933e --- /dev/null +++ b/Model.thy @@ -0,0 +1,158 @@ +theory Model + imports Main +begin + +type_synonym page = "nat \ nat" +type_synonym memory = "nat \ page" + +record pager = + ptable :: "nat \ nat" + physical :: memory + writable :: "nat \ bool" + frontier :: nat + +definition view :: "pager \ memory" where + "view s k = physical s (ptable s k)" + +definition bounded :: "nat \ pager \ bool" where + "bounded n s \ (\k pager \ bool" where + "exclusive n s \ + (\k (\j j = k))" + +definition invariant :: "nat \ pager \ bool" where + "invariant n s \ bounded n s \ exclusive n s" + +definition initial :: "nat \ memory \ pager" where + "initial pages contents = + \ptable = (\k. k mod pages), physical = contents, + writable = (\_. False), frontier = pages\" + +definition detach :: "pager \ nat \ pager" where + "detach s k = s\ptable := (ptable s)(k := frontier s), + physical := (physical s)(frontier s := view s k), + writable := (writable s)(k := True), frontier := Suc (frontier s)\" + +definition prepare :: "pager \ nat \ pager" where + "prepare s k = (if writable s k then s else detach s k)" + +definition store :: "pager \ nat \ nat \ nat \ pager" where + "store s k offset byte = (let t = prepare s k in + t\physical := (physical t)(ptable t k := (view t k)(offset := byte))\)" + +lemma initial_ptable [simp]: "ptable (initial pages contents) k = k mod pages" + by (simp add: initial_def) + +lemma initial_physical [simp]: "physical (initial pages contents) = contents" + by (simp add: initial_def) + +lemma initial_writable [simp]: "\ writable (initial pages contents) k" + by (simp add: initial_def) + +lemma initial_frontier [simp]: "frontier (initial pages contents) = pages" + by (simp add: initial_def) + +lemma initial_view [simp]: "view (initial pages contents) k = contents (k mod pages)" + by (simp add: view_def) + +lemma initial_bounded: + "0 < pages \ bounded n (initial pages contents)" + by (simp add: bounded_def) + +lemma initial_exclusive: "exclusive n (initial pages contents)" + by (simp add: exclusive_def) + +theorem initial_invariant: + "0 < pages \ invariant n (initial pages contents)" + by (simp add: invariant_def initial_bounded initial_exclusive) + +lemma bounded_frame: + "bounded n s \ k < n \ ptable s k < frontier s" + by (simp add: bounded_def) + +lemma fresh_frame: + "bounded n s \ k < n \ ptable s k \ frontier s" + using bounded_frame by fastforce + +lemma writable_unique: + "exclusive n s \ k < n \ j < n \ + writable s k \ ptable s j = ptable s k \ j = k" + by (auto simp: exclusive_def) + +lemma detach_ptable [simp]: + "ptable (detach s k) j = (if j = k then frontier s else ptable s j)" + by (simp add: detach_def) + +lemma detach_writable [simp]: + "writable (detach s k) j = (j = k \ writable s j)" + by (simp add: detach_def) + +lemma detach_frontier [simp]: "frontier (detach s k) = Suc (frontier s)" + by (simp add: detach_def) + +lemma detach_copy [simp]: "physical (detach s k) (frontier s) = view s k" + by (simp add: detach_def) + +lemma detach_other_frame: + "f \ frontier s \ physical (detach s k) f = physical s f" + by (simp add: detach_def) + +lemma detach_target_view [simp]: "view (detach s k) k = view s k" + by (simp add: view_def detach_def) + +lemma detach_view: + assumes "bounded n s" "j < n" + shows "view (detach s k) j = view s j" + using fresh_frame[OF assms] by (auto simp: view_def detach_def) + +lemma detach_bounded: + "bounded n s \ bounded n (detach s k)" + by (auto simp: bounded_def less_Suc_eq_le) + +lemma detach_exclusive: + assumes "bounded n s" "exclusive n s" + shows "exclusive n (detach s k)" + using assms by (auto simp: exclusive_def bounded_def split: if_splits) + +theorem detach_invariant: + "invariant n s \ invariant n (detach s k)" + by (simp add: invariant_def detach_bounded detach_exclusive) + +lemma prepare_writable [simp]: "writable (prepare s k) k" + by (simp add: prepare_def) + +lemma prepare_invariant: + "invariant n s \ invariant n (prepare s k)" + by (simp add: prepare_def detach_invariant) + +lemma prepare_view: + "bounded n s \ j < n \ view (prepare s k) j = view s j" + by (simp add: prepare_def detach_view) + +lemma prepare_frontier: + "frontier (prepare s k) = frontier s + (if writable s k then 0 else 1)" + by (simp add: prepare_def) + +lemma prepare_ptable_other: + "j \ k \ ptable (prepare s k) j = ptable s j" + by (simp add: prepare_def) + +lemma prepare_idempotent [simp]: "prepare (prepare s k) k = prepare s k" + by (simp add: prepare_def detach_def) + +lemma write_ptable [simp]: "ptable (store s k offset byte) = ptable (prepare s k)" + by (simp add: store_def Let_def) + +lemma write_writable [simp]: "writable (store s k offset byte) = writable (prepare s k)" + by (simp add: store_def Let_def) + +lemma write_frontier [simp]: "frontier (store s k offset byte) = frontier (prepare s k)" + by (simp add: store_def Let_def) + +theorem write_invariant: + "invariant n s \ invariant n (store s k offset byte)" + using prepare_invariant[of n s k] + by (simp add: invariant_def bounded_def exclusive_def) + +end diff --git a/ROOT b/ROOT new file mode 100644 index 0000000..913da45 --- /dev/null +++ b/ROOT @@ -0,0 +1,4 @@ +session Split = HOL + + options [document = false] + theories + Model