smalltalk: Object>>perform: family + 10 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-25 08:42:08 +00:00
parent 9954a234ae
commit 4ced16f04e
3 changed files with 68 additions and 1 deletions

View File

@@ -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"))

View File

@@ -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)

View File

@@ -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.