Robert Allan James
422ef2fa29
Isabelle toolchain replaced (was genuinely 2011, 14+ years stale) and every theory file fixed to actually compile -- most had apparently never been checked under a working Isabelle at all. Fixed the vm_state self-reference in StarForth_Base.thy properly (word_table is now a free-standing global constant, not a circular record field), corrected the word_physics_transparent axiom (was claiming full state equality from mere exec-equivalence, provably too strong), and worked through 14 years of HOL-Library drift plus several missing-hypothesis bugs across the physics-loop and ACL theories. Two genuine (non-tactical) bugs found and left oops-flagged rather than silently resolved: forth_roll's index arithmetic disagrees with both its own test lemma and the real C ROLL implementation (three-way inconsistency), and pm_wf isn't actually preserved by pm_record_hit/pm_record_miss. Both need a decision, not a proof-script fix. Full writeup in FABRIC-2.md item 5.2.
182 lines
7.3 KiB
Plaintext
182 lines
7.3 KiB
Plaintext
theory StarForth_Loop3_Decay
|
||
imports StarForth_Q48_16 StarForth_Base
|
||
begin
|
||
|
||
(* =========================================================================
|
||
StarForth_Loop3_Decay — Linear Heat Decay (Physics Loop #3)
|
||
|
||
Mirrors: src/vm_time.c (vm_tick_slope_validator, heartbeat decay sweep)
|
||
include/vm.h (decay_slope_q48, DECAY_RATE_PER_US_Q16)
|
||
|
||
The decay subsystem applies a time-proportional heat reduction to every
|
||
dictionary word on each heartbeat sweep:
|
||
|
||
new_heat = max(0, heat - slope × elapsed_μs)
|
||
|
||
where slope = decay_slope_q48 (Q48.16 fixed-point nat in vm_state).
|
||
======================================================================== *)
|
||
|
||
(* =========================================================================
|
||
Section 1: Decay constants
|
||
======================================================================== *)
|
||
|
||
(* ○ CODE-MUST-MATCH: Initial slope = 2 × Q48_SCALE = 131072.
|
||
Matches DECAY_RATE_PER_US_Q16 × 2 in include/vm.h.
|
||
CORRECTED 2026-08-13: was "2 * Q48_SCALE" directly -- Q48_SCALE :: q48
|
||
(64 word), this constant is nat. Same unat fix as elsewhere. *)
|
||
definition DECAY_SLOPE_INIT :: nat where
|
||
"DECAY_SLOPE_INIT = 2 * unat Q48_SCALE"
|
||
|
||
(* ○ CODE-MUST-MATCH: Never let slope reach zero.
|
||
⚠ HUMAN-REVIEW: Every C code path that reduces decay_slope_q48 must clamp
|
||
to at least DECAY_SLOPE_MIN = 1. Check: src/vm_time.c slope validator,
|
||
src/inference_engine.c slope output path. *)
|
||
definition DECAY_SLOPE_MIN :: nat where
|
||
"DECAY_SLOPE_MIN = 1"
|
||
|
||
definition DECAY_SLOPE_MAX :: nat where
|
||
"DECAY_SLOPE_MAX = unat Q48_SCALE * 1000"
|
||
|
||
(* =========================================================================
|
||
Section 2: Slope well-formedness
|
||
======================================================================== *)
|
||
|
||
definition slope_wf :: "nat \<Rightarrow> bool" where
|
||
"slope_wf s \<longleftrightarrow> s \<ge> DECAY_SLOPE_MIN \<and> s \<le> DECAY_SLOPE_MAX"
|
||
|
||
lemma slope_wf_pos:
|
||
assumes "slope_wf s"
|
||
shows "s > 0"
|
||
using assms by (simp add: slope_wf_def DECAY_SLOPE_MIN_def)
|
||
|
||
lemma slope_init_wf:
|
||
"slope_wf DECAY_SLOPE_INIT"
|
||
by (simp add: slope_wf_def DECAY_SLOPE_INIT_def DECAY_SLOPE_MIN_def
|
||
DECAY_SLOPE_MAX_def Q48_SCALE_def)
|
||
|
||
(* =========================================================================
|
||
Section 3: Slope tuning step
|
||
======================================================================== *)
|
||
|
||
definition slope_decrease :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
|
||
"slope_decrease step s = max DECAY_SLOPE_MIN (s - step)"
|
||
|
||
definition slope_increase :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
|
||
"slope_increase step s = min DECAY_SLOPE_MAX (s + step)"
|
||
|
||
lemma slope_decrease_lb:
|
||
"slope_decrease step s \<ge> DECAY_SLOPE_MIN"
|
||
by (simp add: slope_decrease_def)
|
||
|
||
lemma slope_decrease_preserves_wf:
|
||
assumes "slope_wf s"
|
||
shows "slope_wf (slope_decrease step s)"
|
||
using assms
|
||
by (auto simp: slope_wf_def slope_decrease_def intro: le_trans[OF diff_le_self])
|
||
|
||
lemma slope_increase_ub:
|
||
"slope_increase step s \<le> DECAY_SLOPE_MAX"
|
||
by (simp add: slope_increase_def)
|
||
|
||
lemma slope_increase_preserves_wf:
|
||
assumes "slope_wf s"
|
||
shows "slope_wf (slope_increase step s)"
|
||
using assms by (simp add: slope_wf_def slope_increase_def DECAY_SLOPE_MIN_def DECAY_SLOPE_MAX_def)
|
||
|
||
(* CORRECTED 2026-08-13: added the missing slope_wf hypothesis. Without
|
||
"s \<ge> DECAY_SLOPE_MIN", slope_decrease's max-clamp can raise a too-small
|
||
s back up above its own input (e.g. s=0, step=0 gives
|
||
max DECAY_SLOPE_MIN 0 = 1 > 0 = s), breaking the claim. Symmetric
|
||
argument for slope_increase_mono below. *)
|
||
lemma slope_decrease_mono:
|
||
assumes "s \<ge> DECAY_SLOPE_MIN"
|
||
shows "slope_decrease step s \<le> s"
|
||
using assms by (simp add: slope_decrease_def)
|
||
|
||
lemma slope_increase_mono:
|
||
assumes "s \<le> DECAY_SLOPE_MAX"
|
||
shows "slope_increase step s \<ge> s"
|
||
using assms by (simp add: slope_increase_def)
|
||
|
||
(* =========================================================================
|
||
Section 4: VM decay step
|
||
======================================================================== *)
|
||
|
||
(* vm_decay_step adjusts decay_slope_q48 according to decay_direction.
|
||
○ CODE-MUST-MATCH: decay_direction is set by the inference engine output
|
||
(-1 = reduce slope, 0 = stable, +1 = increase slope). The C code must
|
||
apply exactly slope_decrease or slope_increase with the same clamping. *)
|
||
definition vm_decay_step :: "nat \<Rightarrow> vm_state \<Rightarrow> vm_state" where
|
||
"vm_decay_step step vm =
|
||
(if decay_direction vm = 1
|
||
then vm\<lparr>decay_slope_q48 := slope_increase step (decay_slope_q48 vm)\<rparr>
|
||
else if decay_direction vm = -1
|
||
then vm\<lparr>decay_slope_q48 := slope_decrease step (decay_slope_q48 vm)\<rparr>
|
||
else vm)"
|
||
|
||
lemma vm_decay_step_slope_pos:
|
||
assumes "slope_wf (decay_slope_q48 vm)"
|
||
shows "slope_wf (decay_slope_q48 (vm_decay_step step vm))"
|
||
by (simp add: vm_decay_step_def slope_decrease_preserves_wf slope_increase_preserves_wf assms)
|
||
|
||
lemma vm_decay_step_ds [simp]:
|
||
"data_stack (vm_decay_step step vm) = data_stack vm"
|
||
by (simp add: vm_decay_step_def)
|
||
|
||
lemma vm_decay_step_rs [simp]:
|
||
"return_stack (vm_decay_step step vm) = return_stack vm"
|
||
by (simp add: vm_decay_step_def)
|
||
|
||
lemma vm_decay_step_rolling [simp]:
|
||
"rolling_window (vm_decay_step step vm) = rolling_window vm"
|
||
by (simp add: vm_decay_step_def)
|
||
|
||
lemma vm_decay_step_error [simp]:
|
||
"vm_error (vm_decay_step step vm) = vm_error vm"
|
||
by (simp add: vm_decay_step_def)
|
||
|
||
(* vm_decay_step only modifies decay_slope_q48 — dictionary is unchanged. *)
|
||
lemma vm_decay_step_dict [simp]:
|
||
"dictionary (vm_decay_step step vm) = dictionary vm"
|
||
by (simp add: vm_decay_step_def)
|
||
|
||
(* =========================================================================
|
||
Section 5: Total heat — fully proved monotonicity
|
||
======================================================================== *)
|
||
|
||
definition total_dict_heat :: "vm_state \<Rightarrow> int" where
|
||
"total_dict_heat vm =
|
||
(\<Sum>i \<in> {i. dictionary vm i \<noteq> None}.
|
||
de_heat (the (dictionary vm i)))"
|
||
|
||
(* PROOF (no sorry):
|
||
vm_decay_step only changes decay_slope_q48, so dictionary is identical
|
||
between vm and vm_decay_step step vm. Therefore total_dict_heat is equal
|
||
(not merely ≤) across the step — monotonicity follows trivially. *)
|
||
lemma decay_step_dict_unchanged:
|
||
"total_dict_heat (vm_decay_step step vm) = total_dict_heat vm"
|
||
unfolding total_dict_heat_def
|
||
by simp \<comment> \<open>vm_decay_step_dict [simp] rewrites the dictionary field\<close>
|
||
|
||
lemma decay_total_heat_non_increasing:
|
||
assumes "\<forall>i. dictionary vm i \<noteq> None \<longrightarrow> de_heat (the (dictionary vm i)) \<ge> 0"
|
||
shows "total_dict_heat (vm_decay_step step vm) \<le> total_dict_heat vm"
|
||
by (simp add: decay_step_dict_unchanged)
|
||
|
||
(* =========================================================================
|
||
Section 6: Well-formedness: slope is positive in wf_vm
|
||
======================================================================== *)
|
||
|
||
lemma wf_vm_slope_pos:
|
||
assumes "wf_vm vm"
|
||
shows "decay_slope_q48 vm > 0"
|
||
using assms by (simp add: wf_vm_def)
|
||
|
||
lemma wf_vm_slope_wf:
|
||
assumes "wf_vm vm"
|
||
assumes "decay_slope_q48 vm \<le> DECAY_SLOPE_MAX"
|
||
shows "slope_wf (decay_slope_q48 vm)"
|
||
using assms by (simp add: slope_wf_def DECAY_SLOPE_MIN_def wf_vm_def)
|
||
|
||
end
|