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)