rose-ash/lib/haskell/tests/runtime.sx

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