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