smalltalk: Number tower (Fraction, factorial, gcd:/lcm:, etc.) + 47 tests

lib/smalltalk/eval.sx

@@ -698,6 +698,56 @@
       ((= selector "~~") (not (= n (nth args 0))))
       ((= selector "negated") (- 0 n))
       ((= selector "abs") (if (< n 0) (- 0 n) n))
+      ((= selector "floor") (floor n))
+      ((= selector "ceiling")
+        ;; ceiling(x) = -floor(-x); fast for both signs.
+        (- 0 (floor (- 0 n))))
+      ((= selector "truncated") (truncate n))
+      ((= selector "rounded") (round n))
+      ((= selector "sqrt") (sqrt n))
+      ((= selector "squared") (* n n))
+      ((= selector "raisedTo:")
+        (let ((p (nth args 0)) (acc 1) (i 0))
+          (begin
+            (define
+              rt-loop
+              (fn ()
+                (when (< i p)
+                  (begin (set! acc (* acc n)) (set! i (+ i 1)) (rt-loop)))))
+            (rt-loop)
+            acc)))
+      ((= selector "factorial")
+        (let ((acc 1) (i 2))
+          (begin
+            (define
+              ft-loop
+              (fn ()
+                (when (<= i n)
+                  (begin (set! acc (* acc i)) (set! i (+ i 1)) (ft-loop)))))
+            (ft-loop)
+            acc)))
+      ((= selector "even") (= (mod n 2) 0))
+      ((= selector "odd") (= (mod n 2) 1))
+      ((= selector "isInteger") (integer? n))
+      ((= selector "isFloat") (and (number? n) (not (integer? n))))
+      ((= selector "isNumber") true)
+      ((= selector "gcd:")
+        (let ((a (if (< n 0) (- 0 n) n))
+              (b (if (< (nth args 0) 0) (- 0 (nth args 0)) (nth args 0))))
+          (begin
+            (define
+              gcd-loop
+              (fn ()
+                (cond
+                  ((= b 0) a)
+                  (else
+                    (let ((t (mod a b)))
+                      (begin (set! a b) (set! b t) (gcd-loop)))))))
+            (gcd-loop))))
+      ((= selector "lcm:")
+        (let ((g (st-num-send n "gcd:" args)))
+          (cond ((= g 0) 0)
+                (else (* (/ n g) (nth args 0))))))
       ((= selector "max:") (if (> n (nth args 0)) n (nth args 0)))
       ((= selector "min:") (if (< n (nth args 0)) n (nth args 0)))
       ((= selector "printString") (str n))

lib/smalltalk/runtime.sx

@@ -369,6 +369,7 @@
       (st-class-define! "SmallInteger" "Integer" (list))
       (st-class-define! "LargePositiveInteger" "Integer" (list))
       (st-class-define! "Float" "Number" (list))
+      (st-class-define! "Fraction" "Number" (list "numerator" "denominator"))
       (st-class-define! "Character" "Magnitude" (list "value"))
       ;; Collections
       (st-class-define! "Collection" "Object" (list))
@@ -679,6 +680,76 @@
           "peek
              self atEnd ifTrue: [^ nil].
              ^ collection at: position + 1"))
+      ;; ── Fraction ──
+      ;; Rational numbers stored as numerator/denominator, normalized
+      ;; (sign on numerator, denominator > 0, reduced via gcd).
+      (st-class-add-class-method! "Fraction" "numerator:denominator:"
+        (st-parse-method
+          "numerator: n denominator: d
+             | f |
+             f := super new.
+             ^ f setNumerator: n denominator: d"))
+      (st-class-add-method! "Fraction" "setNumerator:denominator:"
+        (st-parse-method
+          "setNumerator: n denominator: d
+             | g s nn dd |
+             d = 0 ifTrue: [Error signal: 'Fraction denominator cannot be zero'].
+             s := (d < 0) ifTrue: [-1] ifFalse: [1].
+             nn := n * s. dd := d * s.
+             g := nn abs gcd: dd.
+             g = 0 ifTrue: [g := 1].
+             numerator := nn / g.
+             denominator := dd / g.
+             ^ self"))
+      (st-class-add-method! "Fraction" "numerator"
+        (st-parse-method "numerator ^ numerator"))
+      (st-class-add-method! "Fraction" "denominator"
+        (st-parse-method "denominator ^ denominator"))
+      (st-class-add-method! "Fraction" "+"
+        (st-parse-method
+          "+ other
+             ^ Fraction
+                 numerator: numerator * other denominator + (other numerator * denominator)
+                 denominator: denominator * other denominator"))
+      (st-class-add-method! "Fraction" "-"
+        (st-parse-method
+          "- other
+             ^ Fraction
+                 numerator: numerator * other denominator - (other numerator * denominator)
+                 denominator: denominator * other denominator"))
+      (st-class-add-method! "Fraction" "*"
+        (st-parse-method
+          "* other
+             ^ Fraction
+                 numerator: numerator * other numerator
+                 denominator: denominator * other denominator"))
+      (st-class-add-method! "Fraction" "/"
+        (st-parse-method
+          "/ other
+             ^ Fraction
+                 numerator: numerator * other denominator
+                 denominator: denominator * other numerator"))
+      (st-class-add-method! "Fraction" "negated"
+        (st-parse-method
+          "negated ^ Fraction numerator: numerator negated denominator: denominator"))
+      (st-class-add-method! "Fraction" "reciprocal"
+        (st-parse-method
+          "reciprocal ^ Fraction numerator: denominator denominator: numerator"))
+      (st-class-add-method! "Fraction" "="
+        (st-parse-method
+          "= other
+             ^ numerator = other numerator and: [denominator = other denominator]"))
+      (st-class-add-method! "Fraction" "<"
+        (st-parse-method
+          "< other
+             ^ numerator * other denominator < (other numerator * denominator)"))
+      (st-class-add-method! "Fraction" "asFloat"
+        (st-parse-method "asFloat ^ numerator / denominator"))
+      (st-class-add-method! "Fraction" "printString"
+        (st-parse-method
+          "printString ^ numerator printString , '/' , denominator printString"))
+      (st-class-add-method! "Fraction" "isFraction"
+        (st-parse-method "isFraction ^ true"))
       "ok")))
 
 ;; Initialise on load. Tests can re-bootstrap to reset state.

lib/smalltalk/tests/numbers.sx

@@ -0,0 +1,131 @@
+;; Number-tower tests: SmallInteger / Float / Fraction. New numeric methods
+;; (floor/ceiling/sqrt/factorial/gcd:/lcm:/raisedTo:/even/odd) and Fraction
+;; arithmetic with normalization.
+
+(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. New SmallInteger / Float methods ──
+(st-test "floor of 3.7"      (ev "3.7 floor")       3)
+(st-test "floor of -3.2"     (ev "-3.2 floor")      -4)
+(st-test "ceiling of 3.2"    (ev "3.2 ceiling")     4)
+(st-test "ceiling of -3.7"   (ev "-3.7 ceiling")    -3)
+(st-test "truncated of 3.7"  (ev "3.7 truncated")   3)
+(st-test "truncated of -3.7" (ev "-3.7 truncated")  -3)
+(st-test "rounded of 3.4"    (ev "3.4 rounded")     3)
+(st-test "rounded of 3.5"    (ev "3.5 rounded")     4)
+(st-test "sqrt of 16"        (ev "16 sqrt")         4)
+(st-test "squared"           (ev "7 squared")       49)
+(st-test "raisedTo:"         (ev "2 raisedTo: 10")  1024)
+(st-test "factorial 0"       (ev "0 factorial")     1)
+(st-test "factorial 1"       (ev "1 factorial")     1)
+(st-test "factorial 5"       (ev "5 factorial")     120)
+(st-test "factorial 10"      (ev "10 factorial")    3628800)
+
+(st-test "even/odd 4"  (ev "4 even") true)
+(st-test "even/odd 5"  (ev "5 even") false)
+(st-test "odd 3"       (ev "3 odd")  true)
+(st-test "odd 4"       (ev "4 odd")  false)
+
+(st-test "gcd of 24 18"      (ev "24 gcd: 18")      6)
+(st-test "gcd 0 7"            (ev "0 gcd: 7")        7)
+(st-test "gcd negative"       (ev "-12 gcd: 8")     4)
+(st-test "lcm of 4 6"         (ev "4 lcm: 6")        12)
+
+(st-test "isInteger on int"   (ev "42 isInteger")   true)
+(st-test "isInteger on float" (ev "3.14 isInteger") false)
+(st-test "isFloat on float"   (ev "3.14 isFloat")   true)
+(st-test "isNumber"           (ev "42 isNumber")    true)
+
+;; ── 2. Fraction class ──
+(st-test "Fraction class exists" (st-class-exists? "Fraction") true)
+(st-test "Fraction < Number"
+  (st-class-inherits-from? "Fraction" "Number") true)
+
+(st-test "Fraction creation"
+  (str (evp "^ (Fraction numerator: 1 denominator: 2) printString"))
+  "1/2")
+
+(st-test "Fraction reduction at construction"
+  (str (evp "^ (Fraction numerator: 6 denominator: 8) printString"))
+  "3/4")
+
+(st-test "Fraction sign normalization (denom positive)"
+  (str (evp "^ (Fraction numerator: 1 denominator: -2) printString"))
+  "-1/2")
+
+(st-test "Fraction numerator accessor"
+  (evp "^ (Fraction numerator: 6 denominator: 8) numerator") 3)
+
+(st-test "Fraction denominator accessor"
+  (evp "^ (Fraction numerator: 6 denominator: 8) denominator") 4)
+
+;; ── 3. Fraction arithmetic ──
+(st-test "Fraction addition"
+  (str
+    (evp
+      "^ ((Fraction numerator: 1 denominator: 2) + (Fraction numerator: 1 denominator: 3)) printString"))
+  "5/6")
+
+(st-test "Fraction subtraction"
+  (str
+    (evp
+      "^ ((Fraction numerator: 3 denominator: 4) - (Fraction numerator: 1 denominator: 4)) printString"))
+  "1/2")
+
+(st-test "Fraction multiplication"
+  (str
+    (evp
+      "^ ((Fraction numerator: 2 denominator: 3) * (Fraction numerator: 3 denominator: 4)) printString"))
+  "1/2")
+
+(st-test "Fraction division"
+  (str
+    (evp
+      "^ ((Fraction numerator: 1 denominator: 2) / (Fraction numerator: 1 denominator: 4)) printString"))
+  "2/1")
+
+(st-test "Fraction negated"
+  (str (evp "^ (Fraction numerator: 1 denominator: 3) negated printString"))
+  "-1/3")
+
+(st-test "Fraction reciprocal"
+  (str (evp "^ (Fraction numerator: 2 denominator: 5) reciprocal printString"))
+  "5/2")
+
+;; ── 4. Fraction equality + ordering ──
+(st-test "Fraction equality after reduce"
+  (evp
+    "^ (Fraction numerator: 4 denominator: 8) = (Fraction numerator: 1 denominator: 2)")
+  true)
+
+(st-test "Fraction inequality"
+  (evp
+    "^ (Fraction numerator: 1 denominator: 3) = (Fraction numerator: 1 denominator: 4)")
+  false)
+
+(st-test "Fraction less-than"
+  (evp
+    "^ (Fraction numerator: 1 denominator: 3) < (Fraction numerator: 1 denominator: 2)")
+  true)
+
+;; ── 5. Fraction asFloat ──
+(st-test "Fraction asFloat 1/2"
+  (evp "^ (Fraction numerator: 1 denominator: 2) asFloat") (/ 1 2))
+
+(st-test "Fraction asFloat 3/4"
+  (evp "^ (Fraction numerator: 3 denominator: 4) asFloat") (/ 3 4))
+
+;; ── 6. Fraction predicates ──
+(st-test "Fraction isFraction"
+  (evp "^ (Fraction numerator: 1 denominator: 2) isFraction") true)
+
+(st-test "Fraction class name"
+  (evp "^ (Fraction numerator: 1 denominator: 2) class name") "Fraction")
+
+(list st-test-pass st-test-fail)

plans/smalltalk-on-sx.md

@@ -90,7 +90,7 @@ Core mapping:
 - [x] `SequenceableCollection`/`OrderedCollection`/`Array`/`String`/`Symbol`. Bootstrap installs shared methods on `SequenceableCollection`: `inject:into:`, `detect:`/`detect:ifNone:`, `count:`, `allSatisfy:`/`anySatisfy:`, `includes:`, `do:separatedBy:`, `indexOf:`/`indexOf:ifAbsent:`, `reject:`, `isEmpty`/`notEmpty`, `asString`. They each call `self do:`, which dispatches to the receiver's primitive `do:` — so Array, String, and Symbol inherit them uniformly. String/Symbol primitives gained `at:` (1-indexed), `copyFrom:to:`, `first`/`last`, `do:`. OrderedCollection class is in the bootstrap hierarchy; its instance shape will fill out alongside Set/Dictionary in the next box. 28 tests in `lib/smalltalk/tests/collections.sx`.
 - [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.
-- [ ] `Number` tower: `SmallInteger`/`LargePositiveInteger`/`Float`/`Fraction`
+- [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
 
 ### Phase 6 — SUnit + corpus to 200+
@@ -108,6 +108,7 @@ Core mapping:
 
 _Newest first. Agent appends on every commit._
 
+- 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.
 - 2026-04-25: Phase 5 sequenceable-collection methods + 28 tests (`lib/smalltalk/tests/collections.sx`). 13 shared methods on `SequenceableCollection` (inject:into:, detect:, count:, …), inherited by Array/String/Symbol via `self do:`. String primitives at:/copyFrom:to:/first/last/do:. 523/523 total.