@bramas/simulant-lean 0.0.0-stage → 0.1.1

package/Simulant/LibraryLemmas/BlackHole.lean

@@ -0,0 +1,52 @@
+import Simulant.NonVacuity
+import Simulant.Library.BlackHole
+
+/-!
+# Lemmas about the black hole, for every model that contains it
+
+Hand-written, once per library version (plan, Section 5.1). They are
+stated for any list of components, given that the other components
+preserve the black hole's part of the world; a generated model file
+proves that hypothesis (`others_preserve_BlackHole`), because components
+only write their own part.
+-/
+
+namespace Simulant.Library.BlackHole
+open Simulant
+
+variable {σ : Sig} [FlagSet σ.F] [Flags σ.F]
+
+/-- The black hole's own effects never change its site. -/
+theorem hooks_keep_site (policy : HolePolicy) (L : Ctx σ) :
+    (∀ ts C e, ND.Can ((hooks policy L).beforeLook ts C) e → ∀ x, (e.world x).site = x.site) ∧
+    (∀ ts C ds e, ND.Can ((hooks policy L).beforeMove ts C ds) e → ∀ x, (e.world x).site = x.site) ∧
+    (∀ ts C e, ND.Can ((hooks policy L).afterMove ts C) e → ∀ x, (e.world x).site = x.site) := by
+  refine ⟨fun ts C e he x => ?_, fun ts C ds e he x => ?_, fun ts C e he x => ?_⟩
+  · rw [ND.can_pure.1 he]; rfl
+  · rw [ND.can_pure.1 he]; rfl
+  · obtain ⟨_, -, rfl⟩ := ND.can_map.1 he; rfl
+
+/-- The site of the black hole never changes, whatever the other components. -/
+theorem site_stays (m : Model σ) (act0 : σ.A) (policy : HolePolicy) (L : Ctx σ) [LawfulLens L.world]
+    (hc : ∀ c ∈ m.components, c = component policy L ∨ c.Preserves L.world.get)
+    {C C' : Config σ} {w : Witness} (hs : m.Step act0 C w C') :
+    (L.world.get C'.world).site = (L.world.get C.world).site :=
+  m.step_preserves act0 (g := fun w => (L.world.get w).site) (fun c hcm => by
+    rcases hc c hcm with rfl | hp
+    · exact Hooks.toComponent_preserves_own (hooks policy L) L.world (fun x : World σ.N => x.site)
+        (hooks_keep_site policy L)
+    · exact hp.comp (·.site)) hs
+
+/-- Every hook of the black hole always has an outcome. -/
+theorem component_total (policy : HolePolicy) (L : Ctx σ) : (component policy L).Total := by
+  refine ⟨fun ts C => ⟨_, ND.can_bind_of (ND.can_pure.2 rfl) (ND.can_pure.2 rfl)⟩,
+    fun ts C ds => ⟨_, ND.can_bind_of (ND.can_pure.2 rfl) (ND.can_pure.2 rfl)⟩, fun ts C => ?_⟩
+  unfold component Hooks.toComponent hooks
+  dsimp only
+  by_cases h : (policy == HolePolicy.mayEmerge && !(L.world.get C.world).active) = true
+  · exact ⟨_, ND.can_bind_of (ND.can_bind_of (by simp only [h, ↓reduceIte]; exact ND.can_choose.2 (List.mem_cons_self))
+      (ND.can_pure.2 rfl)) (ND.can_pure.2 rfl)⟩
+  · exact ⟨_, ND.can_bind_of (ND.can_bind_of (by simp only [h, Bool.false_eq_true, ↓reduceIte]; exact ND.can_pure.2 rfl)
+      (ND.can_pure.2 rfl)) (ND.can_pure.2 rfl)⟩
+
+end Simulant.Library.BlackHole

package/Simulant/ND.lean

@@ -0,0 +1,88 @@
+/-!
+# Nondeterminism with witnesses
+
+The adversary's choices form a list monad: a computation is the list of
+its outcomes, each with the witness of the choices that lead to it. A
+witness is a list of (site, index) pairs, the same as the interpreter's
+witnesses without their display labels.
+
+The step relation of a model is membership in this list, so the
+computable round and the relational semantics are the same object.
+-/
+
+namespace Simulant
+
+abbrev Witness := List (String × Nat)
+
+/-- A nondeterministic computation: its outcomes, with their witnesses. -/
+abbrev ND (α : Type) : Type := List (Witness × α)
+
+namespace ND
+
+def pure (a : α) : ND α := [([], a)]
+
+def bind (m : ND α) (f : α → ND β) : ND β :=
+  List.flatMap (fun (w, a) => (f a).map fun (w', b) => (w ++ w', b)) m
+
+instance : Monad ND where
+  pure := ND.pure
+  bind := ND.bind
+
+/-- An adversary choice among `xs`; the witness records the index. -/
+def choose (site : String) (xs : List α) : ND α :=
+  (xs.zipIdx).map fun (x, i) => ([(site, i)], x)
+
+/-- A choice among the elements of `xs` satisfying `p`; indices are positions in `xs`. -/
+def chooseSuch (site : String) (xs : List α) (p : α → Bool) : ND α :=
+  ((xs.zipIdx).filter fun (x, _) => p x).map fun (x, i) => ([(site, i)], x)
+
+/-- `m` can produce `a`, with some witness. -/
+def Can (m : ND α) (a : α) : Prop := ∃ w, (w, a) ∈ m
+
+/-- The outcomes, forgetting witnesses. -/
+def outcomes (m : ND α) : List α := List.map Prod.snd m
+
+@[simp] theorem mem_pure {a b : α} {w : Witness} : (w, b) ∈ (Pure.pure a : ND α) ↔ w = [] ∧ b = a := by
+  show (w, b) ∈ [([], a)] ↔ _
+  simp
+
+theorem mem_bind {m : ND α} {f : α → ND β} {w : Witness} {b : β} :
+    (w, b) ∈ (m >>= f) ↔ ∃ w₁ a w₂, (w₁, a) ∈ m ∧ (w₂, b) ∈ f a ∧ w = w₁ ++ w₂ := by
+  show (w, b) ∈ ND.bind m f ↔ _
+  simp only [ND.bind, List.mem_flatMap, List.mem_map, Prod.exists, Prod.mk.injEq]
+  constructor
+  · rintro ⟨w₁, a, hm, w₂, b', hf, rfl, rfl⟩
+    exact ⟨w₁, a, w₂, hm, hf, rfl⟩
+  · rintro ⟨w₁, a, w₂, hm, hf, rfl⟩
+    exact ⟨w₁, a, hm, w₂, b, hf, rfl, rfl⟩
+
+theorem can_pure {a b : α} : Can (Pure.pure a : ND α) b ↔ b = a := by
+  simp [Can]
+
+theorem can_bind {m : ND α} {f : α → ND β} {b : β} :
+    Can (m >>= f) b ↔ ∃ a, Can m a ∧ Can (f a) b := by
+  simp only [Can, mem_bind]
+  constructor
+  · rintro ⟨w, w₁, a, w₂, hm, hf, rfl⟩
+    exact ⟨a, ⟨w₁, hm⟩, ⟨w₂, hf⟩⟩
+  · rintro ⟨a, ⟨w₁, hm⟩, ⟨w₂, hf⟩⟩
+    exact ⟨w₁ ++ w₂, w₁, a, w₂, hm, hf, rfl⟩
+
+theorem mem_choose {site : String} {xs : List α} {w : Witness} {x : α} :
+    (w, x) ∈ choose site xs ↔ ∃ i, (x, i) ∈ xs.zipIdx ∧ w = [(site, i)] := by
+  simp only [choose, List.mem_map, Prod.exists, Prod.mk.injEq]
+  constructor
+  · rintro ⟨y, i, h, rfl, rfl⟩; exact ⟨i, h, rfl⟩
+  · rintro ⟨i, h, rfl⟩; exact ⟨x, i, h, rfl, rfl⟩
+
+theorem can_choose {site : String} {xs : List α} {x : α} : Can (choose site xs) x ↔ x ∈ xs := by
+  simp only [Can, mem_choose, List.mem_zipIdx_iff_getElem?]
+  constructor
+  · rintro ⟨_, i, h, -⟩
+    exact List.mem_iff_getElem?.2 ⟨i, h⟩
+  · intro h
+    obtain ⟨i, hi⟩ := List.mem_iff_getElem?.1 h
+    exact ⟨_, i, hi, rfl⟩
+
+end ND
+end Simulant

package/Simulant/NonVacuity.lean

@@ -0,0 +1,138 @@
+import Simulant.Lemmas
+
+/-!
+# Non-vacuity from totality (plan, Section 5.2)
+
+A round built from pieces that always have an outcome always has a
+successor; with an initial configuration, a synchronous round then has an
+admissible execution, so its correctness theorem is not vacuous.
+-/
+
+namespace Simulant
+
+variable {σ : Sig} [FlagSet σ.F]
+
+/-- Every hook always has an outcome. -/
+def Component.Total (c : Component σ) : Prop :=
+  (∀ ts C, ∃ e, ND.Can (c.beforeLook ts C) e) ∧
+  (∀ ts C ds, ∃ e, ND.Can (c.beforeMove ts C ds) e) ∧
+  (∀ ts C, ∃ e, ND.Can (c.afterMove ts C) e)
+
+theorem ND.can_of_mem {m : ND α} {w : Witness} {a : α} (h : (w, a) ∈ m) : ND.Can m a := ⟨w, h⟩
+
+theorem ND.exists_can {m : ND α} (h : m ≠ []) : ∃ a, ND.Can m a := by
+  obtain ⟨⟨w, a⟩, rest, hm⟩ := List.exists_cons_of_ne_nil h
+  exact ⟨a, w, by rw [hm]; exact List.mem_cons_self⟩
+
+theorem ND.can_bind_of {m : ND α} {f : α → ND β} {a : α} {b : β} (h1 : ND.Can m a) (h2 : ND.Can (f a) b) :
+    ND.Can (m >>= f) b :=
+  ND.can_bind.2 ⟨a, h1, h2⟩
+
+theorem chooseIfMany_total (site : String) {l : List α} (h : l ≠ []) : ∃ x, ND.Can (chooseIfMany site l) x := by
+  unfold chooseIfMany
+  split
+  · exact ⟨_, ND.can_pure.2 rfl⟩
+  · obtain ⟨x, hx⟩ := List.exists_mem_of_ne_nil l h
+    exact ⟨x, ND.can_choose.2 hx⟩
+
+theorem parallel_total (C : Config σ) :
+    ∀ (hooks : List (Config σ → ND (Effect σ))), (∀ hk ∈ hooks, ∃ e, ND.Can (hk C) e) →
+      ∃ e, ND.Can (parallel hooks C) e
+  | [], _ => ⟨_, ND.can_pure.2 rfl⟩
+  | hk :: hs, h => by
+    obtain ⟨e, he⟩ := h hk List.mem_cons_self
+    obtain ⟨r, hr⟩ := parallel_total C hs (fun hk' hm => h hk' (List.mem_cons_of_mem _ hm))
+    exact ⟨_, ND.can_bind_of he (ND.can_bind_of hr (ND.can_pure.2 rfl))⟩
+
+theorem combos_one (l : List α) : combos 1 l = l.map ([·]) := by
+  induction l with
+  | nil => rfl
+  | cons x xs ih => simp [combos, ih]
+
+namespace Model
+
+variable (m : Model σ) (act0 : σ.A)
+
+theorem activate_total (C : Config σ) : ∃ a, ND.Can (m.activate C) a := by
+  unfold Model.activate
+  dsimp only
+  split
+  · exact ⟨_, ND.can_pure.2 rfl⟩
+  · split
+    · exact ⟨_, ND.can_pure.2 rfl⟩
+    · rename_i h
+      obtain ⟨x, hx⟩ := List.exists_mem_of_ne_nil _ (fun he => h (List.isEmpty_iff.2 he))
+      refine ⟨[x], ND.can_choose.2 ?_⟩
+      simp only [nonemptySubsets, List.mem_flatMap, List.mem_range]
+      exact ⟨0, List.length_pos_of_mem hx, by rw [combos_one]; exact List.mem_map_of_mem hx⟩
+  · split
+    · exact ⟨_, ND.can_pure.2 rfl⟩
+    · rename_i h
+      obtain ⟨x, hx⟩ := List.exists_mem_of_ne_nil _ (fun he => h (List.isEmpty_iff.2 he))
+      exact ⟨[x], ND.can_choose.2 (List.mem_map_of_mem hx)⟩
+
+omit [FlagSet σ.F] in
+theorem frames_ne_nil (a : Agent σ) : m.frames a ≠ [] := by
+  unfold Model.frames; split <;> simp
+
+theorem options_total (ts : TState) (C : Config σ) (i : Fin σ.k)
+    (hview : ∀ f, ∃ v, ND.Can (m.view ts C i f) v) : ∃ d, ND.Can (m.options act0 ts C i) d := by
+  unfold Model.options
+  dsimp only
+  split
+  · exact ⟨_, ND.can_bind_of (ND.can_choose.2 (List.mem_cons_self)) (ND.can_pure.2 rfl)⟩
+  · obtain ⟨f, hf⟩ := chooseIfMany_total ("frame " ++ agentName i) (m.frames_ne_nil C.agents[i])
+    obtain ⟨v, hv⟩ := hview f
+    exact ⟨_, ND.can_bind_of hf (ND.can_bind_of hv (ND.can_pure.2 rfl))⟩
+
+theorem decideAll_total (ts : TState) (C : Config σ) (hview : ∀ i f, ∃ v, ND.Can (m.view ts C i f) v) :
+    ∀ (active : List (Fin σ.k)) (init : Fin σ.k → Decision σ),
+      ∃ ds, ND.Can (active.foldlM (fun ds i => do
+          let d ← m.options act0 ts C i
+          pure fun j => if j = i then d else ds j) init) ds
+  | [], init => ⟨init, ND.can_pure.2 rfl⟩
+  | i :: rest, init => by
+    obtain ⟨d, hd⟩ := m.options_total act0 ts C i (hview i)
+    obtain ⟨ds, hds⟩ := decideAll_total ts C hview rest (fun j => if j = i then d else init j)
+    exact ⟨ds, by
+      rw [List.foldlM_cons]
+      exact ND.can_bind_of (ND.can_bind_of hd (ND.can_pure.2 rfl)) hds⟩
+
+/-- A round built from total pieces always has a successor. -/
+theorem total (hts : m.tstates ≠ []) (hc : ∀ c ∈ m.components, c.Total)
+    (hview : ∀ ts C i f, ∃ v, ND.Can (m.view ts C i f) v) (C : Config σ) :
+    ∃ w a C', (w, (a, C')) ∈ m.roundA act0 C := by
+  obtain ⟨ts, hts⟩ := chooseIfMany_total "topology" hts
+  obtain ⟨e1, h1⟩ := parallel_total C (m.components.map fun c => c.beforeLook ts) (by
+    intro hk hm; simp only [List.mem_map] at hm; obtain ⟨c, hcm, rfl⟩ := hm; exact (hc c hcm).1 ts C)
+  obtain ⟨active, ha⟩ := m.activate_total (C.apply e1)
+  obtain ⟨ds, hd⟩ := m.decideAll_total act0 ts (C.apply e1) (hview ts _) active
+    (fun j => Decision.idle (C.apply e1).agents[j] act0)
+  obtain ⟨e2, h2⟩ := parallel_total (C.apply e1) (m.components.map fun c D => c.beforeMove ts D ds) (by
+    intro hk hm; simp only [List.mem_map] at hm; obtain ⟨c, hcm, rfl⟩ := hm; exact (hc c hcm).2.1 ts _ ds)
+  obtain ⟨e3, h3⟩ := parallel_total (moveAll ts ((C.apply e1).apply e2) ds)
+    (m.components.map fun c => c.afterMove ts) (by
+    intro hk hm; simp only [List.mem_map] at hm; obtain ⟨c, hcm, rfl⟩ := hm; exact (hc c hcm).2.2 ts _)
+  have : ND.Can (m.roundA act0 C) (active, (moveAll ts ((C.apply e1).apply e2) ds).apply e3) :=
+    ND.can_bind_of hts (ND.can_bind_of h1 (ND.can_bind_of ha (ND.can_bind_of hd
+      (ND.can_bind_of h2 (ND.can_bind_of h3 (ND.can_pure.2 rfl))))))
+  obtain ⟨w, hw⟩ := this
+  exact ⟨w, _, _, hw⟩
+
+/-- A synchronous round with an initial configuration and a successor for every configuration
+has an admissible execution. -/
+theorem hasExecution (init : ND (Config σ)) (hround : m.round = .fsync) (hinit : m.HasInitial init)
+    (htot : ∀ C, ∃ w a C', (w, (a, C')) ∈ m.roundA act0 C) : m.HasExecution act0 init := by
+  classical
+  let next : Config σ → Witness × List (Fin σ.k) × Config σ := fun C =>
+    let h := htot C
+    (Classical.choose h, Classical.choose (Classical.choose_spec h),
+      Classical.choose (Classical.choose_spec (Classical.choose_spec h)))
+  let config : Nat → Config σ := fun n => Nat.rec (Classical.choose hinit) (fun _ C => (next C).2.2) n
+  refine ⟨⟨config, fun n => (next (config n)).1, fun n => (next (config n)).2.1⟩, ⟨?_, fun n => ?_⟩, ?_⟩
+  · exact Classical.choose_spec hinit
+  · exact Classical.choose_spec (Classical.choose_spec (Classical.choose_spec (htot (config n))))
+  · intro h; exact False.elim (h hround)
+
+end Model
+end Simulant

package/Simulant/Ring.lean

@@ -0,0 +1,130 @@
+/-!
+# Rings, static and dynamic
+
+Nodes of a ring of size `N` are `Fin N`; edge `e` joins nodes `e` and
+`e + 1`. A frame is a `Bool` (mirrored or not). The per-round state of a
+dynamic ring is the list of missing edges, in the interpreter's order.
+-/
+
+namespace Simulant
+
+inductive Move where
+  | stay | cw | ccw
+deriving DecidableEq, Repr, Inhabited
+
+def Move.flip : Move → Move
+  | .cw => .ccw
+  | .ccw => .cw
+  | .stay => .stay
+
+/-- A local move, mapped to a global one through a frame. -/
+def toGlobal (mirrored : Bool) (m : Move) : Move := if mirrored then m.flip else m
+
+/-- The per-round state of the topology: the missing edges. -/
+abbrev TState := List Nat
+
+namespace Ring
+
+variable {N : Nat}
+
+def succ (p : Fin N) : Fin N := ⟨(p.val + 1) % N, Nat.mod_lt _ (by have := p.isLt; omega)⟩
+def pred (p : Fin N) : Fin N := ⟨(p.val + N - 1) % N, Nat.mod_lt _ (by have := p.isLt; omega)⟩
+
+/-- The neighbour in a global direction, whether or not the edge is present. -/
+def target (p : Fin N) : Move → Fin N
+  | .stay => p
+  | .cw => succ p
+  | .ccw => pred p
+
+/-- The node seen at local offset `i` from `p`, in a frame. -/
+def offset (p : Fin N) (mirrored : Bool) (i : Nat) : Fin N :=
+  if mirrored then ⟨(p.val + N - i % N) % N, Nat.mod_lt _ (by have := p.isLt; omega)⟩
+  else ⟨(p.val + i) % N, Nat.mod_lt _ (by have := p.isLt; omega)⟩
+
+/-- The node reached from `p` after `i` steps in a global direction, edges present or not. -/
+def advance (p : Fin N) : Move → Nat → Fin N
+  | .stay, _ => p
+  | .cw, i => offset p false i
+  | .ccw, i => offset p true i
+
+/-- Whether moving from `p` in direction `m` uses an edge present in state `ts`. -/
+def canMove (ts : TState) (p : Fin N) : Move → Bool
+  | .stay => true
+  | .cw => !ts.contains p.val
+  | .ccw => !ts.contains ((p.val + N - 1) % N)
+
+/-- Sets of at most `k` missing edges, extending `cur` with candidates in order. -/
+def extend (k : Nat) (cur : List Nat) : List Nat → List (List Nat)
+  | [] => []
+  | e :: rest =>
+    let next := cur ++ [e]
+    (if next.length ≤ k then next :: extend k next rest else []) ++ extend k cur rest
+
+/-- The states of `DynamicRing k`: at most `k` missing edges. -/
+def dynamicStates (N k : Nat) : List TState := [] :: extend k [] (List.range N)
+
+/-- The single state of a static ring. -/
+def staticStates : List TState := [[]]
+
+/-- Rotation by `r`. -/
+def rot (r : Nat) (p : Fin N) : Fin N := ⟨(p.val + r) % N, Nat.mod_lt _ (by have := p.isLt; omega)⟩
+
+end Ring
+end Simulant
+
+namespace Simulant.Ring
+
+variable {N : Nat}
+
+theorem rot_val (r : Nat) (p : Fin N) : (rot r p).val = (p.val + r) % N := rfl
+
+theorem rot_rot (a b : Nat) (p : Fin N) : rot a (rot b p) = rot (b + a) p := by
+  apply Fin.ext
+  simp only [rot_val, Nat.mod_add_mod, Nat.add_assoc]
+
+/-- Rotating by a multiple of `N` is the identity. -/
+theorem rot_mul (m : Nat) (p : Fin N) : rot (N * m) p = p := by
+  apply Fin.ext
+  show (p.val + N * m) % N = p.val
+  rw [Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt p.isLt]
+
+/-- The inverse of rotation by `r`. -/
+def unrot (r : Nat) (p : Fin N) : Fin N := rot (N - r % N) p
+
+theorem unrot_rot (r : Nat) (p : Fin N) : unrot r (rot r p) = p := by
+  have hN : 0 < N := Nat.lt_of_le_of_lt (Nat.zero_le _) p.isLt
+  have h : r + (N - r % N) = N * (r / N + 1) := by
+    have := Nat.mod_add_div r N
+    have := Nat.mod_lt r hN
+    rw [Nat.mul_add, Nat.mul_one]
+    omega
+  rw [unrot, rot_rot, h, rot_mul]
+
+theorem rot_inj (r : Nat) {p q : Fin N} (h : rot r p = rot r q) : p = q := by
+  rw [← unrot_rot r p, h, unrot_rot]
+
+@[simp] theorem rot_eq_rot (r : Nat) (p q : Fin N) : rot r p = rot r q ↔ p = q :=
+  ⟨rot_inj r, fun h => h ▸ rfl⟩
+
+@[simp] theorem rot_beq (r : Nat) (p q : Fin N) : (rot r p == rot r q) = (p == q) := by
+  by_cases h : p = q
+  · subst h; rw [beq_self_eq_true, beq_self_eq_true]
+  · have : rot r p ≠ rot r q := fun e => h (rot_inj r e)
+    rw [beq_eq_false_iff_ne.2 this, beq_eq_false_iff_ne.2 h]
+
+theorem rot_target (r : Nat) (p : Fin N) (m : Move) : target (rot r p) m = rot r (target p m) := by
+  have hN : 0 < N := Nat.lt_of_le_of_lt (Nat.zero_le _) p.isLt
+  cases m with
+  | stay => rfl
+  | cw =>
+    apply Fin.ext
+    show ((p.val + r) % N + 1) % N = ((p.val + 1) % N + r) % N
+    rw [Nat.mod_add_mod, Nat.mod_add_mod, Nat.add_right_comm]
+  | ccw =>
+    apply Fin.ext
+    show ((p.val + r) % N + N - 1) % N = ((p.val + N - 1) % N + r) % N
+    have h1 : (p.val + r) % N + N - 1 = (p.val + r) % N + (N - 1) := by omega
+    have h2 : p.val + N - 1 = p.val + (N - 1) := by omega
+    rw [h1, h2, Nat.mod_add_mod, Nat.mod_add_mod, Nat.add_right_comm]
+
+end Simulant.Ring

package/Simulant/Round.lean

@@ -0,0 +1,250 @@
+import Simulant.ND
+import Simulant.Ring
+
+/-!
+# The standard round (plan, Section 3.7)
+
+Everything is generic over a signature `Sig`: the ring size, the number of
+agents, and the composed types of flags, component agent fields, public
+state, memory, actions, world and view. A generated model file instantiates
+it.
+
+The round follows the interpreter step by step, so that the interpreter's
+witnesses are witnesses here (see `docs/ir.md`).
+-/
+
+namespace Simulant
+
+structure Sig where
+  N : Nat
+  k : Nat
+  /-- Flags. -/
+  F : Type
+  /-- Component agent fields. -/
+  X : Type
+  /-- Public state of the algorithm. -/
+  P : Type
+  /-- Memory of the algorithm. -/
+  M : Type
+  /-- Actions other than moves. -/
+  A : Type
+  /-- World fields. -/
+  W : Type
+  /-- What the algorithm sees: one field per sensor it uses. -/
+  V : Type
+
+inductive Acts where
+  | never | adversary | algorithm
+deriving DecidableEq, Repr
+
+/-- The flags of a composition, generated as a structure of `Bool`s. -/
+class FlagSet (F : Type) where
+  none : F
+  merge : F → F → F
+  correct : F → Bool
+  present : F → Bool
+  acts : F → Acts
+
+/-- Flags are only ever raised: an agent that never acts never acts again. -/
+class LawfulFlagSet (F : Type) [FlagSet F] : Prop where
+  acts_merge_never : ∀ f g : F, FlagSet.acts f = .never → FlagSet.acts (FlagSet.merge f g) = .never
+
+variable {σ : Sig}
+
+structure Agent (σ : Sig) where
+  pos : Fin σ.N
+  flags : σ.F
+  fields : σ.X
+  pub : σ.P
+  mem : σ.M
+
+structure Config (σ : Sig) where
+  agents : Vector (Agent σ) σ.k
+  world : σ.W
+
+/-- A lens on the part of a state owned by one component. -/
+structure Lens (S T : Type) where
+  get : S → T
+  set : S → T → S
+
+/-- What a hook does: update its component's world fields, and raise flags. -/
+structure Effect (σ : Sig) where
+  world : σ.W → σ.W
+  raise : Fin σ.k → σ.F
+
+def Effect.none [FlagSet σ.F] : Effect σ := ⟨id, fun _ => FlagSet.none⟩
+
+/-- Merging the effects of two hooks run on the same snapshot. -/
+def Effect.combine [FlagSet σ.F] (e f : Effect σ) : Effect σ :=
+  ⟨f.world ∘ e.world, fun a => FlagSet.merge (e.raise a) (f.raise a)⟩
+
+def Config.apply [FlagSet σ.F] (C : Config σ) (e : Effect σ) : Config σ :=
+  { agents := Vector.ofFn fun i => { C.agents[i] with flags := FlagSet.merge C.agents[i].flags (e.raise i) },
+    world := e.world C.world }
+
+structure Decision (σ : Sig) where
+  decided : Bool
+  move : Move
+  pub : σ.P
+  mem : σ.M
+  act : σ.A
+
+/-- What the algorithm returns; the move is local. -/
+structure Out (σ : Sig) where
+  move : Move
+  pub : σ.P
+  mem : σ.M
+  act : σ.A
+
+structure Component (σ : Sig) where
+  beforeLook : TState → Config σ → ND (Effect σ)
+  beforeMove : TState → Config σ → (Fin σ.k → Decision σ) → ND (Effect σ)
+  afterMove : TState → Config σ → ND (Effect σ)
+
+/-! ## Components that own part of the state
+
+A component's hooks return an effect on its own part of the world only;
+the composition lifts it through the component's lens. So no component
+can write another's fields, by construction, and the lemma that says so
+(`Hooks.toComponent_preserves`) is proved once for all components. -/
+
+/-- An effect on the part of the world a component owns. -/
+structure OwnEffect (σ : Sig) (Wc : Type) where
+  world : Wc → Wc
+  raise : Fin σ.k → σ.F
+
+def OwnEffect.lift (L : Lens σ.W Wc) (e : OwnEffect σ Wc) : Effect σ :=
+  ⟨fun w => L.set w (e.world (L.get w)), e.raise⟩
+
+/-- The hooks of a component that owns world part `Wc`. -/
+structure Hooks (σ : Sig) (Wc : Type) where
+  beforeLook : TState → Config σ → ND (OwnEffect σ Wc)
+  beforeMove : TState → Config σ → (Fin σ.k → Decision σ) → ND (OwnEffect σ Wc)
+  afterMove : TState → Config σ → ND (OwnEffect σ Wc)
+
+def Hooks.toComponent (h : Hooks σ Wc) (L : Lens σ.W Wc) : Component σ where
+  beforeLook ts C := do let e ← h.beforeLook ts C; pure (e.lift L)
+  beforeMove ts C ds := do let e ← h.beforeMove ts C ds; pure (e.lift L)
+  afterMove ts C := do let e ← h.afterMove ts C; pure (e.lift L)
+
+/-- The lens of a component that owns no world field. -/
+def Lens.unit (S : Type) : Lens S Unit := ⟨fun _ => (), fun s _ => s⟩
+
+/-- A lens whose `get` reads back what `set` wrote. -/
+class LawfulLens (L : Lens S T) : Prop where
+  get_set : ∀ s t, L.get (L.set s t) = t
+
+inductive FrameModel (σ : Sig) where
+  | common
+  | dynamic
+  | persistent (get : σ.X → Bool)
+
+inductive RoundKind where
+  | fsync | ssync | sequential
+deriving DecidableEq, Repr
+
+structure Model (σ : Sig) where
+  tstates : List TState
+  components : List (Component σ)
+  frame : FrameModel σ
+  round : RoundKind
+  /-- The sensors of an activation: configuration, agent, frame. -/
+  view : TState → Config σ → Fin σ.k → Bool → ND σ.V
+  step : σ.M → σ.P → σ.V → Out σ
+
+/-- All hooks of a hook point read the same snapshot; their effects are merged. -/
+def parallel [FlagSet σ.F] : List (Config σ → ND (Effect σ)) → Config σ → ND (Effect σ)
+  | [], _ => pure Effect.none
+  | h :: hs, C => do
+    let e ← h C
+    let r ← parallel hs C
+    pure (e.combine r)
+
+/-- The decision of an agent that does not decide: stay, keep its state. -/
+def Decision.idle (a : Agent σ) (act : σ.A) : Decision σ :=
+  { decided := false, move := .stay, pub := a.pub, mem := a.mem, act }
+
+/-- Rigid movement along the edges present; only agents that still act apply their decision. -/
+def moveAll [FlagSet σ.F] (ts : TState) (C : Config σ) (ds : Fin σ.k → Decision σ) : Config σ :=
+  { C with agents := Vector.ofFn fun i =>
+      let a := C.agents[i]
+      let d := ds i
+      if d.decided && FlagSet.acts a.flags != .never then
+        { a with
+          pos := if d.move != .stay && Ring.canMove ts a.pos d.move then Ring.target a.pos d.move else a.pos,
+          pub := d.pub, mem := d.mem }
+      else a }
+
+/-- Sub-lists of `l` with `n` elements, in lexicographic order of positions. -/
+def combos : Nat → List α → List (List α)
+  | 0, _ => [[]]
+  | _ + 1, [] => []
+  | n + 1, x :: xs => (combos n xs).map (x :: ·) ++ combos (n + 1) xs
+
+/-- Nonempty sub-lists, smallest first. -/
+def nonemptySubsets (l : List α) : List (List α) :=
+  (List.range l.length).flatMap fun s => combos (s + 1) l
+
+def agentName (i : Fin k) : String := "a" ++ toString i.val
+
+/-- A single option is no choice: it leaves no witness. -/
+def chooseIfMany (site : String) : List α → ND α
+  | [x] => pure x
+  | xs => ND.choose site xs
+
+namespace Model
+
+variable [FlagSet σ.F] (m : Model σ)
+
+/-- FSYNC: all eligible agents; SSYNC: a nonempty subset; sequential: a singleton. -/
+def activate (C : Config σ) : ND (List (Fin σ.k)) :=
+  let eligible := (List.finRange σ.k).filter fun i => FlagSet.acts C.agents[i].flags != .never
+  match m.round with
+  | .fsync => pure eligible
+  | .ssync => if eligible.isEmpty then pure eligible else ND.choose "activation" (nonemptySubsets eligible)
+  | .sequential => if eligible.isEmpty then pure eligible else ND.choose "activation" (eligible.map ([·]))
+
+def frames (a : Agent σ) : List Bool :=
+  match m.frame with
+  | .common => [false]
+  | .dynamic => [false, true]
+  | .persistent get => [get a.fields]
+
+/-- The decisions one agent may take. -/
+def options (act0 : σ.A) (ts : TState) (C : Config σ) (i : Fin σ.k) : ND (Decision σ) :=
+  let a := C.agents[i]
+  match FlagSet.acts a.flags with
+  | .adversary => do
+    let mv ← ND.choose ("adversary " ++ agentName i) [Move.stay, .cw, .ccw]
+    pure { Decision.idle a act0 with decided := true, move := mv }
+  | _ => do
+    let f ← chooseIfMany ("frame " ++ agentName i) (m.frames a)
+    let v ← m.view ts C i f
+    let o := m.step a.mem a.pub v
+    pure { decided := true, move := toGlobal f o.move, pub := o.pub, mem := o.mem, act := o.act }
+
+/-- The product, over the activated agents, of their decisions. -/
+def decideAll (act0 : σ.A) (ts : TState) (C : Config σ) (active : List (Fin σ.k)) : ND (Fin σ.k → Decision σ) :=
+  active.foldlM (fun ds i => do
+      let d ← m.options act0 ts C i
+      pure fun j => if j = i then d else ds j)
+    (fun j => Decision.idle C.agents[j] act0)
+
+/-- One round, with the activated agents. `act0` is the default value of the actions. -/
+def roundA (act0 : σ.A) (C : Config σ) : ND (List (Fin σ.k) × Config σ) := do
+  let ts ← chooseIfMany "topology" m.tstates
+  let e ← parallel (m.components.map fun c => c.beforeLook ts) C
+  let C := C.apply e
+  let active ← m.activate C
+  let ds ← m.decideAll act0 ts C active
+  let e ← parallel (m.components.map fun c D => c.beforeMove ts D ds) C
+  let C := moveAll ts (C.apply e) ds
+  let e ← parallel (m.components.map fun c => c.afterMove ts) C
+  pure (active, C.apply e)
+
+/-- The step relation, with witnesses. -/
+def Step (act0 : σ.A) (C : Config σ) (w : Witness) (C' : Config σ) : Prop :=
+  ∃ active, (w, (active, C')) ∈ m.roundA act0 C
+
+end Model
+end Simulant

package/Simulant.lean

@@ -0,0 +1,9 @@
+import Simulant.ND
+import Simulant.Ring
+import Simulant.Round
+import Simulant.Builtins
+import Simulant.Exec
+import Simulant.Lemmas
+import Simulant.Equivariance
+import Simulant.NonVacuity
+import Simulant.Invariants

package/lakefile.toml

@@ -0,0 +1,13 @@
+name = "simulant"
+version = "0.1.0"
+defaultTargets = ["Simulant"]
+
+# The semantic core and the component library (plan, Section 5.1).
+[[lean_lib]]
+name = "Simulant"
+globs = ["Simulant", "Simulant.+"]
+
+# Generated model files and their proofs, for the Phase 2 prototype.
+[[lean_lib]]
+name = "Examples"
+globs = ["Examples.+"]

package/lean-toolchain

@@ -0,0 +1 @@
+leanprover/lean4:v4.35.0