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

phase 22 Haskell: runtime.sx + 143 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source 
lib/haskell/runtime.sx (113 forms): numeric type class helpers
(hk-div/mod/rem/quot floor semantics), rational numbers (dict-based,
GCD-normalised), hk-force for lazy promises, Data.Char (hk-ord/chr,
inline ASCII predicates, digit-to-int), Data.Set wrappers, Data.List
(take/drop/zip/nub/foldl/foldr/scanl/etc), Maybe/Either ADTs, tuple
helpers (hk-pair/fst/snd/curry/uncurry), string helpers (words/lines/
is-prefix-of/is-infix-of/etc), hk-show.

test.sh updated to pre-load runtime.sx alongside tokenizer.sx.
143/143 runtime tests + 5/5 parse tests = 148/148 total.
This commit is contained in:
giles
2026-05-01 21:41:11 +00:00
parent a7790418f8
commit c02ffcf316
3 changed files with 960 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

451
lib/haskell/tests/runtime.sx Normal file
View File

@@ -0,0 +1,451 @@
;; lib/haskell/tests/runtime.sx — smoke-tests for lib/haskell/runtime.sx
;;
;; Uses the same hk-test framework as tests/parse.sx.
;; Loaded by test.sh after: tokenizer.sx + runtime.sx are pre-loaded.
;; ---------------------------------------------------------------------------
;; Test framework boilerplate (mirrors parse.sx)
;; ---------------------------------------------------------------------------
(define hk-test-pass 0)
(define hk-test-fail 0)
(define hk-test-fails (list))
(define
(hk-test name actual expected)
(if
(= actual expected)
(set! hk-test-pass (+ hk-test-pass 1))
(do
(set! hk-test-fail (+ hk-test-fail 1))
(append! hk-test-fails {:actual actual :expected expected :name name}))))
;; ---------------------------------------------------------------------------
;; 1. Numeric type class helpers
;; ---------------------------------------------------------------------------
(hk-test "is-integer? int" (hk-is-integer? 42) true)
(hk-test "is-integer? float" (hk-is-integer? 1.5) false)
(hk-test "is-float? float" (hk-is-float? 3.14) true)
(hk-test "is-float? int" (hk-is-float? 3) false)
(hk-test "is-num? int" (hk-is-num? 10) true)
(hk-test "is-num? float" (hk-is-num? 1) true)
(hk-test "to-float" (hk-to-float 5) 5)
(hk-test "to-integer trunc" (hk-to-integer 3.7) 3)
(hk-test "div pos pos" (hk-div 7 2) 3)
(hk-test "div neg pos" (hk-div -7 2) -4)
(hk-test "div pos neg" (hk-div 7 -2) -4)
(hk-test "div neg neg" (hk-div -7 -2) 3)
(hk-test "div exact" (hk-div 6 2) 3)
(hk-test "mod pos pos" (hk-mod 10 3) 1)
(hk-test "mod neg pos" (hk-mod -7 3) 2)
(hk-test "rem pos pos" (hk-rem 10 3) 1)
(hk-test "rem neg pos" (hk-rem -7 3) -1)
(hk-test "abs pos" (hk-abs 5) 5)
(hk-test "abs neg" (hk-abs -5) 5)
(hk-test "signum pos" (hk-signum 42) 1)
(hk-test "signum neg" (hk-signum -7) -1)
(hk-test "signum zero" (hk-signum 0) 0)
(hk-test "gcd" (hk-gcd 12 8) 4)
(hk-test "lcm" (hk-lcm 4 6) 12)
(hk-test "even?" (hk-even? 4) true)
(hk-test "even? odd" (hk-even? 3) false)
(hk-test "odd?" (hk-odd? 7) true)
;; ---------------------------------------------------------------------------
;; 2. Rational numbers
;; ---------------------------------------------------------------------------
(let
((r (hk-make-rational 1 2)))
(do
(hk-test "rational?" (hk-rational? r) true)
(hk-test "numerator" (hk-numerator r) 1)
(hk-test "denominator" (hk-denominator r) 2)))
(let
((r (hk-make-rational 2 4)))
(do
(hk-test "rat normalise num" (hk-numerator r) 1)
(hk-test "rat normalise den" (hk-denominator r) 2)))
(let
((sum (hk-rational-add (hk-make-rational 1 2) (hk-make-rational 1 3))))
(do
(hk-test "rat-add num" (hk-numerator sum) 5)
(hk-test "rat-add den" (hk-denominator sum) 6)))
(hk-test
"rat-to-float"
(hk-rational-to-float (hk-make-rational 1 2))
0.5)
(hk-test "rational? int" (hk-rational? 42) false)
;; ---------------------------------------------------------------------------
;; 3. Lazy evaluation (promises via SX delay)
;; ---------------------------------------------------------------------------
(let
((p (delay 42)))
(hk-test "force promise" (hk-force p) 42))
(hk-test "force non-promise" (hk-force 99) 99)
;; ---------------------------------------------------------------------------
;; 4. Char utilities — compare via hk-ord to avoid = on char type
;; ---------------------------------------------------------------------------
(hk-test "ord A" (hk-ord (integer->char 65)) 65)
(hk-test "chr 65" (hk-ord (hk-chr 65)) 65)
(hk-test "is-alpha? A" (hk-is-alpha? (integer->char 65)) true)
(hk-test "is-alpha? 0" (hk-is-alpha? (integer->char 48)) false)
(hk-test "is-digit? 5" (hk-is-digit? (integer->char 53)) true)
(hk-test "is-digit? A" (hk-is-digit? (integer->char 65)) false)
(hk-test "is-upper? A" (hk-is-upper? (integer->char 65)) true)
(hk-test "is-upper? a" (hk-is-upper? (integer->char 97)) false)
(hk-test "is-lower? a" (hk-is-lower? (integer->char 97)) true)
(hk-test "is-space? spc" (hk-is-space? (integer->char 32)) true)
(hk-test "is-space? A" (hk-is-space? (integer->char 65)) false)
(hk-test
"to-upper a"
(hk-ord (hk-to-upper (integer->char 97)))
65)
(hk-test
"to-lower A"
(hk-ord (hk-to-lower (integer->char 65)))
97)
(hk-test
"digit-to-int 0"
(hk-digit-to-int (integer->char 48))
0)
(hk-test
"digit-to-int 9"
(hk-digit-to-int (integer->char 57))
9)
(hk-test
"digit-to-int a"
(hk-digit-to-int (integer->char 97))
10)
(hk-test
"digit-to-int F"
(hk-digit-to-int (integer->char 70))
15)
(hk-test "int-to-digit 0" (hk-ord (hk-int-to-digit 0)) 48)
(hk-test "int-to-digit 10" (hk-ord (hk-int-to-digit 10)) 97)
;; ---------------------------------------------------------------------------
;; 5. Data.Set
;; ---------------------------------------------------------------------------
(hk-test "set-empty is set?" (hk-set? (hk-set-empty)) true)
(hk-test "set-null? empty" (hk-set-null? (hk-set-empty)) true)
(let
((s (hk-set-singleton 42)))
(do
(hk-test "singleton member" (hk-set-member? 42 s) true)
(hk-test "singleton size" (hk-set-size s) 1)))
(let
((s (hk-set-from-list (list 1 2 3))))
(do
(hk-test "from-list member" (hk-set-member? 2 s) true)
(hk-test "from-list absent" (hk-set-member? 9 s) false)
(hk-test "from-list size" (hk-set-size s) 3)))
;; ---------------------------------------------------------------------------
;; 6. Data.List
;; ---------------------------------------------------------------------------
(hk-test "head" (hk-head (list 1 2 3)) 1)
(hk-test
"tail length"
(len (hk-tail (list 1 2 3)))
2)
(hk-test "null? empty" (hk-null? (list)) true)
(hk-test "null? non-empty" (hk-null? (list 1)) false)
(hk-test
"length"
(hk-length (list 1 2 3))
3)
(hk-test
"take 2"
(hk-take 2 (list 1 2 3))
(list 1 2))
(hk-test "take 0" (hk-take 0 (list 1 2)) (list))
(hk-test
"take overflow"
(hk-take 5 (list 1 2))
(list 1 2))
(hk-test
"drop 1"
(hk-drop 1 (list 1 2 3))
(list 2 3))
(hk-test
"drop 0"
(hk-drop 0 (list 1 2))
(list 1 2))
(hk-test
"take-while"
(hk-take-while
(fn (x) (< x 3))
(list 1 2 3 4))
(list 1 2))
(hk-test
"drop-while"
(hk-drop-while
(fn (x) (< x 3))
(list 1 2 3 4))
(list 3 4))
(hk-test
"zip"
(hk-zip (list 1 2) (list 3 4))
(list (list 1 3) (list 2 4)))
(hk-test
"zip uneven"
(hk-zip
(list 1 2 3)
(list 4 5))
(list (list 1 4) (list 2 5)))
(hk-test
"zip-with +"
(hk-zip-with
+
(list 1 2 3)
(list 10 20 30))
(list 11 22 33))
(hk-test
"unzip fst"
(first
(hk-unzip
(list (list 1 3) (list 2 4))))
(list 1 2))
(hk-test
"unzip snd"
(nth
(hk-unzip
(list (list 1 3) (list 2 4)))
1)
(list 3 4))
(hk-test
"elem hit"
(hk-elem 2 (list 1 2 3))
true)
(hk-test
"elem miss"
(hk-elem 9 (list 1 2 3))
false)
(hk-test
"not-elem"
(hk-not-elem 9 (list 1 2 3))
true)
(hk-test
"nub"
(hk-nub (list 1 2 1 3 2))
(list 1 2 3))
(hk-test
"sum"
(hk-sum (list 1 2 3 4))
10)
(hk-test
"product"
(hk-product (list 1 2 3 4))
24)
(hk-test
"maximum"
(hk-maximum (list 3 1 4 1 5))
5)
(hk-test
"minimum"
(hk-minimum (list 3 1 4 1 5))
1)
(hk-test
"concat"
(hk-concat
(list (list 1 2) (list 3 4)))
(list 1 2 3 4))
(hk-test
"concat-map"
(hk-concat-map
(fn (x) (list x (* x x)))
(list 1 2 3))
(list 1 1 2 4 3 9))
(hk-test
"sort"
(hk-sort (list 3 1 4 1 5))
(list 1 1 3 4 5))
(hk-test
"replicate"
(hk-replicate 3 0)
(list 0 0 0))
(hk-test "replicate 0" (hk-replicate 0 99) (list))
(hk-test
"intersperse"
(hk-intersperse 0 (list 1 2 3))
(list 1 0 2 0 3))
(hk-test
"intersperse 1"
(hk-intersperse 0 (list 1))
(list 1))
(hk-test "intersperse empty" (hk-intersperse 0 (list)) (list))
(hk-test
"span"
(hk-span
(fn (x) (< x 3))
(list 1 2 3 4))
(list (list 1 2) (list 3 4)))
(hk-test
"break"
(hk-break
(fn (x) (>= x 3))
(list 1 2 3 4))
(list (list 1 2) (list 3 4)))
(hk-test
"foldl"
(hk-foldl
(fn (a b) (- a b))
10
(list 1 2 3))
4)
(hk-test
"foldr"
(hk-foldr cons (list) (list 1 2 3))
(list 1 2 3))
(hk-test
"scanl"
(hk-scanl + 0 (list 1 2 3))
(list 0 1 3 6))
;; ---------------------------------------------------------------------------
;; 7. Maybe / Either
;; ---------------------------------------------------------------------------
(hk-test "nothing is-nothing?" (hk-is-nothing? hk-nothing) true)
(hk-test "nothing is-just?" (hk-is-just? hk-nothing) false)
(hk-test "just is-just?" (hk-is-just? (hk-just 42)) true)
(hk-test "just is-nothing?" (hk-is-nothing? (hk-just 42)) false)
(hk-test "from-just" (hk-from-just (hk-just 99)) 99)
(hk-test
"from-maybe nothing"
(hk-from-maybe 0 hk-nothing)
0)
(hk-test
"from-maybe just"
(hk-from-maybe 0 (hk-just 42))
42)
(hk-test
"maybe nothing"
(hk-maybe 0 (fn (x) (* x 2)) hk-nothing)
0)
(hk-test
"maybe just"
(hk-maybe 0 (fn (x) (* x 2)) (hk-just 5))
10)
(hk-test "left is-left?" (hk-is-left? (hk-left "e")) true)
(hk-test "right is-right?" (hk-is-right? (hk-right 42)) true)
(hk-test "from-right" (hk-from-right (hk-right 7)) 7)
(hk-test
"either left"
(hk-either (fn (x) (str "L" x)) (fn (x) (str "R" x)) (hk-left "err"))
"Lerr")
(hk-test
"either right"
(hk-either
(fn (x) (str "L" x))
(fn (x) (str "R" x))
(hk-right 42))
"R42")
;; ---------------------------------------------------------------------------
;; 8. Tuples
;; ---------------------------------------------------------------------------
(hk-test "pair" (hk-pair 1 2) (list 1 2))
(hk-test "fst" (hk-fst (hk-pair 3 4)) 3)
(hk-test "snd" (hk-snd (hk-pair 3 4)) 4)
(hk-test
"triple"
(hk-triple 1 2 3)
(list 1 2 3))
(hk-test
"fst3"
(hk-fst3 (hk-triple 7 8 9))
7)
(hk-test
"thd3"
(hk-thd3 (hk-triple 7 8 9))
9)
(hk-test "curry" ((hk-curry +) 3 4) 7)
(hk-test
"uncurry"
((hk-uncurry (fn (a b) (* a b))) (list 3 4))
12)
;; ---------------------------------------------------------------------------
;; 9. String helpers
;; ---------------------------------------------------------------------------
(hk-test "words" (hk-words "hello world") (list "hello" "world"))
(hk-test "words leading ws" (hk-words " foo bar") (list "foo" "bar"))
(hk-test "words empty" (hk-words "") (list))
(hk-test "unwords" (hk-unwords (list "a" "b" "c")) "a b c")
(hk-test "unwords single" (hk-unwords (list "x")) "x")
(hk-test "lines" (hk-lines "a\nb\nc") (list "a" "b" "c"))
(hk-test "lines single" (hk-lines "hello") (list "hello"))
(hk-test "unlines" (hk-unlines (list "a" "b")) "a\nb\n")
(hk-test "is-prefix-of yes" (hk-is-prefix-of "he" "hello") true)
(hk-test "is-prefix-of no" (hk-is-prefix-of "wo" "hello") false)
(hk-test "is-prefix-of eq" (hk-is-prefix-of "hi" "hi") true)
(hk-test "is-prefix-of empty" (hk-is-prefix-of "" "hi") true)
(hk-test "is-suffix-of yes" (hk-is-suffix-of "lo" "hello") true)
(hk-test "is-suffix-of no" (hk-is-suffix-of "he" "hello") false)
(hk-test "is-suffix-of empty" (hk-is-suffix-of "" "hi") true)
(hk-test "is-infix-of yes" (hk-is-infix-of "ell" "hello") true)
(hk-test "is-infix-of no" (hk-is-infix-of "xyz" "hello") false)
(hk-test "is-infix-of empty" (hk-is-infix-of "" "hello") true)
;; ---------------------------------------------------------------------------
;; 10. Show
;; ---------------------------------------------------------------------------
(hk-test "show nil" (hk-show nil) "Nothing")
(hk-test "show true" (hk-show true) "True")
(hk-test "show false" (hk-show false) "False")
(hk-test "show int" (hk-show 42) "42")
(hk-test "show string" (hk-show "hi") "\"hi\"")
(hk-test
"show list"
(hk-show (list 1 2 3))
"[1,2,3]")
(hk-test "show empty list" (hk-show (list)) "[]")
;; ---------------------------------------------------------------------------
;; Summary (required by test.sh — last expression is the return value)
;; ---------------------------------------------------------------------------
(list hk-test-pass hk-test-fail)