;;;; bitwise-utils-test  -*- Scheme -*-
;;;; Kon Lovett, Apr '20

(import test)

(test-begin "Bitwise Utils")

;;;

(import bitwise-utils)
(import (chicken bitwise))

(define (hex->number x) (string->number x 16))
(define (number->hex x) (number->string x 16))
(define (negate x) (* -1 x))

;from srfi-1/srfi-1.scm
;;; IOTA count [start step] (start start+step ... start+(count-1)*step)

(define (iota count . maybe-start+step)
;  (check-arg integer? count iota)
  (##sys#check-number count 'iota)
  (if (< count 0) (##sys#error 'iota "Negative step count" iota count))
  (let-optionals maybe-start+step ((start 0) ; Olin, I'm tired of fixing your stupid bugs - why didn't
           (step 1) ) ; you use your own macros, then?
    (##sys#check-number start 'iota)
    (##sys#check-number step 'iota)
;    (check-arg number? start iota)
;    (check-arg number? step iota)
    (let ((last-val (+ start (* (- count 1) step))))
      (do ((count count (- count 1))
     (val last-val (- val step))
     (ans '() (cons val ans)))
    ((<= count 0)  ans)))))

(test-group "(from srfi-60 test)"
  (test "bitwise-and/bitwise-and"
    #b1000 (bitwise-and #b1100 #b1010))
  (test "bitwise-ior/bitwise-ior"
    #b1110 (bitwise-ior #b1100 #b1010))
  (test "bitwise-xor/bitwise-xor"
    #b110 (bitwise-xor #b1100 #b1010))
  (test "bitwise-not/bitwise-not"
    #b-10000001 (bitwise-not #b10000000))
  (test "bitwise-any?/any-bitwise-nth? no"
    #f (bitwise-any? #b0100 #b1011))
  (test-assert "bitwise-any?/any-bitwise-nth? yes"
    (bitwise-any? #b0100 #b0111))
  (test "bitwise-count"
    4 (bitwise-count #b10101010))
  (test "bitwise-count zero"
    0 (bitwise-count 0))
  (test "bitwise-count negative"
    1 (bitwise-count -2))
  (test "integer-length"
    8 (integer-length #b10101010))
  (test "integer-length zero"
    0 (integer-length 0))
  (test "integer-length four"
    4 (integer-length #b1111))
  (test "bitwise-first-set/bitwise-first-set"
    '(4 0 1 0 2 0 1 0 3 0 1 0 2 0 1 0 -1 0 1 0 2 0 1 0 3 0 1 0 2 0 1 0 4)
    (map bitwise-first-set (iota 33 -16)))
  (test "bitwise-nth?/bitwise-nth?"
    '(#t #f #t #t #f)
    (map (lambda (n) (bitwise-nth? n #b1101)) (iota 5)))
  (test "bitwise-set-nth zero unary"
    #b1 (bitwise-set-nth 0 0 #t))
  (test "bitwise-set-nth zero centenial"
    #b100 (bitwise-set-nth 0 2 #t))
  (test "bitwise-set-nth negative"
    #b1011 (bitwise-set-nth #b1111 2 #f))
  (test "bitwise-field first half"
    #b1010 (bitwise-field #b1101101010 0 4))
  (test "bitwise-field second half"
    #b10110 (bitwise-field #b1101101010 4 9))
  (test "copy-bitwise-field positive"
    #b1101100000 (bitwise-field-copy #b1101101010 0 0 4))
  (test "bitwise-field-copy negative"
    #b1101101111 (bitwise-field-copy #b1101101010 -1 0 4))
  (test "bitwise-field-copy long negative"
    #b110100111110000 (bitwise-field-copy #b110100100010000 -1 5 9))
  (test "arithmetic-shift/arithmetic-shift positive"
    #b1000 (arithmetic-shift #b1 3))
  (test "arithmetic-shift/arithmetic-shift negative"
    #b101 (arithmetic-shift #b1010 -1))
  (test "bitwise-field-rotate short positive"
    #b10 (bitwise-field-rotate #b0100 3 0 4))
  (test "bitwise-field-rotate short negative"
    #b10 (bitwise-field-rotate #b0100 -1 0 4))
  (test "bitwise-field-rotate long negative"
    #b110100010010000 (bitwise-field-rotate #b110100100010000 -1 5 9))
  (test "bitwise-field-rotate long positive"
    #b110100000110000 (bitwise-field-rotate #b110100100010000 1 5 9))
  (test "bitwise-field-reverse"
    #xe5 (bitwise-field-reverse #xa7 0 8))
)

(test-group "additional tests"
  ;used internally
  (test #b1010011 (bitwise-drop-right #b101001111 2))

  (test #b+01111111 (bitwise-mask 7))
  (test #b+01111111 (bitwise-mask 7 #t))
  (test #b-10000000 (bitwise-mask 7 #f))

  (test #b-100 (logical-shift-right #b-1000 1))
  (test #b+100 (logical-shift-right #b+1000 1))

  (test #b-101 (logical-shift-right #b-1011 1))
  (test #b+101 (logical-shift-right #b+1011 1))

  (test #x-2c (logical-shift-right #x-b0 2))
  (test #x+2c (logical-shift-right #x+b0 2))

  (test #x-2c000000000000000000000000044000
    (logical-shift-right #x-b0000000000000000000000000110000 2))
  (test #x+2c000000000000000000000000044000
    (logical-shift-right #x+b0000000000000000000000000110000 2))

  (test #b+0111111100 (logical-shift-left (bitwise-mask 7) 2))
  (test #b+0111111100 (logical-shift-left (bitwise-mask 7 #t) 2))
  (test #b-1000000000 (logical-shift-left (bitwise-mask 7 #f) 2))

  (test 1023 (string-length (number->string (bitwise-mask 1023) 2)))

  (test #b101101 (bitwise-join #b10 #b0000001 #b101))
  (test #b110011000000001 (bitwise-join #b1100 #b1100000000 #b1))
  (test #xb0000000000000000000000000110000deadbeef
    (bitwise-join #xb0000000000000000000000000110000 #xdeadbeef))
  ;(bitwise-join #t 23 '())
  (test #b110111 (bitwise-join #b1 23 #x0))

  ;mask effectively #b1..11000000011 (#b-111111101)
  (test #b-111111101 (bitwise-join (bitwise-mask 7 #f) #b11))
  (test #b110011000000001 (bitwise-and #b110011010110101 (bitwise-join (bitwise-mask 7 #f) #b11)))
  (test #b110011000000001 (bitwise-and #b110011010110101 #b111111000000011))

  (test '(0) (bitwise-split 0 5))
  (test '(5) (bitwise-split 5 0))
  (test '(0) (bitwise-split 0 0))

  (test '("a" "b" "c" "d" "e" "f") (map number->hex (bitwise-split #xabcdef 4)))
  (test '("-a" "-b" "-c" "-d" "-e" "-f") (map number->hex (bitwise-split #x-abcdef 4)))

  ;NOTE not bitwise-join <inverse> bitwise-split due to sign
  (test #xabcdef (apply bitwise-join (map hex->number '("a" "b" "c" "d" "e" "f"))))
  (test #x-abcdef (negate (apply bitwise-join (map (o negate hex->number) '("-a" "-b" "-c" "-d" "-e" "-f")))))

  (test '("b0000000" "0" "110000deadbeef") (map number->hex (bitwise-split #xb0000000000000000000000000110000deadbeef 64)))
  (test '("-b0000000" "0" "-110000deadbeef") (map number->hex (bitwise-split #x-b0000000000000000000000000110000deadbeef 64)))

  (test 29 (bitwise-count #xb0000000000000000000000000110000deadbeef))
  (test 28 (bitwise-count #x-b0000000000000000000000000110000deadbeef))

  (test 64 (bitwise-count 12234789487927890421094841580858919801))

  (test #b011001100110011001100110011001100110011001100110 (list->integer (integer->list #b011001100110011001100110011001100110011001100110)))
  (test #b0 (list->integer (integer->list #b01100110 0)))
  (test #b110 (list->integer (integer->list #b01100110 3)))
)

;;;

(test-end "Bitwise Utils")

(test-exit)