coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

smalltalk: Number tower (Fraction, factorial, gcd:/lcm:, etc.) + 47 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-25 12:31:05 +00:00
parent 47249900f2
commit 15da694c0d
4 changed files with 254 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
lib/smalltalk/eval.sx
View File

@@ -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))