admin/LithosAnanake
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

proof/: complete parse+insert composition for :, CREATE, VARIABLE, DEFER

Browse Source 
Extends the CONSTANT worked example from the previous commit to all five
name-parsing/entry-creating words. Each now has a forth_*_full definition
composing the real C order end to end, up to but not including the
data-field write (gap b, still open):

- forth_create_full: parse -> dict_insert_entry -> forth_align (reused
  directly from StarForth_Dictionary_Words.thy's ALIGN model).
- forth_variable_full: parse -> forth_align -> forth_vm_allot_raw (new --
  models the raw vm_allot() C helper VARIABLE calls directly, bounds-
  checked against DICTIONARY_MEMORY_SIZE exactly like vm_align, distinct
  from the FORTH word ALLOT's own VM_MEMORY_SIZE-bounded forth_allot) ->
  dict_insert_entry.
- forth_colon_full: nested-':' guard (checked before the parse, matching
  real C order) -> parse -> forth_colon_entry_half (mode-set + WORD_SMUDGED
  insert). Added forth_parse_word_preserves_vm_mode/dictionary/
  word_id_next to StarForth_Base.thy to support this composition cleanly.
- forth_defer_full: parse -> dict_insert_entry, the simplest of the five.

dict_insert_entry's callers (the four forth_*_entry_half definitions)
still take the parsed name as a caller parameter for standalone use.

Full suite (54 theories) verifies green.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
Robert Allan James
2026-08-15 05:29:49 -04:00
co-authored by Claude Sonnet 5
parent 1aca77d55c
commit d3d66fb608
4 changed files with 256 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
proof/StarForth_Defining_Words.thy
+180 -4
View File
@@ -1,5 +1,5 @@
theory StarForth_Defining_Words
imports StarForth_Base StarForth_Memory_Words ACL_Pin_Monotone
imports StarForth_Base StarForth_Memory_Words ACL_Pin_Monotone StarForth_Dictionary_Words
begin
(* =========================================================================
@@ -402,13 +402,70 @@ lemma colon_entry_half_still_compile_mode:
lemma colon_entry_half_not_full_colon: True
\<comment> \<open>Still NOT modelled: name parse (`name` is a caller-supplied parameter
here, not derived from `forth_parse_word` -- see forth_constant_full
below for the one word in this file where parse IS composed in),
vm->compiling_word tracking (no vm_state field), vm_align+HERE
here, not derived from `forth_parse_word` -- see forth_colon_full
below), vm->compiling_word tracking (no vm_state field), vm_align+HERE
capture, DF write of the threaded-body start address (gap b). See
section header.\<close>
by simp
(* ── `:`, full composition, gap (a)+parse CLOSED 2026-08-15 ──────────────
`defining_word_colon` (defining_words.c:407-426): nested-`:` guard
FIRST (checked before any parse -- real C order), THEN parse name, THEN
`vm_enter_compile_mode` (mode/state effect + WORD_SMUDGED entry
creation, already `forth_colon_entry_half`). `forth_parse_word` never
touches `vm_mode`, so checking the guard before parsing and reusing
`forth_colon_entry_half` (which re-derives the same guard internally
via `forth_colon_guard`) afterward is sound -- the mode it observes is
unchanged by the intervening parse. Still NOT modelled: vm->
compiling_word tracking, vm_align+HERE capture, DF write (gap b). *)
definition forth_colon_full :: "nat \<Rightarrow> bool \<Rightarrow> vm_state \<Rightarrow> vm_state" where
"forth_colon_full max_len pinned_conflict vm =
(if vm_mode vm = ModeCompile
then set_error vm
else
let (nm, vm1) = forth_parse_word max_len vm
in if nm = ''''
then set_error vm1
else forth_colon_entry_half nm pinned_conflict vm1)"
lemma colon_full_nested_errors:
assumes "vm_mode vm = ModeCompile"
shows "vm_error (forth_colon_full max_len pinned_conflict vm)"
by (simp add: forth_colon_full_def set_error_def assms)
lemma colon_full_empty_parse_errors:
assumes "vm_mode vm \<noteq> ModeCompile"
assumes "fst (forth_parse_word max_len vm) = ''''"
shows "vm_error (forth_colon_full max_len pinned_conflict vm)"
proof -
obtain nm vm1 where parse_eq: "forth_parse_word max_len vm = (nm, vm1)" by fastforce
hence "nm = ''''" using assms(2) by simp
thus ?thesis using parse_eq assms(1) by (simp add: forth_colon_full_def set_error_def)
qed
lemma colon_full_success_populates_dictionary:
assumes "vm_mode vm \<noteq> ModeCompile"
assumes "dropWhile is_ws (drop (input_pos vm) (input_buffer vm)) \<noteq> []" (is "?s1 \<noteq> []")
assumes "max_len \<ge> 2"
assumes "\<not> pinned_conflict"
shows "\<exists>e wid. dictionary (forth_colon_full max_len pinned_conflict vm) wid = Some e
\<and> de_name e \<noteq> '''' \<and> de_flags e = WORD_SMUDGED"
proof -
obtain nm vm1 where parse_eq: "forth_parse_word max_len vm = (nm, vm1)" by fastforce
hence nm_nonempty: "nm \<noteq> ''''"
using forth_parse_word_success_nonempty[OF assms(2) assms(3)] by (metis fstI)
have vm_mode_vm1: "vm_mode vm1 = vm_mode vm"
using parse_eq forth_parse_word_preserves_vm_mode[of max_len vm] by simp
have "forth_colon_full max_len pinned_conflict vm = forth_colon_entry_half nm pinned_conflict vm1"
using parse_eq nm_nonempty assms(1) by (simp add: forth_colon_full_def)
moreover have "\<exists>e. dictionary (forth_colon_entry_half nm pinned_conflict vm1) (word_id_next (forth_colon_guard vm1)) = Some e
\<and> de_name e = nm \<and> de_flags e = WORD_SMUDGED"
using assms(1) assms(4) vm_mode_vm1
by (simp add: forth_colon_entry_half_def forth_colon_guard_def dict_insert_entry_def Let_def)
ultimately show ?thesis using nm_nonempty by auto
qed
(* ── ; ( -- ) : compile-mode guard only ──────────────────────────────────── *)
(* C: error unless vm->mode == MODE_COMPILE; else calls vm_exit_compile_mode,
entirely unmodelled (finds/compiles EXIT, flips WORD_SMUDGED/WORD_COMPILED,
@@ -550,6 +607,125 @@ proof -
ultimately show ?thesis using nm_nonempty by auto
qed
(* ── CREATE, full composition, gap (a)+parse CLOSED for this word
2026-08-15 ─────────────────────────────────────────────────────────────
CREATE's real C order: parse name -> vm_create_word -> vm_align(vm) ->
capture dfa = here (fed to the still-unmodelled DF write, gap b). No
stack precondition at all (unlike CONSTANT). `forth_align`
(StarForth_Dictionary_Words.thy) is reused directly -- it is exactly
what `vm_align` already models, word-for-word. Composed unconditionally
over `dict_insert_entry`'s result the same way `forth_colon_entry_half`
already does: when `pinned_conflict` holds, the real C returns before
ever calling vm_align, so `forth_align` running anyway on the
already-errored state is a known, minor divergence, not claimed
otherwise -- see forth_colon_entry_half's identical precedent. *)
definition forth_create_full :: "nat \<Rightarrow> bool \<Rightarrow> vm_state \<Rightarrow> vm_state" where
"forth_create_full max_len pinned_conflict vm =
(let (nm, vm1) = forth_parse_word max_len vm
in if nm = ''''
then set_error vm1
else forth_align (dict_insert_entry nm 0 pinned_conflict vm1))"
lemma create_full_empty_parse_errors:
assumes "fst (forth_parse_word max_len vm) = ''''"
shows "vm_error (forth_create_full max_len pinned_conflict vm)"
proof -
obtain nm vm1 where parse_eq: "forth_parse_word max_len vm = (nm, vm1)" by fastforce
hence "nm = ''''" using assms by simp
thus ?thesis using parse_eq by (simp add: forth_create_full_def set_error_def)
qed
lemma create_full_success_populates_dictionary:
assumes "dropWhile is_ws (drop (input_pos vm) (input_buffer vm)) \<noteq> []" (is "?s1 \<noteq> []")
assumes "max_len \<ge> 2"
assumes "\<not> pinned_conflict"
shows "\<exists>e wid. dictionary (forth_create_full max_len pinned_conflict vm) wid = Some e
\<and> de_name e \<noteq> '''' \<and> de_flags e = 0"
proof -
obtain nm vm1 where parse_eq: "forth_parse_word max_len vm = (nm, vm1)" by fastforce
hence nm_nonempty: "nm \<noteq> ''''"
using forth_parse_word_success_nonempty[OF assms(1) assms(2)] by (metis fstI)
have "forth_create_full max_len pinned_conflict vm
= forth_align (dict_insert_entry nm 0 pinned_conflict vm1)"
using parse_eq nm_nonempty by (simp add: forth_create_full_def)
moreover have "\<exists>e. dictionary (dict_insert_entry nm 0 pinned_conflict vm1) (word_id_next vm1) = Some e
\<and> de_name e = nm \<and> de_flags e = 0"
using assms(3) by (simp add: dict_insert_entry_def Let_def)
moreover have "dictionary (forth_align vm2) = dictionary vm2" for vm2
by (simp add: forth_align_def set_error_def Let_def)
ultimately show ?thesis using nm_nonempty by metis
qed
(* ── VARIABLE, full composition, gap (a)+parse CLOSED for this word
2026-08-15 ─────────────────────────────────────────────────────────────
VARIABLE's real C order: parse name -> vm_align(vm) -> capture
addr = here (fed to the still-unmodelled DF write, gap b) ->
vm_allot(vm, sizeof(cell_t)) [the RAW C helper, bounds-checked against
DICTIONARY_MEMORY_SIZE exactly like vm_align -- NOT the FORTH word
ALLOT, which pops a stack argument and checks VM_MEMORY_SIZE instead,
see StarForth_Dictionary_Words.thy's forth_allot header] ->
vm_create_word. `forth_vm_allot_raw` below models that raw helper;
`addr` itself is not tracked since only the still-unmodelled DF write
consumes it. *)
definition forth_vm_allot_raw :: "nat \<Rightarrow> vm_state \<Rightarrow> vm_state" where
"forth_vm_allot_raw bytes vm =
(if here vm + bytes \<ge> DICTIONARY_MEMORY_SIZE
then set_error vm
else vm\<lparr>here := here vm + bytes\<rparr>)"
lemma vm_allot_raw_advances_here:
assumes "here vm + bytes < DICTIONARY_MEMORY_SIZE"
shows "here (forth_vm_allot_raw bytes vm) = here vm + bytes"
using assms by (simp add: forth_vm_allot_raw_def)
lemma vm_allot_raw_overflow:
assumes "here vm + bytes \<ge> DICTIONARY_MEMORY_SIZE"
shows "vm_error (forth_vm_allot_raw bytes vm)"
using assms by (simp add: forth_vm_allot_raw_def set_error_def)
lemma vm_allot_raw_dictionary_unchanged:
"dictionary (forth_vm_allot_raw bytes vm) = dictionary vm"
by (simp add: forth_vm_allot_raw_def set_error_def)
definition forth_variable_full :: "nat \<Rightarrow> bool \<Rightarrow> vm_state \<Rightarrow> vm_state" where
"forth_variable_full max_len pinned_conflict vm =
(let (nm, vm1) = forth_parse_word max_len vm
in if nm = ''''
then set_error vm1
else dict_insert_entry nm 0 pinned_conflict
(forth_vm_allot_raw CELL_BYTES (forth_align vm1)))"
lemma variable_full_empty_parse_errors:
assumes "fst (forth_parse_word max_len vm) = ''''"
shows "vm_error (forth_variable_full max_len pinned_conflict vm)"
proof -
obtain nm vm1 where parse_eq: "forth_parse_word max_len vm = (nm, vm1)" by fastforce
hence "nm = ''''" using assms by simp
thus ?thesis using parse_eq by (simp add: forth_variable_full_def set_error_def)
qed
lemma variable_full_success_populates_dictionary:
assumes "dropWhile is_ws (drop (input_pos vm) (input_buffer vm)) \<noteq> []" (is "?s1 \<noteq> []")
assumes "max_len \<ge> 2"
assumes "\<not> pinned_conflict"
shows "\<exists>e wid. dictionary (forth_variable_full max_len pinned_conflict vm) wid = Some e
\<and> de_name e \<noteq> '''' \<and> de_flags e = 0"
proof -
obtain nm vm1 where parse_eq: "forth_parse_word max_len vm = (nm, vm1)" by fastforce
hence nm_nonempty: "nm \<noteq> ''''"
using forth_parse_word_success_nonempty[OF assms(1) assms(2)] by (metis fstI)
let ?vm3 = "forth_vm_allot_raw CELL_BYTES (forth_align vm1)"
have "forth_variable_full max_len pinned_conflict vm
= dict_insert_entry nm 0 pinned_conflict ?vm3"
using parse_eq nm_nonempty by (simp add: forth_variable_full_def)
moreover have "\<exists>e. dictionary (dict_insert_entry nm 0 pinned_conflict ?vm3) (word_id_next ?vm3) = Some e
\<and> de_name e = nm \<and> de_flags e = 0"
using assms(3) by (simp add: dict_insert_entry_def Let_def)
ultimately show ?thesis using nm_nonempty by auto
qed
lemma create_runtime_not_modelled: True \<comment> \<open>defining_runtime_create: reads current_executing_entry's DF cell (gap b).\<close>
by simp
lemma variable_runtime_not_modelled: True \<comment> \<open>defining_runtime_variable: reads current_executing_entry's DF cell (gap b).\<close>