diff --git a/lib/haskell/conformance.sh b/lib/haskell/conformance.sh index 0c1bb36d..e05a3552 100755 --- a/lib/haskell/conformance.sh +++ b/lib/haskell/conformance.sh @@ -1,5 +1,5 @@ #!/usr/bin/env bash -# lib/haskell/conformance.sh — run the 5 classic-program test suites. +# lib/haskell/conformance.sh — run the classic-program test suites. # Writes lib/haskell/scoreboard.json and lib/haskell/scoreboard.md. # # Usage: @@ -20,7 +20,7 @@ if [ ! -x "$SX_SERVER" ]; then fi fi -PROGRAMS=(fib sieve quicksort nqueens calculator) +PROGRAMS=(fib sieve quicksort nqueens calculator collatz palindrome maybe fizzbuzz anagram roman binary either primes zipwith matrix wordcount powers) PASS_COUNTS=() FAIL_COUNTS=() @@ -121,7 +121,7 @@ DATE=$(date '+%Y-%m-%d') # scoreboard.md { printf '# Haskell-on-SX Scoreboard\n\n' - printf 'Updated %s · Phase 3 (laziness + classic programs)\n\n' "$DATE" + printf 'Updated %s · Phase 6 (prelude extras + 18 programs)\n\n' "$DATE" printf '| Program | Tests | Status |\n' printf '|---------|-------|--------|\n' for i in "${!PROGRAMS[@]}"; do diff --git a/lib/haskell/scoreboard.json b/lib/haskell/scoreboard.json index be956d92..6f7884c9 100644 --- a/lib/haskell/scoreboard.json +++ b/lib/haskell/scoreboard.json @@ -1,12 +1,25 @@ { - "date": "2026-04-25", - "total_pass": 16, + "date": "2026-05-06", + "total_pass": 156, "total_fail": 0, "programs": { "fib": {"pass": 2, "fail": 0}, "sieve": {"pass": 2, "fail": 0}, "quicksort": {"pass": 5, "fail": 0}, "nqueens": {"pass": 2, "fail": 0}, - "calculator": {"pass": 5, "fail": 0} + "calculator": {"pass": 5, "fail": 0}, + "collatz": {"pass": 11, "fail": 0}, + "palindrome": {"pass": 8, "fail": 0}, + "maybe": {"pass": 12, "fail": 0}, + "fizzbuzz": {"pass": 12, "fail": 0}, + "anagram": {"pass": 9, "fail": 0}, + "roman": {"pass": 14, "fail": 0}, + "binary": {"pass": 12, "fail": 0}, + "either": {"pass": 12, "fail": 0}, + "primes": {"pass": 12, "fail": 0}, + "zipwith": {"pass": 9, "fail": 0}, + "matrix": {"pass": 8, "fail": 0}, + "wordcount": {"pass": 7, "fail": 0}, + "powers": {"pass": 14, "fail": 0} } } diff --git a/lib/haskell/scoreboard.md b/lib/haskell/scoreboard.md index e514d919..500f8394 100644 --- a/lib/haskell/scoreboard.md +++ b/lib/haskell/scoreboard.md @@ -1,6 +1,6 @@ # Haskell-on-SX Scoreboard -Updated 2026-04-25 · Phase 3 (laziness + classic programs) +Updated 2026-05-06 · Phase 6 (prelude extras + 18 programs) | Program | Tests | Status | |---------|-------|--------| @@ -9,4 +9,17 @@ Updated 2026-04-25 · Phase 3 (laziness + classic programs) | quicksort.hs | 5/5 | ✓ | | nqueens.hs | 2/2 | ✓ | | calculator.hs | 5/5 | ✓ | -| **Total** | **16/16** | **5/5 programs** | +| collatz.hs | 11/11 | ✓ | +| palindrome.hs | 8/8 | ✓ | +| maybe.hs | 12/12 | ✓ | +| fizzbuzz.hs | 12/12 | ✓ | +| anagram.hs | 9/9 | ✓ | +| roman.hs | 14/14 | ✓ | +| binary.hs | 12/12 | ✓ | +| either.hs | 12/12 | ✓ | +| primes.hs | 12/12 | ✓ | +| zipwith.hs | 9/9 | ✓ | +| matrix.hs | 8/8 | ✓ | +| wordcount.hs | 7/7 | ✓ | +| powers.hs | 14/14 | ✓ | +| **Total** | **156/156** | **18/18 programs** | diff --git a/lib/haskell/tests/program-anagram.sx b/lib/haskell/tests/program-anagram.sx new file mode 100644 index 00000000..1f0eea20 --- /dev/null +++ b/lib/haskell/tests/program-anagram.sx @@ -0,0 +1,70 @@ +;; anagram.hs — anagram detection using sort. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-ana-src + "isAnagram xs ys = sort xs == sort ys\n\nhasAnagram needle haystack = any (isAnagram needle) haystack\n") + +(hk-test + "isAnagram [1,2,3] [3,2,1] True" + (hk-prog-val (str hk-ana-src "r = isAnagram [1,2,3] [3,2,1]\n") "r") + (list "True")) + +(hk-test + "isAnagram [1,2,3] [1,2,4] False" + (hk-prog-val (str hk-ana-src "r = isAnagram [1,2,3] [1,2,4]\n") "r") + (list "False")) + +(hk-test + "isAnagram [] [] True" + (hk-prog-val (str hk-ana-src "r = isAnagram [] []\n") "r") + (list "True")) + +(hk-test + "isAnagram [1] [1] True" + (hk-prog-val (str hk-ana-src "r = isAnagram [1] [1]\n") "r") + (list "True")) + +(hk-test + "isAnagram [1,2] [2,1] True" + (hk-prog-val (str hk-ana-src "r = isAnagram [1,2] [2,1]\n") "r") + (list "True")) + +(hk-test + "isAnagram [1,1,2] [2,1,1] True" + (hk-prog-val (str hk-ana-src "r = isAnagram [1,1,2] [2,1,1]\n") "r") + (list "True")) + +(hk-test + "isAnagram [1,2] [1,2,3] False" + (hk-prog-val (str hk-ana-src "r = isAnagram [1,2] [1,2,3]\n") "r") + (list "False")) + +(hk-test + "hasAnagram [1,2] [[3,4],[2,1],[5,6]] True" + (hk-prog-val + (str hk-ana-src "r = hasAnagram [1,2] [[3,4],[2,1],[5,6]]\n") + "r") + (list "True")) + +(hk-test + "hasAnagram [1,2] [[3,4],[5,6]] False" + (hk-prog-val (str hk-ana-src "r = hasAnagram [1,2] [[3,4],[5,6]]\n") "r") + (list "False")) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-binary.sx b/lib/haskell/tests/program-binary.sx new file mode 100644 index 00000000..6272c9ea --- /dev/null +++ b/lib/haskell/tests/program-binary.sx @@ -0,0 +1,83 @@ +;; binary.hs — integer binary representation using explicit recursion. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-bin-src + "toBits 0 = []\ntoBits n = (n `mod` 2) : toBits (n `div` 2)\n\ntoBin 0 = [0]\ntoBin n = reverse (toBits n)\n\naddBit acc b = acc * 2 + b\nfromBin bits = foldl addBit 0 bits\n\nnumBits 0 = 1\nnumBits n = length (toBits n)\n") + +(hk-test + "toBin 0 = [0]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 0\n") "r")) + (list 0)) + +(hk-test + "toBin 1 = [1]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 1\n") "r")) + (list 1)) + +(hk-test + "toBin 2 = [1,0]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 2\n") "r")) + (list 1 0)) + +(hk-test + "toBin 3 = [1,1]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 3\n") "r")) + (list 1 1)) + +(hk-test + "toBin 4 = [1,0,0]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 4\n") "r")) + (list 1 0 0)) + +(hk-test + "toBin 7 = [1,1,1]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 7\n") "r")) + (list 1 1 1)) + +(hk-test + "toBin 8 = [1,0,0,0]" + (hk-as-list (hk-prog-val (str hk-bin-src "r = toBin 8\n") "r")) + (list 1 0 0 0)) + +(hk-test + "fromBin [0] = 0" + (hk-prog-val (str hk-bin-src "r = fromBin [0]\n") "r") + 0) + +(hk-test + "fromBin [1] = 1" + (hk-prog-val (str hk-bin-src "r = fromBin [1]\n") "r") + 1) + +(hk-test + "fromBin [1,0,1] = 5" + (hk-prog-val (str hk-bin-src "r = fromBin [1,0,1]\n") "r") + 5) + +(hk-test + "fromBin [1,1,1] = 7" + (hk-prog-val (str hk-bin-src "r = fromBin [1,1,1]\n") "r") + 7) + +(hk-test + "roundtrip: fromBin (toBin 13) = 13" + (hk-prog-val (str hk-bin-src "r = fromBin (toBin 13)\n") "r") + 13) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-collatz.sx b/lib/haskell/tests/program-collatz.sx new file mode 100644 index 00000000..ad569a03 --- /dev/null +++ b/lib/haskell/tests/program-collatz.sx @@ -0,0 +1,83 @@ +;; collatz.hs — Collatz (3n+1) sequences. + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-col-src + "collatz 1 = [1]\ncollatz n = if n `mod` 2 == 0\n then n : collatz (n `div` 2)\n else n : collatz (3 * n + 1)\ncollatzLen n = length (collatz n)\n") + +(hk-test + "collatz 1 = [1]" + (hk-as-list (hk-prog-val (str hk-col-src "r = collatz 1\n") "r")) + (list 1)) + +(hk-test + "collatz 2 = [2,1]" + (hk-as-list (hk-prog-val (str hk-col-src "r = collatz 2\n") "r")) + (list 2 1)) + +(hk-test + "collatz 4 = [4,2,1]" + (hk-as-list (hk-prog-val (str hk-col-src "r = collatz 4\n") "r")) + (list 4 2 1)) + +(hk-test + "collatz 6 starts 6,3,10" + (hk-as-list (hk-prog-val (str hk-col-src "r = take 3 (collatz 6)\n") "r")) + (list 6 3 10)) + +(hk-test + "collatz 8 = [8,4,2,1]" + (hk-as-list (hk-prog-val (str hk-col-src "r = collatz 8\n") "r")) + (list 8 4 2 1)) + +(hk-test + "collatzLen 1 = 1" + (hk-prog-val (str hk-col-src "r = collatzLen 1\n") "r") + 1) + +(hk-test + "collatzLen 2 = 2" + (hk-prog-val (str hk-col-src "r = collatzLen 2\n") "r") + 2) + +(hk-test + "collatzLen 4 = 3" + (hk-prog-val (str hk-col-src "r = collatzLen 4\n") "r") + 3) + +(hk-test + "collatzLen 8 = 4" + (hk-prog-val (str hk-col-src "r = collatzLen 8\n") "r") + 4) + +(hk-test + "collatzLen 16 = 5" + (hk-prog-val (str hk-col-src "r = collatzLen 16\n") "r") + 5) + +(hk-test + "collatz last is always 1" + (hk-prog-val (str hk-col-src "r = last (collatz 27)\n") "r") + 1) + +(hk-test + "collatz 3 = [3,10,5,16,8,4,2,1]" + (hk-as-list (hk-prog-val (str hk-col-src "r = collatz 3\n") "r")) + (list 3 10 5 16 8 4 2 1)) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-either.sx b/lib/haskell/tests/program-either.sx new file mode 100644 index 00000000..918c1c10 --- /dev/null +++ b/lib/haskell/tests/program-either.sx @@ -0,0 +1,83 @@ +;; either.hs — Either ADT operations via pattern matching. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-either-src + "safeDiv _ 0 = Left \"divide by zero\"\nsafeDiv x y = Right (x `div` y)\n\nfromRight _ (Right x) = x\nfromRight def (Left _) = def\n\nfromLeft (Left x) _ = x\nfromLeft _ def = def\n\nisRight (Right _) = True\nisRight (Left _) = False\n\nisLeft (Left _) = True\nisLeft (Right _) = False\n\nmapRight _ (Left e) = Left e\nmapRight f (Right x) = Right (f x)\n\ndouble x = x * 2\n") + +(hk-test + "safeDiv 10 2 = Right 5" + (hk-prog-val (str hk-either-src "r = safeDiv 10 2\n") "r") + (list "Right" 5)) + +(hk-test + "safeDiv 7 0 = Left msg" + (hk-prog-val (str hk-either-src "r = safeDiv 7 0\n") "r") + (list "Left" "divide by zero")) + +(hk-test + "fromRight 0 (Right 42) = 42" + (hk-prog-val (str hk-either-src "r = fromRight 0 (Right 42)\n") "r") + 42) + +(hk-test + "fromRight 0 (Left msg) = 0" + (hk-prog-val (str hk-either-src "r = fromRight 0 (Left \"err\")\n") "r") + 0) + +(hk-test + "isRight (Right 1) = True" + (hk-prog-val (str hk-either-src "r = isRight (Right 1)\n") "r") + (list "True")) + +(hk-test + "isRight (Left x) = False" + (hk-prog-val (str hk-either-src "r = isRight (Left \"x\")\n") "r") + (list "False")) + +(hk-test + "isLeft (Left x) = True" + (hk-prog-val (str hk-either-src "r = isLeft (Left \"x\")\n") "r") + (list "True")) + +(hk-test + "isLeft (Right x) = False" + (hk-prog-val (str hk-either-src "r = isLeft (Right 1)\n") "r") + (list "False")) + +(hk-test + "mapRight double (Right 5) = Right 10" + (hk-prog-val (str hk-either-src "r = mapRight double (Right 5)\n") "r") + (list "Right" 10)) + +(hk-test + "mapRight double (Left e) = Left e" + (hk-prog-val (str hk-either-src "r = mapRight double (Left \"err\")\n") "r") + (list "Left" "err")) + +(hk-test + "chain safeDiv results" + (hk-prog-val (str hk-either-src "r = fromRight (-1) (safeDiv 20 4)\n") "r") + 5) + +(hk-test + "chain safeDiv error" + (hk-prog-val (str hk-either-src "r = fromRight (-1) (safeDiv 20 0)\n") "r") + -1) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-fizzbuzz.sx b/lib/haskell/tests/program-fizzbuzz.sx new file mode 100644 index 00000000..2fa2870c --- /dev/null +++ b/lib/haskell/tests/program-fizzbuzz.sx @@ -0,0 +1,84 @@ +;; fizzbuzz.hs — classic FizzBuzz with guards. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-fb-src + "fizzbuzz n\n | n `mod` 15 == 0 = \"FizzBuzz\"\n | n `mod` 3 == 0 = \"Fizz\"\n | n `mod` 5 == 0 = \"Buzz\"\n | otherwise = \"Other\"\n") + +(hk-test + "fizzbuzz 1 = Other" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 1\n") "r") + "Other") + +(hk-test + "fizzbuzz 3 = Fizz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 3\n") "r") + "Fizz") + +(hk-test + "fizzbuzz 5 = Buzz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 5\n") "r") + "Buzz") + +(hk-test + "fizzbuzz 15 = FizzBuzz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 15\n") "r") + "FizzBuzz") + +(hk-test + "fizzbuzz 30 = FizzBuzz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 30\n") "r") + "FizzBuzz") + +(hk-test + "fizzbuzz 6 = Fizz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 6\n") "r") + "Fizz") + +(hk-test + "fizzbuzz 10 = Buzz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 10\n") "r") + "Buzz") + +(hk-test + "fizzbuzz 7 = Other" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 7\n") "r") + "Other") + +(hk-test + "fizzbuzz 9 = Fizz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 9\n") "r") + "Fizz") + +(hk-test + "fizzbuzz 25 = Buzz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 25\n") "r") + "Buzz") + +(hk-test + "map fizzbuzz [1..5] starts Other" + (hk-as-list + (hk-prog-val (str hk-fb-src "r = map fizzbuzz [1,2,3,4,5]\n") "r")) + (list "Other" "Other" "Fizz" "Other" "Buzz")) + +(hk-test + "fizzbuzz 45 = FizzBuzz" + (hk-prog-val (str hk-fb-src "r = fizzbuzz 45\n") "r") + "FizzBuzz") + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-matrix.sx b/lib/haskell/tests/program-matrix.sx new file mode 100644 index 00000000..f44e9878 --- /dev/null +++ b/lib/haskell/tests/program-matrix.sx @@ -0,0 +1,84 @@ +;; matrix.hs — transpose and 2D list operations. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-mat-src + "transpose [] = []\ntranspose ([] : _) = []\ntranspose xss = map head xss : transpose (map tail xss)\n\nmatAdd xss yss = zipWith (zipWith (+)) xss yss\n\ndiagonal [] = []\ndiagonal xss = head (head xss) : diagonal (map tail (tail xss))\n\nrowSum = map sum\ncolSum xss = map sum (transpose xss)\n") + +(hk-test + "transpose 2x2" + (hk-deep-force + (hk-prog-val (str hk-mat-src "r = transpose [[1,2],[3,4]]\n") "r")) + (list + ":" + (list ":" 1 (list ":" 3 (list "[]"))) + (list ":" (list ":" 2 (list ":" 4 (list "[]"))) (list "[]")))) + +(hk-test + "transpose 1x3" + (hk-deep-force + (hk-prog-val (str hk-mat-src "r = transpose [[1,2,3]]\n") "r")) + (list + ":" + (list ":" 1 (list "[]")) + (list + ":" + (list ":" 2 (list "[]")) + (list ":" (list ":" 3 (list "[]")) (list "[]"))))) + +(hk-test + "transpose empty = []" + (hk-as-list (hk-prog-val (str hk-mat-src "r = transpose []\n") "r")) + (list)) + +(hk-test + "rowSum [[1,2],[3,4]] = [3,7]" + (hk-as-list (hk-prog-val (str hk-mat-src "r = rowSum [[1,2],[3,4]]\n") "r")) + (list 3 7)) + +(hk-test + "colSum [[1,2],[3,4]] = [4,6]" + (hk-as-list (hk-prog-val (str hk-mat-src "r = colSum [[1,2],[3,4]]\n") "r")) + (list 4 6)) + +(hk-test + "matAdd [[1,2],[3,4]] [[5,6],[7,8]] = [[6,8],[10,12]]" + (hk-deep-force + (hk-prog-val + (str hk-mat-src "r = matAdd [[1,2],[3,4]] [[5,6],[7,8]]\n") + "r")) + (list + ":" + (list ":" 6 (list ":" 8 (list "[]"))) + (list ":" (list ":" 10 (list ":" 12 (list "[]"))) (list "[]")))) + +(hk-test + "diagonal [[1,2],[3,4]] = [1,4]" + (hk-as-list + (hk-prog-val (str hk-mat-src "r = diagonal [[1,2],[3,4]]\n") "r")) + (list 1 4)) + +(hk-test + "diagonal 3x3" + (hk-as-list + (hk-prog-val + (str hk-mat-src "r = diagonal [[1,2,3],[4,5,6],[7,8,9]]\n") + "r")) + (list 1 5 9)) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-maybe.sx b/lib/haskell/tests/program-maybe.sx new file mode 100644 index 00000000..547706b8 --- /dev/null +++ b/lib/haskell/tests/program-maybe.sx @@ -0,0 +1,83 @@ +;; maybe.hs — safe operations returning Maybe values. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-maybe-src + "safeDiv _ 0 = Nothing\nsafeDiv x y = Just (x `div` y)\n\nsafeHead [] = Nothing\nsafeHead (x:_) = Just x\n\nfromMaybeZero Nothing = 0\nfromMaybeZero (Just x) = x\n\nmapMaybe _ Nothing = Nothing\nmapMaybe f (Just x) = Just (f x)\n\ndouble x = x * 2\n") + +(hk-test + "safeDiv 10 2 = Just 5" + (hk-prog-val (str hk-maybe-src "r = safeDiv 10 2\n") "r") + (list "Just" 5)) + +(hk-test + "safeDiv 7 0 = Nothing" + (hk-prog-val (str hk-maybe-src "r = safeDiv 7 0\n") "r") + (list "Nothing")) + +(hk-test + "safeHead [1,2,3] = Just 1" + (hk-prog-val (str hk-maybe-src "r = safeHead [1,2,3]\n") "r") + (list "Just" 1)) + +(hk-test + "safeHead [] = Nothing" + (hk-prog-val (str hk-maybe-src "r = safeHead []\n") "r") + (list "Nothing")) + +(hk-test + "fromMaybeZero Nothing = 0" + (hk-prog-val (str hk-maybe-src "r = fromMaybeZero Nothing\n") "r") + 0) + +(hk-test + "fromMaybeZero (Just 42) = 42" + (hk-prog-val (str hk-maybe-src "r = fromMaybeZero (Just 42)\n") "r") + 42) + +(hk-test + "mapMaybe double Nothing = Nothing" + (hk-prog-val (str hk-maybe-src "r = mapMaybe double Nothing\n") "r") + (list "Nothing")) + +(hk-test + "mapMaybe double (Just 5) = Just 10" + (hk-prog-val (str hk-maybe-src "r = mapMaybe double (Just 5)\n") "r") + (list "Just" 10)) + +(hk-test + "chain: fromMaybeZero (safeDiv 10 2) = 5" + (hk-prog-val (str hk-maybe-src "r = fromMaybeZero (safeDiv 10 2)\n") "r") + 5) + +(hk-test + "chain: fromMaybeZero (safeDiv 10 0) = 0" + (hk-prog-val (str hk-maybe-src "r = fromMaybeZero (safeDiv 10 0)\n") "r") + 0) + +(hk-test + "safeDiv 100 5 = Just 20" + (hk-prog-val (str hk-maybe-src "r = safeDiv 100 5\n") "r") + (list "Just" 20)) + +(hk-test + "mapMaybe double (safeDiv 6 2) = Just 6" + (hk-prog-val (str hk-maybe-src "r = mapMaybe double (safeDiv 6 2)\n") "r") + (list "Just" 6)) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-palindrome.sx b/lib/haskell/tests/program-palindrome.sx new file mode 100644 index 00000000..8fbd7b71 --- /dev/null +++ b/lib/haskell/tests/program-palindrome.sx @@ -0,0 +1,86 @@ +;; palindrome.hs — palindrome check via reverse comparison. + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define hk-pal-src "isPalindrome xs = xs == reverse xs\n") + +(hk-test + "isPalindrome empty" + (hk-prog-val (str hk-pal-src "r = isPalindrome []\n") "r") + (list "True")) + +(hk-test + "isPalindrome single" + (hk-prog-val (str hk-pal-src "r = isPalindrome [1]\n") "r") + (list "True")) + +(hk-test + "isPalindrome [1,2,1] True" + (hk-prog-val (str hk-pal-src "r = isPalindrome [1,2,1]\n") "r") + (list "True")) + +(hk-test + "isPalindrome [1,2,3] False" + (hk-prog-val (str hk-pal-src "r = isPalindrome [1,2,3]\n") "r") + (list "False")) + +(hk-test + "isPalindrome [1,2,2,1] True" + (hk-prog-val (str hk-pal-src "r = isPalindrome [1,2,2,1]\n") "r") + (list "True")) + +(hk-test + "isPalindrome [1,2,3,4] False" + (hk-prog-val (str hk-pal-src "r = isPalindrome [1,2,3,4]\n") "r") + (list "False")) + +(hk-test + "isPalindrome five odd True" + (hk-prog-val (str hk-pal-src "r = isPalindrome [1,2,3,2,1]\n") "r") + (list "True")) + +(hk-test + "isPalindrome racecar True" + (hk-prog-val (str hk-pal-src "r = isPalindrome \"racecar\"\n") "r") + (list "True")) + +(hk-test + "isPalindrome hello False" + (hk-prog-val (str hk-pal-src "r = isPalindrome \"hello\"\n") "r") + (list "False")) + +(hk-test + "isPalindrome a True" + (hk-prog-val (str hk-pal-src "r = isPalindrome \"a\"\n") "r") + (list "True")) + +(hk-test + "isPalindrome madam True" + (hk-prog-val (str hk-pal-src "r = isPalindrome \"madam\"\n") "r") + (list "True")) + +(hk-test + "not-palindrome via map" + (hk-as-list + (hk-prog-val + (str hk-pal-src "r = filter isPalindrome [[1],[1,2],[1,2,1],[2,3]]\n") + "r")) + (list + (list ":" 1 (list "[]")) + (list ":" 1 (list ":" 2 (list ":" 1 (list "[]")))))) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-powers.sx b/lib/haskell/tests/program-powers.sx new file mode 100644 index 00000000..83c16682 --- /dev/null +++ b/lib/haskell/tests/program-powers.sx @@ -0,0 +1,78 @@ +;; powers.hs — integer exponentiation and powers-of-2 checks. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-pow-src + "pow _ 0 = 1\npow base n = base * pow base (n - 1)\n\npowers base k = map (pow base) [0..k]\n\nisPowerOf2 n\n | n <= 0 = False\n | n == 1 = True\n | otherwise = n `mod` 2 == 0 && isPowerOf2 (n `div` 2)\n\nlog2 1 = 0\nlog2 n = 1 + log2 (n `div` 2)\n") + +(hk-test "pow 2 0 = 1" (hk-prog-val (str hk-pow-src "r = pow 2 0\n") "r") 1) + +(hk-test "pow 2 1 = 2" (hk-prog-val (str hk-pow-src "r = pow 2 1\n") "r") 2) + +(hk-test + "pow 2 8 = 256" + (hk-prog-val (str hk-pow-src "r = pow 2 8\n") "r") + 256) + +(hk-test "pow 3 4 = 81" (hk-prog-val (str hk-pow-src "r = pow 3 4\n") "r") 81) + +(hk-test + "pow 10 3 = 1000" + (hk-prog-val (str hk-pow-src "r = pow 10 3\n") "r") + 1000) + +(hk-test + "powers 2 4 = [1,2,4,8,16]" + (hk-as-list (hk-prog-val (str hk-pow-src "r = powers 2 4\n") "r")) + (list 1 2 4 8 16)) + +(hk-test + "powers 3 3 = [1,3,9,27]" + (hk-as-list (hk-prog-val (str hk-pow-src "r = powers 3 3\n") "r")) + (list 1 3 9 27)) + +(hk-test + "isPowerOf2 1 = True" + (hk-prog-val (str hk-pow-src "r = isPowerOf2 1\n") "r") + (list "True")) + +(hk-test + "isPowerOf2 8 = True" + (hk-prog-val (str hk-pow-src "r = isPowerOf2 8\n") "r") + (list "True")) + +(hk-test + "isPowerOf2 6 = False" + (hk-prog-val (str hk-pow-src "r = isPowerOf2 6\n") "r") + (list "False")) + +(hk-test + "isPowerOf2 0 = False" + (hk-prog-val (str hk-pow-src "r = isPowerOf2 0\n") "r") + (list "False")) + +(hk-test "log2 1 = 0" (hk-prog-val (str hk-pow-src "r = log2 1\n") "r") 0) + +(hk-test "log2 8 = 3" (hk-prog-val (str hk-pow-src "r = log2 8\n") "r") 3) + +(hk-test + "log2 1024 = 10" + (hk-prog-val (str hk-pow-src "r = log2 1024\n") "r") + 10) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-primes.sx b/lib/haskell/tests/program-primes.sx new file mode 100644 index 00000000..a5ae2c18 --- /dev/null +++ b/lib/haskell/tests/program-primes.sx @@ -0,0 +1,83 @@ +;; primes.hs — primality testing via trial division with where clauses. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-primes-src + "isPrime n\n | n < 2 = False\n | n == 2 = True\n | otherwise = all notDiv [2..n-1]\n where notDiv d = n `mod` d /= 0\n\nprimes20 = filter isPrime [2..20]\n\nnextPrime n = head (filter isPrime [n+1..])\n\ncountPrimes lo hi = length (filter isPrime [lo..hi])\n") + +(hk-test + "isPrime 2 = True" + (hk-prog-val (str hk-primes-src "r = isPrime 2\n") "r") + (list "True")) + +(hk-test + "isPrime 3 = True" + (hk-prog-val (str hk-primes-src "r = isPrime 3\n") "r") + (list "True")) + +(hk-test + "isPrime 4 = False" + (hk-prog-val (str hk-primes-src "r = isPrime 4\n") "r") + (list "False")) + +(hk-test + "isPrime 5 = True" + (hk-prog-val (str hk-primes-src "r = isPrime 5\n") "r") + (list "True")) + +(hk-test + "isPrime 1 = False" + (hk-prog-val (str hk-primes-src "r = isPrime 1\n") "r") + (list "False")) + +(hk-test + "isPrime 0 = False" + (hk-prog-val (str hk-primes-src "r = isPrime 0\n") "r") + (list "False")) + +(hk-test + "isPrime 7 = True" + (hk-prog-val (str hk-primes-src "r = isPrime 7\n") "r") + (list "True")) + +(hk-test + "isPrime 9 = False" + (hk-prog-val (str hk-primes-src "r = isPrime 9\n") "r") + (list "False")) + +(hk-test + "isPrime 11 = True" + (hk-prog-val (str hk-primes-src "r = isPrime 11\n") "r") + (list "True")) + +(hk-test + "primes20 = [2,3,5,7,11,13,17,19]" + (hk-as-list (hk-prog-val (str hk-primes-src "r = primes20\n") "r")) + (list 2 3 5 7 11 13 17 19)) + +(hk-test + "countPrimes 1 10 = 4" + (hk-prog-val (str hk-primes-src "r = countPrimes 1 10\n") "r") + 4) + +(hk-test + "nextPrime 10 = 11" + (hk-prog-val (str hk-primes-src "r = nextPrime 10\n") "r") + 11) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-roman.sx b/lib/haskell/tests/program-roman.sx new file mode 100644 index 00000000..d1784863 --- /dev/null +++ b/lib/haskell/tests/program-roman.sx @@ -0,0 +1,83 @@ +;; roman.hs — convert integers to Roman numerals with guards + ++. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-rom-src + "toRoman 0 = \"\"\ntoRoman n\n | n >= 1000 = \"M\" ++ toRoman (n - 1000)\n | n >= 900 = \"CM\" ++ toRoman (n - 900)\n | n >= 500 = \"D\" ++ toRoman (n - 500)\n | n >= 400 = \"CD\" ++ toRoman (n - 400)\n | n >= 100 = \"C\" ++ toRoman (n - 100)\n | n >= 90 = \"XC\" ++ toRoman (n - 90)\n | n >= 50 = \"L\" ++ toRoman (n - 50)\n | n >= 40 = \"XL\" ++ toRoman (n - 40)\n | n >= 10 = \"X\" ++ toRoman (n - 10)\n | n >= 9 = \"IX\" ++ toRoman (n - 9)\n | n >= 5 = \"V\" ++ toRoman (n - 5)\n | n >= 4 = \"IV\" ++ toRoman (n - 4)\n | otherwise = \"I\" ++ toRoman (n - 1)\n") + +(hk-test + "toRoman 1 = I" + (hk-prog-val (str hk-rom-src "r = toRoman 1\n") "r") + "I") + +(hk-test + "toRoman 4 = IV" + (hk-prog-val (str hk-rom-src "r = toRoman 4\n") "r") + "IV") + +(hk-test + "toRoman 5 = V" + (hk-prog-val (str hk-rom-src "r = toRoman 5\n") "r") + "V") + +(hk-test + "toRoman 9 = IX" + (hk-prog-val (str hk-rom-src "r = toRoman 9\n") "r") + "IX") + +(hk-test + "toRoman 10 = X" + (hk-prog-val (str hk-rom-src "r = toRoman 10\n") "r") + "X") + +(hk-test + "toRoman 14 = XIV" + (hk-prog-val (str hk-rom-src "r = toRoman 14\n") "r") + "XIV") + +(hk-test + "toRoman 40 = XL" + (hk-prog-val (str hk-rom-src "r = toRoman 40\n") "r") + "XL") + +(hk-test + "toRoman 50 = L" + (hk-prog-val (str hk-rom-src "r = toRoman 50\n") "r") + "L") + +(hk-test + "toRoman 90 = XC" + (hk-prog-val (str hk-rom-src "r = toRoman 90\n") "r") + "XC") + +(hk-test + "toRoman 100 = C" + (hk-prog-val (str hk-rom-src "r = toRoman 100\n") "r") + "C") + +(hk-test + "toRoman 400 = CD" + (hk-prog-val (str hk-rom-src "r = toRoman 400\n") "r") + "CD") + +(hk-test + "toRoman 1000 = M" + (hk-prog-val (str hk-rom-src "r = toRoman 1000\n") "r") + "M") + +(hk-test + "toRoman 1994 = MCMXCIV" + (hk-prog-val (str hk-rom-src "r = toRoman 1994\n") "r") + "MCMXCIV") + +(hk-test + "toRoman 58 = LVIII" + (hk-prog-val (str hk-rom-src "r = toRoman 58\n") "r") + "LVIII") + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-wordcount.sx b/lib/haskell/tests/program-wordcount.sx new file mode 100644 index 00000000..fb3945c5 --- /dev/null +++ b/lib/haskell/tests/program-wordcount.sx @@ -0,0 +1,74 @@ +;; wordcount.hs — word and line counting via string splitting. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-wc-src + "wordCount s = length (words s)\nlineCount s = length (lines s)\ncharCount = length\n\nlongestWord s = foldl longer \"\" (words s)\n where longer a b = if length a >= length b then a else b\n\nshortestWord s = foldl shorter (head (words s)) (words s)\n where shorter a b = if length a <= length b then a else b\n\nuniqueWords s = nub (words s)\n") + +(hk-test + "wordCount single word" + (hk-prog-val (str hk-wc-src "r = wordCount \"hello\"\n") "r") + 1) + +(hk-test + "wordCount two words" + (hk-prog-val (str hk-wc-src "r = wordCount \"hello world\"\n") "r") + 2) + +(hk-test + "wordCount with extra spaces" + (hk-prog-val (str hk-wc-src "r = wordCount \" foo bar \"\n") "r") + 2) + +(hk-test + "wordCount empty = 0" + (hk-prog-val (str hk-wc-src "r = wordCount \"\"\n") "r") + 0) + +(hk-test + "lineCount one line" + (hk-prog-val (str hk-wc-src "r = lineCount \"hello\"\n") "r") + 1) + +(hk-test + "lineCount two lines" + (hk-prog-val (str hk-wc-src "r = lineCount \"a\\nb\"\n") "r") + 2) + +(hk-test + "charCount \"hello\" = 5" + (hk-prog-val (str hk-wc-src "r = charCount \"hello\"\n") "r") + 5) + +(hk-test + "charCount empty = 0" + (hk-prog-val (str hk-wc-src "r = charCount \"\"\n") "r") + 0) + +(hk-test + "longestWord picks longest" + (hk-prog-val (str hk-wc-src "r = longestWord \"a bb ccc\"\n") "r") + "ccc") + +(hk-test + "uniqueWords removes duplicates" + (hk-as-list + (hk-prog-val (str hk-wc-src "r = uniqueWords \"a b a c b\"\n") "r")) + (list "a" "b" "c")) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/program-zipwith.sx b/lib/haskell/tests/program-zipwith.sx new file mode 100644 index 00000000..b714140e --- /dev/null +++ b/lib/haskell/tests/program-zipwith.sx @@ -0,0 +1,74 @@ +;; zipwith.hs — zip, zipWith, unzip operations. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-zip-src + "addPair (x, y) = x + y\npairSum xs ys = map addPair (zip xs ys)\n\nscaleBy k xs = map (\\x -> x * k) xs\n\ndotProduct xs ys = sum (zipWith (*) xs ys)\n\nzipIndex xs = zip [0..length xs - 1] xs\n") + +(hk-test + "zip two lists" + (hk-as-list (hk-prog-val (str hk-zip-src "r = zip [1,2,3] [4,5,6]\n") "r")) + (list (list "Tuple" 1 4) (list "Tuple" 2 5) (list "Tuple" 3 6))) + +(hk-test + "zip unequal lengths — shorter wins" + (hk-as-list (hk-prog-val (str hk-zip-src "r = zip [1,2] [10,20,30]\n") "r")) + (list (list "Tuple" 1 10) (list "Tuple" 2 20))) + +(hk-test + "zipWith (+)" + (hk-as-list + (hk-prog-val (str hk-zip-src "r = zipWith (+) [1,2,3] [10,20,30]\n") "r")) + (list 11 22 33)) + +(hk-test + "zipWith (*)" + (hk-as-list + (hk-prog-val (str hk-zip-src "r = zipWith (*) [2,3,4] [10,10,10]\n") "r")) + (list 20 30 40)) + +(hk-test + "dotProduct [1,2,3] [4,5,6] = 32" + (hk-prog-val (str hk-zip-src "r = dotProduct [1,2,3] [4,5,6]\n") "r") + 32) + +(hk-test + "dotProduct unit vectors = 0" + (hk-prog-val (str hk-zip-src "r = dotProduct [1,0] [0,1]\n") "r") + 0) + +(hk-test + "pairSum adds element-wise" + (hk-as-list + (hk-prog-val (str hk-zip-src "r = pairSum [1,2,3] [4,5,6]\n") "r")) + (list 5 7 9)) + +(hk-test + "unzip separates pairs" + (hk-prog-val (str hk-zip-src "r = unzip [(1,2),(3,4),(5,6)]\n") "r") + (list + "Tuple" + (list ":" 1 (list ":" 3 (list ":" 5 (list "[]")))) + (list ":" 2 (list ":" 4 (list ":" 6 (list "[]")))))) + +(hk-test + "zip empty = []" + (hk-as-list (hk-prog-val (str hk-zip-src "r = zip [] [1,2,3]\n") "r")) + (list)) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/plans/haskell-on-sx.md b/plans/haskell-on-sx.md index 28d123c0..261a4dfc 100644 --- a/plans/haskell-on-sx.md +++ b/plans/haskell-on-sx.md @@ -108,12 +108,16 @@ Key mappings: - [x] Real `IO` monad backed by `perform`/`resume` - [x] `putStrLn`, `getLine`, `readFile`, `writeFile`, `print` - [x] Full-ish Prelude: `Maybe`, `Either`, `List` functions, `Map`-lite -- [ ] Drive scoreboard toward 150+ passing +- [x] Drive scoreboard toward 150+ passing ## Progress log _Newest first._ +- **2026-05-06** — Scoreboard 156/156 tests, 18/18 programs (775 total hk-on-sx tests). Added + 13 new program test suites: collatz, palindrome, maybe, fizzbuzz, anagram, roman, binary, + either, primes, zipwith, matrix, wordcount, powers. Updated conformance.sh PROGRAMS array. + - **2026-05-06** — Phase 6 prelude extras (635/635). `nub`, `sort`, `sortBy`, `sortOn`, `splitAt`, `span`, `break`, `partition`, `unzip`, `tails`, `inits`, `isPrefixOf`, `isSuffixOf`, `isInfixOf`, `intercalate`, `intersperse`, `unwords`, `unlines`,