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)