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