From 4ced16f04ea868a8c59c0696222a867f349933af Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Sat, 25 Apr 2026 08:42:08 +0000
Subject: [PATCH] smalltalk: Object>>perform: family + 10 tests

---
 lib/smalltalk/eval.sx             | 10 ++++++
 lib/smalltalk/tests/reflection.sx | 56 +++++++++++++++++++++++++++++++
 plans/smalltalk-on-sx.md          |  3 +-
 3 files changed, 68 insertions(+), 1 deletion(-)

diff --git a/lib/smalltalk/eval.sx b/lib/smalltalk/eval.sx
index cca806db..2234c21f 100644
--- a/lib/smalltalk/eval.sx
+++ b/lib/smalltalk/eval.sx
@@ -529,6 +529,16 @@
           (cond
             ((st-class-ref? receiver) (st-class-ref "Metaclass"))
             (else (st-class-ref cls))))
+        ;; perform: / perform:with: / perform:withArguments:
+        ((= selector "perform:")
+          (st-send receiver (str (nth args 0)) (list)))
+        ((= selector "perform:withArguments:")
+          (st-send receiver (str (nth args 0)) (nth args 1)))
+        ((or (= selector "perform:with:")
+             (= selector "perform:with:with:")
+             (= selector "perform:with:with:with:")
+             (= selector "perform:with:with:with:with:"))
+          (st-send receiver (str (nth args 0)) (slice args 1 (len args))))
         ((or (= cls "SmallInteger") (= cls "Float"))
           (st-num-send receiver selector args))
         ((or (= cls "String") (= cls "Symbol"))
diff --git a/lib/smalltalk/tests/reflection.sx b/lib/smalltalk/tests/reflection.sx
index ffe6b10b..692664a1 100644
--- a/lib/smalltalk/tests/reflection.sx
+++ b/lib/smalltalk/tests/reflection.sx
@@ -85,4 +85,60 @@
 (st-test "methodDict at: returns method record dict"
   (dict? (get (ev "Cat methodDict") "miaow")) true)
 
+;; ── 11. Object>>perform: ──
+(st-test "perform: a unary selector"
+  (str (evp "^ Cat new perform: #miaow"))
+  "miaow")
+
+(st-test "perform: works on native receiver"
+  (ev "42 perform: #printString")
+  "42")
+
+(st-test "perform: with no method falls back to DNU"
+  ;; With no Object DNU defined here, perform: a missing selector raises.
+  ;; Wrap in guard to catch.
+  (let ((caught false))
+    (begin
+      (guard (c (true (set! caught true)))
+        (evp "^ Cat new perform: #nonexistent"))
+      caught))
+  true)
+
+;; ── 12. Object>>perform:with: ──
+(st-class-add-method! "Cat" "say:"
+  (st-parse-method "say: aMsg ^ aMsg"))
+
+(st-test "perform:with: passes arg through"
+  (evp "^ Cat new perform: #say: with: 'hi'") "hi")
+
+(st-test "perform:with: on native"
+  (ev "10 perform: #+ with: 5") 15)
+
+;; ── 13. Object>>perform:with:with: (multi-arg form) ──
+(st-class-add-method! "Cat" "describe:and:"
+  (st-parse-method "describe: a and: b ^ a , b"))
+
+(st-test "perform:with:with: keyword selector"
+  (evp "^ Cat new perform: #describe:and: with: 'foo' with: 'bar'")
+  "foobar")
+
+;; ── 14. Object>>perform:withArguments: ──
+(st-test "perform:withArguments: empty array"
+  (str (evp "^ Cat new perform: #miaow withArguments: #()"))
+  "miaow")
+
+(st-test "perform:withArguments: 1 element"
+  (evp "^ Cat new perform: #say: withArguments: #('hello')")
+  "hello")
+
+(st-test "perform:withArguments: 2 elements"
+  (evp "^ Cat new perform: #describe:and: withArguments: #('a' 'b')")
+  "ab")
+
+(st-test "perform:withArguments: on native receiver"
+  (ev "20 perform: #+ withArguments: #(5)") 25)
+
+;; perform: routes through ordinary dispatch, so super, DNU, primitives
+;; all still apply naturally. No special test for that — it's free.
+
 (list st-test-pass st-test-fail)
diff --git a/plans/smalltalk-on-sx.md b/plans/smalltalk-on-sx.md
index a8e3d7e0..a41148ce 100644
--- a/plans/smalltalk-on-sx.md
+++ b/plans/smalltalk-on-sx.md
@@ -80,7 +80,7 @@ Core mapping:
 
 ### Phase 4 — reflection + MOP
 - [x] `Object>>class`, `class>>name`, `class>>superclass`, `class>>methodDict`, `class>>selectors`. `class` is universal in `st-primitive-send` (returns `Metaclass` for class-refs, the receiver's class otherwise). Class-side dispatch gains `methodDict`/`classMethodDict` (raw dict), `selectors`/`classSelectors` (Array of symbols), `instanceVariableNames` (own), `allInstVarNames` (inherited + own). 26 tests in `lib/smalltalk/tests/reflection.sx`.
-- [ ] `Object>>perform:` / `perform:with:` / `perform:withArguments:`
+- [x] `Object>>perform:` / `perform:with:` / `perform:with:with:` / `perform:with:with:with:` / `perform:with:with:with:with:` / `perform:withArguments:`. Universal in `st-primitive-send`; routes back through `st-send` so user methods, primitives, super, and DNU all still apply. Selector arg can be a symbol or string (we `str` it). 10 new tests in `lib/smalltalk/tests/reflection.sx`.
 - [ ] `Object>>respondsTo:`, `Object>>isKindOf:`, `Object>>isMemberOf:`
 - [ ] `Behavior>>compile:` — runtime method addition
 - [ ] `Object>>becomeForward:` (one-way become; rewrites the class field of `aReceiver`)
@@ -108,6 +108,7 @@ Core mapping:
 
 _Newest first. Agent appends on every commit._
 
+- 2026-04-25: `Object>>perform:` family + 10 tests. Universal dispatch via `st-send` after `(str (nth args 0))` for the selector. 439/439 total.
 - 2026-04-25: Phase 4 reflection accessors (`lib/smalltalk/tests/reflection.sx`, 26 tests). Universal `Object>>class`, plus `methodDict`/`selectors`/`instanceVariableNames`/`allInstVarNames`/`classMethodDict`/`classSelectors` on class-refs. 429/429 total.
 - 2026-04-25: conformance.sh + scoreboard.{json,md} (`lib/smalltalk/conformance.sh`, `lib/smalltalk/scoreboard.json`, `lib/smalltalk/scoreboard.md`). Single-pass runner over `test.sh -v`; baseline at 5 programs / 39 corpus tests / 403 total. **Phase 3 complete.**
 - 2026-04-25: classic-corpus #5 Life (`tests/programs/life.st`, 4 tests). Spec-interpreter Conway's Life with edge handling. Block + blinker + glider initial setup verified; larger step counts pending JIT (each spec-interpreter step is ~5-8s on a 5x5 grid). Added `{e1. e2. e3}` dynamic array literal to parser + evaluator. 403/403 total.