Files
rose-ash/lib/haskell/tests/program-binary.sx
giles 09d65d2d7b
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
haskell: 13 new program suites + scoreboard 156/156 (775 tests)
collatz, palindrome, maybe, fizzbuzz, anagram, roman, binary, either,
primes, zipwith, matrix, wordcount, powers — all 18/18 programs green.
conformance.sh PROGRAMS array updated; scoreboard.md regenerated.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-06 17:02:02 +00:00

84 lines
1.9 KiB
Plaintext

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