Lean: prove the R420 Fin661 COPY/scatter lifecycle

research/r420-scatter-lifecycle/BitCopyScatterWindow.lean

@@ -0,0 +1,191 @@
+import BitXorTargetTranslation
+
+/-! Boolean scalar projection of a retained-centre COPY/ADD/ERASE window.
+COPY overwrites the temporary and ERASE writes false. No physical allocation,
+frame transport, or restoration of an arbitrary incoming temporary is asserted.
+The overwrite/clear statement shapes parallel the accepted F19 scalar adapter;
+its rational Module instance is not imported or treated as Boolean semantics. -/
+namespace CurrentMain.BitCopyScatter
+set_option Elab.async false
+variable {Reg : Type} [DecidableEq Reg]
+abbrev State (Reg : Type) := Reg → Bool
+
+def copy (temp centre : Reg) (s : State Reg) : State Reg :=
+  fun r => if r = temp then s centre else s r
+
+def clear (temp : Reg) (s : State Reg) : State Reg :=
+  fun r => if r = temp then false else s r
+
+/-- Ordered destination loop, using the accepted scalar XOR ADD. -/
+def adds (src : Reg) : List Reg → State Reg → State Reg
+  | [], s => s
+  | d :: ds, s => adds src ds (BitXor.single d src s)
+
+def window (temp centre : Reg) (ds : List Reg) (s : State Reg) : State Reg :=
+  clear temp (adds temp ds (copy temp centre s))
+
+structure Window (Reg : Type) where
+  centre : Reg
+  targets : List Reg
+
+def WellFormed (temp : Reg) (w : Window Reg) : Prop :=
+  w.centre ≠ temp ∧ ∀ d ∈ w.targets, d ≠ temp ∧ d ≠ w.centre
+
+def runWindows (temp : Reg) : List (Window Reg) → State Reg → State Reg
+  | [], s => s
+  | w :: ws, s => runWindows temp ws (window temp w.centre w.targets s)
+
+def directWindows : List (Window Reg) → State Reg → State Reg
+  | [], s => s
+  | w :: ws, s => directWindows ws (adds w.centre w.targets s)
+
+theorem copy_at_temp (temp centre : Reg) (s : State Reg) :
+    copy temp centre s temp = s centre := by simp [copy]
+
+theorem clear_at_temp (temp : Reg) (s : State Reg) :
+    clear temp s temp = false := by simp [clear]
+
+private theorem single_copy (temp centre dst : Reg)
+    (hdt : dst ≠ temp) (hdc : dst ≠ centre) (s : State Reg) :
+    BitXor.single dst temp (copy temp centre s) =
+      copy temp centre (BitXor.single dst centre s) := by
+  funext r
+  by_cases hr : r = temp
+  · subst r
+    simp [copy, BitXor.single, Ne.symm hdt, Ne.symm hdc]
+  · simp [copy, BitXor.single, hr]
+
+private theorem adds_copy (temp centre : Reg) (ds : List Reg) :
+    (∀ d ∈ ds, d ≠ temp ∧ d ≠ centre) → ∀ s,
+    adds temp ds (copy temp centre s) = copy temp centre (adds centre ds s) := by
+  induction ds with
+  | nil => intro h s; rfl
+  | cons d ds ih =>
+    intro h s
+    change adds temp ds (BitXor.single d temp (copy temp centre s)) =
+      copy temp centre (adds centre ds (BitXor.single d centre s))
+    rw [single_copy temp centre d (h d List.mem_cons_self).1
+      (h d List.mem_cons_self).2 s]
+    exact ih (fun r hr => h r (List.mem_cons_of_mem d hr)) (BitXor.single d centre s)
+
+private theorem clear_copy (temp centre : Reg) (s : State Reg) :
+    clear temp (copy temp centre s) = clear temp s := by
+  funext r
+  by_cases hr : r = temp <;> simp [clear, copy, hr]
+
+private theorem clear_clear (temp : Reg) (s : State Reg) :
+    clear temp (clear temp s) = clear temp s := by
+  funext r
+  by_cases hr : r = temp <;> simp [clear, hr]
+
+theorem window_eq_clear_direct (temp centre : Reg) (ds : List Reg)
+    (h : ∀ d ∈ ds, d ≠ temp ∧ d ≠ centre) (s : State Reg) :
+    window temp centre ds s = clear temp (adds centre ds s) := by
+  unfold window
+  rw [adds_copy temp centre ds h s, clear_copy]
+
+private theorem single_clear (temp src dst : Reg)
+    (hst : src ≠ temp) (hdt : dst ≠ temp) (s : State Reg) :
+    BitXor.single dst src (clear temp s) = clear temp (BitXor.single dst src s) := by
+  funext r
+  by_cases hr : r = temp
+  · subst r
+    simp [clear, BitXor.single, Ne.symm hdt]
+  · simp [clear, BitXor.single, hr, hst]
+
+private theorem adds_clear (temp src : Reg) (ds : List Reg) (hst : src ≠ temp) :
+    (∀ d ∈ ds, d ≠ temp) → ∀ s,
+    adds src ds (clear temp s) = clear temp (adds src ds s) := by
+  induction ds with
+  | nil => intro h s; rfl
+  | cons d ds ih =>
+    intro h s
+    change adds src ds (BitXor.single d src (clear temp s)) =
+      clear temp (adds src ds (BitXor.single d src s))
+    rw [single_clear temp src d hst (h d List.mem_cons_self) s]
+    exact ih (fun r hr => h r (List.mem_cons_of_mem d hr)) (BitXor.single d src s)
+
+private theorem copy_clear_input (temp centre : Reg) (hct : centre ≠ temp)
+    (s : State Reg) : copy temp centre (clear temp s) = copy temp centre s := by
+  funext r
+  by_cases hr : r = temp <;> simp [copy, clear, hr, hct]
+
+private theorem runWindows_clear (temp : Reg) (ws : List (Window Reg)) :
+    (∀ w ∈ ws, WellFormed temp w) → ∀ s,
+    runWindows temp ws (clear temp s) = clear temp (directWindows ws s) := by
+  induction ws with
+  | nil => intro h s; rfl
+  | cons w ws ih =>
+    intro h s
+    have hw := h w List.mem_cons_self
+    change runWindows temp ws (window temp w.centre w.targets (clear temp s)) =
+      clear temp (directWindows ws (adds w.centre w.targets s))
+    rw [window_eq_clear_direct temp w.centre w.targets hw.2,
+      adds_clear temp w.centre w.targets hw.1 (fun d hd => (hw.2 d hd).1),
+      clear_clear]
+    exact ih (fun q hq => h q (List.mem_cons_of_mem w hq)) (adds w.centre w.targets s)
+
+/-- Nonempty copy windows dispose of the incoming temporary and end it at zero.
+All other coordinates agree with the direct retained-centre XOR word. -/
+theorem runWindows_eq_clear_direct (temp : Reg) (ws : List (Window Reg))
+    (hne : ws ≠ []) (h : ∀ w ∈ ws, WellFormed temp w) (s : State Reg) :
+    runWindows temp ws s = clear temp (directWindows ws s) := by
+  cases ws with
+  | nil => exact False.elim (hne rfl)
+  | cons w ws =>
+    have hw := h w List.mem_cons_self
+    calc
+      runWindows temp (w :: ws) s = runWindows temp (w :: ws) (clear temp s) := by
+        change runWindows temp ws (window temp w.centre w.targets s) =
+          runWindows temp ws (window temp w.centre w.targets (clear temp s))
+        simp only [window, copy_clear_input temp w.centre hw.1 s]
+      _ = clear temp (directWindows (w :: ws) s) := runWindows_clear temp (w :: ws) h s
+
+private theorem adds_untouched (src : Reg) (ds : List Reg) :
+    ∀ s r, r ∉ ds → adds src ds s r = s r := by
+  induction ds with
+  | nil => intro s r h; rfl
+  | cons d ds ih =>
+    intro s r h
+    have hrd : r ≠ d := fun he => h (by simp [he])
+    have hrs : r ∉ ds := fun hr => h (List.mem_cons_of_mem d hr)
+    change adds src ds (BitXor.single d src s) r = s r
+    rw [ih (BitXor.single d src s) r hrs]
+    simp [BitXor.single, hrd]
+
+theorem directWindows_untouched (ws : List (Window Reg)) :
+    ∀ s r, (∀ w ∈ ws, r ∉ w.targets) → directWindows ws s r = s r := by
+  induction ws with
+  | nil => intro s r h; rfl
+  | cons w ws ih =>
+    intro s r h
+    change directWindows ws (adds w.centre w.targets s) r = s r
+    rw [ih (adds w.centre w.targets s) r (fun q hq => h q (List.mem_cons_of_mem w hq))]
+    exact adds_untouched w.centre w.targets s r (h w List.mem_cons_self)
+
+/-- Equality away from the disposable slot suffices, even if the two incoming
+slots differ. This is loss of the temporary's old value, not its restoration. -/
+theorem runWindows_independent_of_temp (temp : Reg) (ws : List (Window Reg))
+    (hne : ws ≠ []) (h : ∀ w ∈ ws, WellFormed temp w)
+    (s t : State Reg) (hst : ∀ r, r ≠ temp → s r = t r) :
+    runWindows temp ws s = runWindows temp ws t := by
+  cases ws with
+  | nil => exact False.elim (hne rfl)
+  | cons w ws =>
+    have hct := (h w List.mem_cons_self).1
+    have hc : copy temp w.centre s = copy temp w.centre t := by
+      funext r
+      by_cases hr : r = temp
+      · simp [copy, hr, hst w.centre hct]
+      · simp [copy, hr, hst r hr]
+    change runWindows temp ws (window temp w.centre w.targets s) =
+      runWindows temp ws (window temp w.centre w.targets t)
+    simp only [window, hc]
+
+end CurrentMain.BitCopyScatter
+#print axioms CurrentMain.BitCopyScatter.copy_at_temp
+#print axioms CurrentMain.BitCopyScatter.clear_at_temp
+#print axioms CurrentMain.BitCopyScatter.window_eq_clear_direct
+#print axioms CurrentMain.BitCopyScatter.runWindows_eq_clear_direct
+#print axioms CurrentMain.BitCopyScatter.directWindows_untouched
+#print axioms CurrentMain.BitCopyScatter.runWindows_independent_of_temp

research/r420-scatter-lifecycle/BitXorTargetTranslation.lean

@@ -0,0 +1,139 @@
+import Init
+
+/-! Raw Boolean XOR semantics for an ordered multi-source gate. Frame metadata
+is retained but has no scalar action here; physical frame transport is separate.
+This small structural adapter reuses core Bool XOR laws. It does not interpret
+COPY/ERASE or assert any source-specific operator or geometry. -/
+namespace CurrentMain.BitXor
+set_option Elab.async false
+
+structure Gate (Reg : Type) where
+  frame : Nat
+  dst : Reg
+  sources : List Reg
+
+abbrev State (Reg : Type) := Reg → Bool
+variable {Reg : Type} [DecidableEq Reg]
+
+/-- One actual XOR ADD, preserving every other register. -/
+def single (dst src : Reg) (s : State Reg) : State Reg :=
+  fun r => if r = dst then s r ^^ s src else s r
+
+/-- Operand order matches the source checker's `for src in srcs` loop. -/
+def sourcesRun (dst : Reg) : List Reg → State Reg → State Reg
+  | [], s => s
+  | src :: rest, s => sourcesRun dst rest (single dst src s)
+
+def step (g : Gate Reg) (s : State Reg) : State Reg :=
+  sourcesRun g.dst g.sources s
+
+theorem sourcesRun_untouched (dst : Reg) (rs : List Reg) :
+    ∀ s r, r ≠ dst → sourcesRun dst rs s r = s r := by
+  induction rs with
+  | nil => intro s r hr; rfl
+  | cons src rs ih =>
+    intro s r hr
+    change sourcesRun dst rs (single dst src s) r = s r
+    rw [ih (single dst src s) r hr]
+    simp [single, hr]
+
+def run : List (Gate Reg) → State Reg → State Reg
+  | [], s => s
+  | g :: gs, s => run gs (step g s)
+
+variable (target : Reg → Prop) [DecidablePred target]
+
+def shift (s delta : State Reg) : State Reg :=
+  fun r => if target r then s r ^^ delta r else s r
+
+def eraseTargets (s : State Reg) : State Reg :=
+  fun r => if target r then false else s r
+
+theorem single_shift (dst src : Reg) (hsrc : ¬ target src)
+    (s delta : State Reg) :
+    single dst src (shift target s delta) =
+      shift target (single dst src s) delta := by
+  funext r
+  by_cases hd : r = dst
+  · subst r
+    by_cases ht : target dst <;>
+      simp [single, shift, ht, hsrc, Bool.xor_right_comm]
+    exact Bool.xor_comm (delta dst) (s src)
+  · by_cases ht : target r <;>
+      simp [single, shift, hd, ht, hsrc, Bool.xor_right_comm]
+
+theorem sourcesRun_shift (dst : Reg) (rs : List Reg) :
+    (∀ r ∈ rs, ¬ target r) → ∀ s delta,
+    sourcesRun dst rs (shift target s delta) =
+      shift target (sourcesRun dst rs s) delta := by
+  induction rs with
+  | nil => intro h s delta; rfl
+  | cons src rs ih =>
+    intro h s delta
+    have hs : ¬ target src := h src List.mem_cons_self
+    have ht : ∀ r ∈ rs, ¬ target r := fun r hr => h r (List.mem_cons_of_mem src hr)
+    change sourcesRun dst rs (single dst src (shift target s delta)) = _
+    rw [single_shift target dst src hs s delta]
+    exact ih ht (single dst src s) delta
+
+theorem step_shift (g : Gate Reg) (h : ∀ r ∈ g.sources, ¬ target r)
+    (s delta : State Reg) :
+    step g (shift target s delta) = shift target (step g s) delta :=
+  sourcesRun_shift target g.dst g.sources h s delta
+
+theorem run_shift (gs : List (Gate Reg)) :
+    (∀ g ∈ gs, ∀ r ∈ g.sources, ¬ target r) → ∀ s delta,
+    run gs (shift target s delta) = shift target (run gs s) delta := by
+  induction gs with
+  | nil => intro h s delta; rfl
+  | cons g gs ih =>
+    intro h s delta
+    change run gs (step g (shift target s delta)) =
+      shift target (run gs (step g s)) delta
+    rw [step_shift target g (h g List.mem_cons_self) s delta]
+    exact ih (fun q hq => h q (List.mem_cons_of_mem g hq)) (step g s) delta
+
+theorem run_off_target (gs : List (Gate Reg)) :
+    (∀ g ∈ gs, target g.dst) → ∀ s r, ¬ target r → run gs s r = s r := by
+  induction gs with
+  | nil => intro h s r hr; rfl
+  | cons g gs ih =>
+    intro h s r hr
+    have hne : r ≠ g.dst := by
+      intro he
+      apply hr
+      simpa [he] using h g List.mem_cons_self
+    change run gs (step g s) r = s r
+    rw [ih (fun q hq => h q (List.mem_cons_of_mem g hq)) (step g s) r hr]
+    exact sourcesRun_untouched g.dst g.sources s r hne
+
+theorem erase_shift_self (s : State Reg) :
+    shift target (eraseTargets target s) s = s := by
+  funext r
+  by_cases hr : target r <;> simp [shift, eraseTargets, hr]
+
+theorem target_identity (gs : List (Gate Reg))
+    (h : ∀ g ∈ gs, ∀ r ∈ g.sources, ¬ target r)
+    (s : State Reg) (r : Reg) (hr : target r) :
+    run gs s r = (s r ^^ run gs (eraseTargets target s) r) := by
+  calc
+    run gs s r = run gs (shift target (eraseTargets target s) s) r := by
+      rw [erase_shift_self]
+    _ = shift target (run gs (eraseTargets target s)) s r :=
+      congrFun (run_shift target gs h (eraseTargets target s) s) r
+    _ = (s r ^^ run gs (eraseTargets target s) r) := by
+      simp [shift, hr, Bool.xor_comm]
+
+theorem erased_eq_of_agree_off_target (s t : State Reg)
+    (h : ∀ r, ¬ target r → s r = t r) :
+    eraseTargets target s = eraseTargets target t := by
+  funext r
+  by_cases hr : target r
+  · simp [eraseTargets, hr]
+  · simp [eraseTargets, hr, h r hr]
+
+end CurrentMain.BitXor
+#print axioms CurrentMain.BitXor.run_shift
+#print axioms CurrentMain.BitXor.run_off_target
+#print axioms CurrentMain.BitXor.target_identity
+#print axioms CurrentMain.BitXor.erased_eq_of_agree_off_target