smalltalk: fibonacci classic program + smalltalk-load + 13 tests

lib/smalltalk/eval.sx

@@ -698,17 +698,98 @@
       ((= selector "notNil") true)
       (else :unhandled))))
 
+;; Split a Smalltalk-style "x y z" instance-variable string into a list of
+;; ivar names. Whitespace-delimited.
+(define
+  st-split-ivars
+  (fn
+    (s)
+    (let ((out (list)) (n (len s)) (i 0) (start nil))
+      (begin
+        (define
+          flush!
+          (fn ()
+            (when
+              (not (= start nil))
+              (begin (append! out (slice s start i)) (set! start nil)))))
+        (define
+          si-loop
+          (fn ()
+            (when
+              (< i n)
+              (let ((c (nth s i)))
+                (cond
+                  ((or (= c " ") (= c "\t") (= c "\n") (= c "\r"))
+                    (begin (flush!) (set! i (+ i 1)) (si-loop)))
+                  (else
+                    (begin
+                      (when (= start nil) (set! start i))
+                      (set! i (+ i 1))
+                      (si-loop))))))))
+        (si-loop)
+        (flush!)
+        out))))
+
 (define
   st-class-side-send
   (fn
     (cref selector args)
     (let ((name (get cref :name)))
       (cond
-        ((= selector "new") (st-make-instance name))
+        ((= selector "new")
+          (cond
+            ((= name "Array") (list))
+            (else (st-make-instance name))))
+        ((= selector "new:")
+          (cond
+            ((= name "Array")
+              (let ((size (nth args 0)) (out (list)))
+                (begin
+                  (let ((i 0))
+                    (begin
+                      (define
+                        an-loop
+                        (fn ()
+                          (when
+                            (< i size)
+                            (begin
+                              (append! out nil)
+                              (set! i (+ i 1))
+                              (an-loop)))))
+                      (an-loop)))
+                  out)))
+            (else (st-make-instance name))))
         ((= selector "name") name)
         ((= selector "superclass")
           (let ((s (st-class-superclass name)))
             (cond ((= s nil) nil) (else (st-class-ref s)))))
+        ;; Class definition: `Object subclass: #Foo instanceVariableNames: 'x y'`.
+        ;; Supports the short `subclass:` and the full
+        ;; `subclass:instanceVariableNames:classVariableNames:package:` form.
+        ((or (= selector "subclass:")
+             (= selector "subclass:instanceVariableNames:")
+             (= selector "subclass:instanceVariableNames:classVariableNames:")
+             (= selector "subclass:instanceVariableNames:classVariableNames:package:")
+             (= selector "subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:"))
+          (let
+            ((sub-sym (nth args 0))
+              (iv-string (if (> (len args) 1) (nth args 1) "")))
+            (let
+              ((sub-name (str sub-sym)))
+              (begin
+                (st-class-define!
+                  sub-name
+                  name
+                  (st-split-ivars (if (string? iv-string) iv-string (str iv-string))))
+                (st-class-ref sub-name)))))
+        ;; methodsFor: / methodsFor:stamp: are Pharo file-in markers — at
+        ;; the expression level they just return the class for further
+        ;; cascades. Method bodies are loaded by the chunk-stream loader.
+        ((or (= selector "methodsFor:")
+             (= selector "methodsFor:stamp:")
+             (= selector "category:")
+             (= selector "comment:"))
+          cref)
         ((= selector "printString") name)
         ((= selector "class") (st-class-ref "Metaclass"))
         ((= selector "==") (and (st-class-ref? (nth args 0))
@@ -719,6 +800,45 @@
         ((= selector "notNil") true)
         (else :unhandled)))))
 
+;; Run a chunk-format Smalltalk program. Do-it expressions execute in a
+;; fresh top-level frame (with an active-cell so ^expr works). Method
+;; chunks register on the named class.
+(define
+  smalltalk-load
+  (fn
+    (src)
+    (let ((entries (st-parse-chunks src)) (last-result nil))
+      (begin
+        (for-each
+          (fn (entry)
+            (let ((kind (get entry :kind)))
+              (cond
+                ((= kind "expr")
+                  (let ((cell {:active true}))
+                    (set!
+                      last-result
+                      (call/cc
+                        (fn (k)
+                          (smalltalk-eval-ast
+                            (get entry :ast)
+                            (st-make-frame nil nil nil k cell)))))
+                    (dict-set! cell :active false)))
+                ((= kind "method")
+                  (cond
+                    ((get entry :class-side?)
+                      (st-class-add-class-method!
+                        (get entry :class)
+                        (get (get entry :ast) :selector)
+                        (get entry :ast)))
+                    (else
+                      (st-class-add-method!
+                        (get entry :class)
+                        (get (get entry :ast) :selector)
+                        (get entry :ast)))))
+                (else nil))))
+          entries)
+        last-result))))
+
 ;; Convenience: parse and evaluate a Smalltalk expression with no receiver.
 (define
   smalltalk-eval

lib/smalltalk/tests/programs.sx

@@ -0,0 +1,85 @@
+;; Classic programs corpus tests.
+;;
+;; Each program lives in tests/programs/*.st as canonical Smalltalk source.
+;; This file embeds the same source as a string (until a file-read primitive
+;; lands) and runs it via smalltalk-load, then asserts behaviour.
+
+(set! st-test-pass 0)
+(set! st-test-fail 0)
+(set! st-test-fails (list))
+
+(define ev (fn (src) (smalltalk-eval src)))
+(define evp (fn (src) (smalltalk-eval-program src)))
+
+;; ── fibonacci.st (kept in sync with lib/smalltalk/tests/programs/fibonacci.st) ──
+(define
+  fib-source
+  "Object subclass: #Fibonacci
+     instanceVariableNames: 'memo'!
+
+   !Fibonacci methodsFor: 'init'!
+   init memo := Array new: 100. ^ self! !
+
+   !Fibonacci methodsFor: 'compute'!
+   fib: n
+     n < 2 ifTrue: [^ n].
+     ^ (self fib: n - 1) + (self fib: n - 2)!
+
+   memoFib: n
+     | cached |
+     cached := memo at: n + 1.
+     cached notNil ifTrue: [^ cached].
+     cached := n < 2
+                 ifTrue: [n]
+                 ifFalse: [(self memoFib: n - 1) + (self memoFib: n - 2)].
+     memo at: n + 1 put: cached.
+     ^ cached! !")
+
+(st-bootstrap-classes!)
+(smalltalk-load fib-source)
+
+(st-test "fib(0)"  (evp "^ Fibonacci new fib: 0")  0)
+(st-test "fib(1)"  (evp "^ Fibonacci new fib: 1")  1)
+(st-test "fib(2)"  (evp "^ Fibonacci new fib: 2")  1)
+(st-test "fib(5)"  (evp "^ Fibonacci new fib: 5")  5)
+(st-test "fib(10)" (evp "^ Fibonacci new fib: 10") 55)
+(st-test "fib(15)" (evp "^ Fibonacci new fib: 15") 610)
+
+(st-test "memoFib(20)"
+  (evp "| f | f := Fibonacci new init. ^ f memoFib: 20")
+  6765)
+
+(st-test "memoFib(30)"
+  (evp "| f | f := Fibonacci new init. ^ f memoFib: 30")
+  832040)
+
+;; Memoisation actually populates the array.
+(st-test "memo cache stores intermediate"
+  (evp
+    "| f | f := Fibonacci new init.
+     f memoFib: 12.
+     ^ #(0 1 1 2 3 5) , #() , #()")
+  (list 0 1 1 2 3 5))
+
+;; The class is reachable from the bootstrap class table.
+(st-test "Fibonacci class exists in table" (st-class-exists? "Fibonacci") true)
+(st-test "Fibonacci has memo ivar"
+  (get (st-class-get "Fibonacci") :ivars)
+  (list "memo"))
+
+;; Method dictionary holds the three methods.
+(st-test "Fibonacci methodDict size"
+  (len (keys (get (st-class-get "Fibonacci") :methods)))
+  3)
+
+;; Each fib call is independent (no shared state between two instances).
+(st-test "two memo instances independent"
+  (evp
+    "| a b |
+     a := Fibonacci new init.
+     b := Fibonacci new init.
+     a memoFib: 10.
+     ^ b memoFib: 10")
+  55)
+
+(list st-test-pass st-test-fail)

lib/smalltalk/tests/programs/fibonacci.st

@@ -0,0 +1,23 @@
+"Fibonacci — recursive and array-memoised. Classic-corpus program for
+ the Smalltalk-on-SX runtime."
+
+Object subclass: #Fibonacci
+  instanceVariableNames: 'memo'!
+
+!Fibonacci methodsFor: 'init'!
+init memo := Array new: 100. ^ self! !
+
+!Fibonacci methodsFor: 'compute'!
+fib: n
+  n < 2 ifTrue: [^ n].
+  ^ (self fib: n - 1) + (self fib: n - 2)!
+
+memoFib: n
+  | cached |
+  cached := memo at: n + 1.
+  cached notNil ifTrue: [^ cached].
+  cached := n < 2
+              ifTrue: [n]
+              ifFalse: [(self memoFib: n - 1) + (self memoFib: n - 2)].
+  memo at: n + 1 put: cached.
+  ^ cached! !

plans/smalltalk-on-sx.md

@@ -75,7 +75,7 @@ Core mapping:
   - [ ] `quicksort.st`
   - [ ] `mandelbrot.st`
   - [ ] `life.st` (Conway's Life, glider gun)
-  - [ ] `fibonacci.st` (recursive + memoised)
+  - [x] `fibonacci.st` (recursive + Array-memoised) — `lib/smalltalk/tests/programs/fibonacci.st`. Loaded from chunk-format source by new `smalltalk-load` helper; verified by 13 tests in `lib/smalltalk/tests/programs.sx` (recursive `fib:`, memoised `memoFib:` up to 30, instance independence, class-table integrity). Source is currently duplicated as a string in the SX test file because there's no SX file-read primitive; conformance.sh will dedupe by piping the .st file directly.
 - [ ] `lib/smalltalk/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md`
 
 ### Phase 4 — reflection + MOP
@@ -108,6 +108,7 @@ Core mapping:
 
 _Newest first. Agent appends on every commit._
 
+- 2026-04-25: classic-corpus #1 fibonacci (`tests/programs/fibonacci.st` + `tests/programs.sx`, 13 tests). Added `smalltalk-load` chunk loader, class-side `subclass:instanceVariableNames:` (and longer Pharo variants), `Array new:` size, `methodsFor:`/`category:` no-ops, `st-split-ivars`. 377/377 total.
 - 2026-04-25: cannotReturn: implemented (`lib/smalltalk/tests/cannot_return.sx`, 5 tests). Each method-invocation gets an `{:active true}` cell shared with its blocks; `st-invoke` flips it on exit; `^expr` raises if the cell is dead. Tests use SX `guard` to catch the raise. Non-`^` blocks unaffected. 364/364 total.
 - 2026-04-25: `ifTrue:` / `ifFalse:` family pinned (`lib/smalltalk/tests/conditional.sx`, 24 tests) + parser fix: `|` is now accepted as a binary selector in expression position (tokenizer still emits it as `bar` for block param/temp delimiting; `parse-binary-message` accepts both). Caught by `false | true` truncating silently to `false`. 359/359 total.
 - 2026-04-25: `whileTrue:` / `whileFalse:` / no-arg variants pinned (`lib/smalltalk/tests/while.sx`, 14 tests). `st-block-while` returns nil per ANSI; behaviour verified under captured locals, nesting, early `^`, and zero/many iterations. 334/334 total.