smalltalk: Behavior>>compile: + addSelector:/removeSelector: + 9 tests

lib/smalltalk/eval.sx

@@ -872,6 +872,29 @@
              (= selector "category:")
              (= selector "comment:"))
           cref)
+        ;; Behavior>>compile: parses the source string as a method and
+        ;; installs it. Returns the selector as a symbol.
+        ;; Sister forms: compile:classified: and compile:notifying:
+        ;; ignore the extra arg, mirroring Pharo's tolerant behaviour.
+        ((or (= selector "compile:")
+             (= selector "compile:classified:")
+             (= selector "compile:notifying:"))
+          (let ((src (nth args 0)))
+            (let ((method-ast (st-parse-method (str src))))
+              (st-class-add-method!
+                name (get method-ast :selector) method-ast)
+              (make-symbol (get method-ast :selector)))))
+        ((or (= selector "addSelector:withMethod:")
+             (= selector "addSelector:method:"))
+          (let
+            ((sel (str (nth args 0)))
+              (method-ast (nth args 1)))
+            (begin
+              (st-class-add-method! name sel method-ast)
+              (make-symbol sel))))
+        ((= selector "removeSelector:")
+          (let ((sel (str (nth args 0))))
+            (st-class-remove-method! name sel)))
         ((= selector "printString") name)
         ((= selector "class") (st-class-ref "Metaclass"))
         ((= selector "==") (and (st-class-ref? (nth args 0))

lib/smalltalk/tests/reflection.sx

@@ -189,4 +189,53 @@
 (st-test "respondsTo: with string arg"
   (evp "^ Cat new respondsTo: 'miaow'") true)
 
-(list st-test-pass st-test-fail)
+;; ── 18. Behavior>>compile: — runtime method addition ──
+(st-test "compile: a unary method"
+  (begin
+    (evp "Cat compile: 'whisker ^ 99'")
+    (evp "^ Cat new whisker"))
+  99)
+
+(st-test "compile: returns the selector as a symbol"
+  (str (evp "^ Cat compile: 'twitch ^ #twitch'"))
+  "twitch")
+
+(st-test "compile: a keyword method"
+  (begin
+    (evp "Cat compile: 'doubled: x ^ x * 2'")
+    (evp "^ Cat new doubled: 21"))
+  42)
+
+(st-test "compile: a method with temps and blocks"
+  (begin
+    (evp "Cat compile: 'sumTo: n | s | s := 0. 1 to: n do: [:i | s := s + i]. ^ s'")
+    (evp "^ Cat new sumTo: 10"))
+  55)
+
+(st-test "recompile overrides existing method"
+  (begin
+    (evp "Cat compile: 'miaow ^ #ahem'")
+    (str (evp "^ Cat new miaow")))
+  "ahem")
+
+;; methodDict reflects the new method.
+(st-test "compile: registers in methodDict"
+  (has-key? (ev "Cat methodDict") "whisker") true)
+
+;; respondsTo: notices the new method.
+(st-test "respondsTo: sees compiled method"
+  (evp "^ Cat new respondsTo: #whisker") true)
+
+;; Behavior>>removeSelector: takes a method back out.
+(st-test "removeSelector: drops the method"
+  (begin
+    (evp "Cat removeSelector: #whisker")
+    (evp "^ Cat new respondsTo: #whisker"))
+  false)
+
+;; compile:classified: ignores the extra arg.
+(st-test "compile:classified: works"
+  (begin
+    (evp "Cat compile: 'taggedMethod ^ #yes' classified: 'demo'")
+    (str (evp "^ Cat new taggedMethod")))
+  "yes")

plans/smalltalk-on-sx.md

@@ -82,7 +82,7 @@ Core mapping:
 - [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`.
 - [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`.
 - [x] `Object>>respondsTo:`, `Object>>isKindOf:`, `Object>>isMemberOf:`. Universal in `st-primitive-send`. `respondsTo:` searches user method dicts (instance- or class-side based on receiver kind); native primitive selectors aren't enumerated, documented limitation. `isKindOf:` walks `st-class-inherits-from?`; `isMemberOf:` is exact class equality. 26 new tests in `reflection.sx`.
-- [ ] `Behavior>>compile:` — runtime method addition
+- [x] `Behavior>>compile:` — runtime method addition. Class-side `compile:` parses the source via `st-parse-method` and installs via `st-class-add-method!`. Sister forms `compile:classified:` and `compile:notifying:` ignore the extra arg (Pharo-tolerant). Returns the selector as a symbol. Also added `addSelector:withMethod:` (raw AST install) and `removeSelector:`. 9 new tests in `reflection.sx`.
 - [ ] `Object>>becomeForward:` (one-way become; rewrites the class field of `aReceiver`)
 - [ ] Exceptions: `Exception`, `Error`, `signal`, `signal:`, `on:do:`, `ensure:`, `ifCurtailed:` — built on top of SX `handler-bind`/`raise`
 
@@ -108,6 +108,7 @@ Core mapping:
 
 _Newest first. Agent appends on every commit._
 
+- 2026-04-25: `Behavior>>compile:` + sisters + 9 tests. Parses source via `st-parse-method`, installs via runtime helpers; also added `addSelector:withMethod:` and `removeSelector:`. 474/474 total.
 - 2026-04-25: `respondsTo:` / `isKindOf:` / `isMemberOf:` + 26 tests. Universal at `st-primitive-send`. 465/465 total.
 - 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.