smalltalk: reflection accessors (Object>>class, methodDict, selectors)

lib/smalltalk/eval.sx

@@ -523,7 +523,12 @@
   (fn
     (receiver selector args)
     (let ((cls (st-class-of receiver)))
+      ;; Universal Object messages — work on any receiver type.
       (cond
+        ((= selector "class")
+          (cond
+            ((st-class-ref? receiver) (st-class-ref "Metaclass"))
+            (else (st-class-ref cls))))
         ((or (= cls "SmallInteger") (= cls "Float"))
           (st-num-send receiver selector args))
         ((or (= cls "String") (= cls "Symbol"))
@@ -778,6 +783,32 @@
         ((= selector "superclass")
           (let ((s (st-class-superclass name)))
             (cond ((= s nil) nil) (else (st-class-ref s)))))
+        ((= selector "methodDict")
+          ;; The class's own method dictionary (instance side).
+          (get (st-class-get name) :methods))
+        ((= selector "classMethodDict")
+          (get (st-class-get name) :class-methods))
+        ((= selector "selectors")
+          ;; Own instance-side selectors as an Array of symbols.
+          (let ((out (list)))
+            (begin
+              (for-each
+                (fn (k) (append! out (make-symbol k)))
+                (keys (get (st-class-get name) :methods)))
+              out)))
+        ((= selector "classSelectors")
+          (let ((out (list)))
+            (begin
+              (for-each
+                (fn (k) (append! out (make-symbol k)))
+                (keys (get (st-class-get name) :class-methods)))
+              out)))
+        ((= selector "instanceVariableNames")
+          ;; Own ivars as an Array of strings (matches Pharo).
+          (get (st-class-get name) :ivars))
+        ((= selector "allInstVarNames")
+          ;; Inherited + own ivars in declaration order (root first).
+          (st-class-all-ivars name))
         ;; Class definition: `Object subclass: #Foo instanceVariableNames: 'x y'`.
         ;; Supports the short `subclass:` and the full
         ;; `subclass:instanceVariableNames:classVariableNames:package:` form.

lib/smalltalk/tests/reflection.sx

@@ -0,0 +1,88 @@
+;; Reflection accessors: Object>>class, class>>name, class>>superclass,
+;; class>>methodDict, class>>selectors. Phase 4 starting point.
+
+(set! st-test-pass 0)
+(set! st-test-fail 0)
+(set! st-test-fails (list))
+
+(st-bootstrap-classes!)
+(define ev (fn (src) (smalltalk-eval src)))
+(define evp (fn (src) (smalltalk-eval-program src)))
+
+;; ── 1. Object>>class on native receivers ──
+(st-test "42 class name"        (ev "42 class name")     "SmallInteger")
+(st-test "3.14 class name"      (ev "3.14 class name")   "Float")
+(st-test "'hi' class name"      (ev "'hi' class name")   "String")
+(st-test "#foo class name"      (ev "#foo class name")   "Symbol")
+(st-test "true class name"      (ev "true class name")   "True")
+(st-test "false class name"     (ev "false class name")  "False")
+(st-test "nil class name"       (ev "nil class name")    "UndefinedObject")
+(st-test "$a class name"        (ev "$a class name")     "String")
+(st-test "#(1 2 3) class name"  (ev "#(1 2 3) class name") "Array")
+(st-test "[42] class name"      (ev "[42] class name")   "BlockClosure")
+
+;; ── 2. Object>>class on user instances ──
+(st-class-define! "Cat" "Object" (list "name"))
+(st-test "user instance class name"
+  (evp "^ Cat new class name") "Cat")
+(st-test "user instance class superclass name"
+  (evp "^ Cat new class superclass name") "Object")
+
+;; ── 3. class>>name / class>>superclass ──
+(st-test "class>>name on Object" (ev "Object name") "Object")
+(st-test "class>>superclass on Object" (ev "Object superclass") nil)
+(st-test "class>>superclass on Symbol"
+  (ev "Symbol superclass name") "String")
+(st-test "class>>superclass on String"
+  (ev "String superclass name") "ArrayedCollection")
+
+;; ── 4. class>>class returns Metaclass ──
+(st-test "Cat class is Metaclass"
+  (ev "Cat class name") "Metaclass")
+
+;; ── 5. class>>methodDict ──
+(st-class-add-method! "Cat" "miaow" (st-parse-method "miaow ^ #miaow"))
+(st-class-add-method! "Cat" "purr"  (st-parse-method "purr ^ #purr"))
+
+(st-test
+  "methodDict has expected keys"
+  (sort (keys (ev "Cat methodDict")))
+  (sort (list "miaow" "purr")))
+
+(st-test
+  "methodDict size after two adds"
+  (len (keys (ev "Cat methodDict")))
+  2)
+
+;; ── 6. class>>selectors ──
+(st-test
+  "selectors returns Array of symbols"
+  (sort (map (fn (s) (str s)) (ev "Cat selectors")))
+  (sort (list "miaow" "purr")))
+
+;; ── 7. class>>instanceVariableNames ──
+(st-test "instance variable names"
+  (ev "Cat instanceVariableNames") (list "name"))
+
+(st-class-define! "Kitten" "Cat" (list "age"))
+(st-test "subclass own ivars"
+  (ev "Kitten instanceVariableNames") (list "age"))
+(st-test "subclass allInstVarNames includes inherited"
+  (ev "Kitten allInstVarNames") (list "name" "age"))
+
+;; ── 8. methodDict reflects new methods ──
+(st-class-add-method! "Cat" "scratch" (st-parse-method "scratch ^ #scratch"))
+(st-test "methodDict updated after add"
+  (len (keys (ev "Cat methodDict"))) 3)
+
+;; ── 9. classMethodDict / classSelectors ──
+(st-class-add-class-method! "Cat" "named:"
+  (st-parse-method "named: aName ^ self new"))
+(st-test "classSelectors"
+  (map (fn (s) (str s)) (ev "Cat classSelectors")) (list "named:"))
+
+;; ── 10. Method records are usable values ──
+(st-test "methodDict at: returns method record dict"
+  (dict? (get (ev "Cat methodDict") "miaow")) true)
+
+(list st-test-pass st-test-fail)

plans/smalltalk-on-sx.md

@@ -79,7 +79,7 @@ Core mapping:
 - [x] `lib/smalltalk/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md`. The runner runs `bash lib/smalltalk/test.sh -v` once, parses per-file counts, and emits both files. JSON has date / program names / corpus-test count / all-test pass/total / exit code. Markdown has a totals table, the program list, the verbatim per-file test counts block, and notes about JIT-deferred work. Both are checked into the tree as the latest baseline; the runner overwrites them.
 
 ### Phase 4 — reflection + MOP
-- [ ] `Object>>class`, `class>>name`, `class>>superclass`, `class>>methodDict`, `class>>selectors`
+- [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:`
 - [ ] `Object>>respondsTo:`, `Object>>isKindOf:`, `Object>>isMemberOf:`
 - [ ] `Behavior>>compile:` — runtime method addition
@@ -108,6 +108,7 @@ Core mapping:
 
 _Newest first. Agent appends on every commit._
 
+- 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.
 - 2026-04-25: classic-corpus #4 mandelbrot (`tests/programs/mandelbrot.st`, 7 tests). Escape-time iterator + grid counter. Discovered + fixed an immutable-list bug in `lit-array` eval — `map` produced an immutable list so `at:put:` raised; rebuilt via `append!`. Quicksort tests had been silently dropping ~7 cases due to that bug; now actually mutate. 399/399 total.