smalltalk: String>>format: + universal printOn: + 18 tests

lib/smalltalk/eval.sx

@@ -615,6 +615,25 @@
             (cond
               ((not (st-class-ref? arg)) false)
               (else (st-class-inherits-from? target-cls (get arg :name))))))
+        ;; Universal printOn: — send `printString` (so user overrides win)
+        ;; and write the result to the stream argument. Coerce the
+        ;; printString result via SX `str` so it's an iterable String —
+        ;; if a user method returns a Symbol, the stream's nextPutAll:
+        ;; (which loops with `do:`) needs a String to walk character by
+        ;; character.
+        ((= selector "printOn:")
+          (let
+            ((stream (nth args 0))
+              (s (str (st-send receiver "printString" (list)))))
+            (begin
+              (st-send stream "nextPutAll:" (list s))
+              receiver)))
+        ;; Universal printString fallback for receivers no primitive table
+        ;; handles (notably user st-instances). Native types implement
+        ;; their own printString in the primitive senders below.
+        ((and (= selector "printString")
+              (or (st-instance? receiver) (st-class-ref? receiver)))
+          (st-printable-string receiver))
         ;; isMemberOf: aClass — exact class match.
         ((= selector "isMemberOf:")
           (let
@@ -677,6 +696,97 @@
         ((st-class-ref? receiver) (st-class-side-send receiver selector args))
         (else :unhandled)))))
 
+;; Default printable representation. User instances render as
+;; "an X" (or "a X" for vowel-initial classes); class-refs render as
+;; their name. Native types are handled by their primitive senders.
+(define
+  st-printable-string
+  (fn
+    (v)
+    (cond
+      ((st-class-ref? v) (get v :name))
+      ((st-instance? v)
+        (let ((cls (get v :class)))
+          (let ((article (if (st-vowel-initial? cls) "an " "a ")))
+            (str article cls))))
+      (else (str v)))))
+
+(define
+  st-vowel-initial?
+  (fn
+    (s)
+    (cond
+      ((= (len s) 0) false)
+      (else
+        (let ((c (nth s 0)))
+          (or (= c "A") (= c "E") (= c "I") (= c "O") (= c "U")
+              (= c "a") (= c "e") (= c "i") (= c "o") (= c "u")))))))
+
+;; Pharo-style {N}-substitution. Walks the source, when a '{' starts a
+;; valid numeric index, substitutes the corresponding (1-indexed) item
+;; from the args collection. Unmatched braces are preserved.
+(define
+  st-format-step
+  (fn
+    (src args out i n)
+    (let ((c (nth src i)))
+      (cond
+        ((not (= c "{"))
+          {:emit c :advance 1})
+        (else
+          (let ((close (st-find-close-brace src i)))
+            (cond
+              ((= close -1) {:emit c :advance 1})
+              (else
+                (let ((idx (parse-number (slice src (+ i 1) close))))
+                  (cond
+                    ((and (number? idx)
+                          (integer? idx)
+                          (> idx 0)
+                          (<= idx (len args)))
+                      {:emit (str (nth args (- idx 1)))
+                       :advance (- (+ close 1) i)})
+                    (else
+                      {:emit c :advance 1})))))))))))
+
+(define
+  st-format-string
+  (fn
+    (src args)
+    (let ((out (list)) (i 0) (n (len src)))
+      (begin
+        (define
+          fmt-loop
+          (fn
+            ()
+            (when
+              (< i n)
+              (let ((step (st-format-step src args out i n)))
+                (begin
+                  (append! out (get step :emit))
+                  (set! i (+ i (get step :advance)))
+                  (fmt-loop))))))
+        (fmt-loop)
+        (join "" out)))))
+
+(define
+  st-find-close-brace
+  (fn
+    (src start)
+    (let ((i (+ start 1)) (n (len src)) (found -1))
+      (begin
+        (define
+          fc-loop
+          (fn
+            ()
+            (when
+              (and (< i n) (= found -1))
+              (cond
+                ((= (nth src i) "}") (set! found i))
+                (else (begin (set! i (+ i 1)) (fc-loop)))))))
+        (fc-loop)
+        found))))
+
 (define
   st-num-send
   (fn
@@ -826,6 +936,11 @@
       ((= selector "last") (nth s (- (len s) 1)))
       ((= selector "copyFrom:to:")
         (slice s (- (nth args 0) 1) (nth args 1)))
+      ;; String>>format: — Pharo-style {N}-substitution.
+      ;;   '{1} loves {2}' format: #('Alice' 'Bob') → 'Alice loves Bob'
+      ;; Indexes are 1-based. Unmatched braces are kept literally.
+      ((= selector "format:")
+        (st-format-string s (nth args 0)))
       ((= selector "class") (st-class-ref (st-class-of s)))
       ((= selector "isNil") false)
       ((= selector "notNil") true)

lib/smalltalk/runtime.sx

@@ -479,8 +479,9 @@
         (st-parse-method "isEmpty ^ self size = 0"))
       (st-class-add-method! "SequenceableCollection" "notEmpty"
         (st-parse-method "notEmpty ^ self size > 0"))
-      (st-class-add-method! "SequenceableCollection" "asString"
-        (st-parse-method "asString ^ self printString"))
+      ;; (no asString here — Symbol/String have their own primitive
+      ;; impls; SequenceableCollection-level fallback would overwrite
+      ;; the bare-name-for-Symbol behaviour.)
       ;; ── HashedCollection / Set / Dictionary ──
       ;; Implemented as user instances with array-backed storage. Sets
       ;; use a single `array` ivar; Dictionaries use parallel `keys`/

lib/smalltalk/tests/printing.sx

@@ -0,0 +1,122 @@
+;; String>>format: and printOn: tests.
+
+(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. String>>format: ──
+(st-test "format: single placeholder"
+  (ev "'Hello, {1}!' format: #('World')")
+  "Hello, World!")
+
+(st-test "format: multiple placeholders"
+  (ev "'{1} + {2} = {3}' format: #(1 2 3)")
+  "1 + 2 = 3")
+
+(st-test "format: out-of-order"
+  (ev "'{2} {1}' format: #('first' 'second')")
+  "second first")
+
+(st-test "format: repeated index"
+  (ev "'{1}-{1}-{1}' format: #(#a)")
+  "a-a-a")
+
+(st-test "format: empty source"
+  (ev "'' format: #()") "")
+
+(st-test "format: no placeholders"
+  (ev "'plain text' format: #()") "plain text")
+
+(st-test "format: unmatched {"
+  (ev "'open { brace' format: #('x')")
+  "open { brace")
+
+(st-test "format: out-of-range index keeps literal"
+  (ev "'{99}' format: #('hi')")
+  "{99}")
+
+(st-test "format: numeric arg"
+  (ev "'value: {1}' format: #(42)")
+  "value: 42")
+
+(st-test "format: float arg"
+  (ev "'pi ~ {1}' format: #(3.14)")
+  "pi ~ 3.14")
+
+;; ── 2. printOn: writes printString to stream ──
+(st-test "printOn: writes int via stream"
+  (evp
+    "| s |
+     s := WriteStream on: (Array new: 0).
+     42 printOn: s.
+     ^ s contents")
+  (list "4" "2"))
+
+(st-test "printOn: writes string"
+  (evp
+    "| s |
+     s := WriteStream on: (Array new: 0).
+     'hi' printOn: s.
+     ^ s contents")
+  (list "'" "h" "i" "'"))
+
+(st-test "printOn: returns receiver"
+  (evp
+    "| s |
+     s := WriteStream on: (Array new: 0).
+     ^ 99 printOn: s")
+  99)
+
+;; ── 3. Universal printString fallback for user instances ──
+(st-class-define! "Cat" "Object" (list))
+(st-class-define! "Animal" "Object" (list))
+
+(st-test "printString of vowel-initial class"
+  (evp "^ Animal new printString")
+  "an Animal")
+
+(st-test "printString of consonant-initial class"
+  (evp "^ Cat new printString")
+  "a Cat")
+
+(st-test "user override of printString wins"
+  (begin
+    (st-class-add-method! "Cat" "printString"
+      (st-parse-method "printString ^ #miaow asString"))
+    (str (evp "^ Cat new printString")))
+  "miaow")
+
+;; ── 4. printOn: on user instance with overridden printString ──
+(st-test "printOn: respects user-overridden printString"
+  (evp
+    "| s |
+     s := WriteStream on: (Array new: 0).
+     Cat new printOn: s.
+     ^ s contents")
+  (list "m" "i" "a" "o" "w"))
+
+;; ── 5. printString for class-refs ──
+(st-test "Class printString is its name"
+  (ev "Animal printString") "Animal")
+
+;; ── 6. format: combined with printString ──
+(st-class-define! "Box" "Object" (list "n"))
+(st-class-add-method! "Box" "n:"
+  (st-parse-method "n: v n := v. ^ self"))
+(st-class-add-method! "Box" "printString"
+  (st-parse-method "printString ^ '<' , n printString , '>'"))
+
+(st-test "format: with custom printString in arg"
+  (str (evp
+    "| b | b := Box new n: 7.
+     ^ '({1})' format: (Array with: b printString)"))
+  "(<7>)")
+
+(st-class-add-class-method! "Array" "with:"
+  (st-parse-method "with: x | a | a := Array new: 1. a at: 1 put: x. ^ a"))
+
+(list st-test-pass st-test-fail)

plans/smalltalk-on-sx.md

@@ -91,7 +91,7 @@ Core mapping:
 - [x] `HashedCollection`/`Set`/`Dictionary`/`IdentityDictionary`. Implemented as user classes in `runtime.sx`. `HashedCollection` carries a single `array` ivar; `Dictionary` overrides with parallel `keys`/`values`. Set: `add:` (dedup), `addAll:`, `remove:`, `includes:`, `do:`, `size`, `asArray`. Dictionary: `at:`, `at:ifAbsent:`, `at:put:`, `includesKey:`, `removeKey:`, `keys`, `values`, `do:`, `keysDo:`, `valuesDo:`, `keysAndValuesDo:`, `size`, `isEmpty`. `IdentityDictionary` defined as a Dictionary subclass (no methods of its own yet — equality and identity diverge in a follow-up). Class-side `new` calls `super new init`. Added Array primitive `add:` (append). 29 tests in `lib/smalltalk/tests/hashed.sx`.
 - [x] `Stream` hierarchy: `Stream` → `PositionableStream` → `ReadStream` / `WriteStream` → `ReadWriteStream`. User classes with `collection` + 0-based `position` ivars. ReadStream: `next`, `peek`, `atEnd`, `upToEnd`, `next:`, `skip:`, `reset`, `position`/`position:`. WriteStream: `nextPut:`, `nextPutAll:`, `contents`. Class-side `on:` constructor; `WriteStream class>>with:` pre-fills + `setToEnd`. Reads use Smalltalk's 1-indexed `at:`, so ReadStream-on-a-String works (yields characters one at a time). 21 tests in `lib/smalltalk/tests/streams.sx`. Bumped `test.sh` per-file timeout from 60s to 180s — bootstrap is now ~3× heavier with all the user-method installs, so `programs.sx` runs in ~64s.
 - [x] `Number` tower: `SmallInteger`/`LargePositiveInteger`/`Float`/`Fraction`. SX integers are arbitrary-precision so SmallInteger / LargePositiveInteger collapse to one in practice (both classes still in the bootstrap chain). Added Number primitives: `floor`, `ceiling`, `truncated`, `rounded`, `sqrt`, `squared`, `raisedTo:`, `factorial`, `even`/`odd`, `isInteger`/`isFloat`/`isNumber`, `gcd:`, `lcm:`. **Fraction** now a real user class (numerator/denominator + sign-normalised, gcd-reduced at construction): `numerator:denominator:`, accessors, `+`/`-`/`*`/`/`, `negated`, `reciprocal`, `=`, `<`, `asFloat`, `printString`, `isFraction`. 47 tests in `lib/smalltalk/tests/numbers.sx`.
-- [ ] `String>>format:`, `printOn:` for everything
+- [x] `String>>format:`, `printOn:` for everything. `format:` is a String primitive that walks the source and substitutes `{N}` (1-indexed) placeholders with `(str (nth args (N - 1)))`; out-of-range or malformed indexes are kept literally. `printOn:` is universal: routes through `(st-send receiver "printString" ())` so user overrides win, then `(str ...)` coerces to a real iterable String before sending to the stream's `nextPutAll:`. `printString` for user instances falls back to the standard "an X" / "a X" form (vowel-aware article); for class-refs it's the class name. 18 tests in `lib/smalltalk/tests/printing.sx`. Phase 5 complete.
 
 ### Phase 6 — SUnit + corpus to 200+
 - [ ] Port SUnit (TestCase, TestSuite, TestResult) — written in SX-Smalltalk, runs in itself
@@ -108,6 +108,7 @@ Core mapping:
 
 _Newest first. Agent appends on every commit._
 
+- 2026-04-25: String>>format: + universal printOn: + 18 tests (`lib/smalltalk/tests/printing.sx`). `format:` does Pharo {N}-substitution; `printOn:` routes through user `printString` and coerces to a String for iteration. Phase 5 complete. 638/638 total.
 - 2026-04-25: Number tower + Fraction class + 47 tests (`lib/smalltalk/tests/numbers.sx`). 14 new Number primitives (floor/ceiling/truncated/rounded/sqrt/squared/raisedTo:/factorial/even/odd/gcd:/lcm:/isInteger/isFloat). Fraction with normalisation + arithmetic + comparisons + asFloat. 620/620 total.
 - 2026-04-25: Stream hierarchy + 21 tests (`lib/smalltalk/tests/streams.sx`). ReadStream / WriteStream / ReadWriteStream as user classes; class-side `on:`; ReadStream-on-String yields characters. Bumped `test.sh` per-file timeout 60s → 180s — heavier bootstrap pushed `programs.sx` past 60s. 573/573 total.
 - 2026-04-25: HashedCollection / Set / Dictionary / IdentityDictionary + 29 tests (`lib/smalltalk/tests/hashed.sx`). Set: dedup add:, remove:, includes:, do:, addAll:. Dictionary: parallel keys/values backing; at:put:, at:ifAbsent:, includesKey:, removeKey:, keysDo:, keysAndValuesDo:. Class-side `new` chains `super new init`. Array primitive `add:` added. 552/552 total.