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

;;;; Issues
;;

#>
/* Number of 1 bits */
static unsigned int
C_uword_bits( C_uword n )
{
# define TWO( c )       ( ((C_uword) 1u) << (c))
# define MASK( c )      (((C_uword) -1) / (TWO( TWO( c ) ) + 1u))
# define COUNT( x, c )  ((x) & MASK( c )) + (((x) >> (TWO( c ))) & MASK( c ))

  if (0 == n) return (unsigned int) 0;

	n = COUNT( n, 0 );
	n = COUNT( n, 1 );
	n = COUNT( n, 2 );
	n = COUNT( n, 3 );
	n = COUNT( n, 4 );
# ifdef C_SIXTY_FOUR
	n = COUNT( n, 5 );
# endif

	return (unsigned int) n;

# undef COUNT
# undef MASK
# undef TWO
}
<#

(module bitwise-utils

(;export
  arithmetic-shift-left arithmetic-shift-right
  logical-shift-left logical-shift-right
  bitwise-mask
  bitwise-join
  bitwise-split
  bitwise-count)

(import scheme)
(import (only (chicken base) fixnum? foldl cut))
(import (chicken type))
(import (chicken foreign))
(import (only (chicken bitwise)
  integer-length arithmetic-shift
  bitwise-not bitwise-and bitwise-ior))

;;

(: arithmetic-shift-left (integer fixnum --> integer))
(: arithmetic-shift-right (integer fixnum --> integer))
(: logical-shift-left (integer fixnum --> integer))
(: logical-shift-right (integer fixnum --> integer))
(: bitwise-mask (fixnum #!optional boolean fixnum --> integer))
(: bitwise-join (integer #!rest integer --> integer))
(: bitwise-split (integer fixnum --> (list-of integer)))
(: bitwise-count (integer --> fixnum))

;observes sign - does sign extend
(define arithmetic-shift-left arithmetic-shift)
(define (arithmetic-shift-right n w) (arithmetic-shift n (- w)))

;5 #t => +0...011111
;5 #f => -1...100000
(define (bitwise-mask b #!optional (on? #t))
  (if (zero? b) 0
    (let ((res (arithmetic-shift-left -1 b)))
      (if on? (bitwise-not res) res) ) ) )

(define (*logical-shift-right n w)
  (bitwise-and (arithmetic-shift-right n w) (bitwise-mask (- (integer-length n) w))) )

;preserves sign - doesn't sign extend
(define logical-shift-left arithmetic-shift-left)
(define (logical-shift-right n w)
  (if (zero? w) n
    (let ((res (*logical-shift-right (abs n) w)))
      (if (negative? n) (- res) res) ) ) )

(define (*bitwise-join a b)
  (bitwise-ior (logical-shift-left a (integer-length b)) b) )

;#b10 #b0000001 #b101 => #b101101
(define (bitwise-join n . ns) (foldl (cut *bitwise-join <> <>) n ns))

;babcdef 2 => ba bc de f
;0 2 => '()
;123 0 => '()
(define (bitwise-split n w)
  (if (or (zero? n) (zero? w)) `(,n)
    (let ((neg? (negative? n)) (mask (bitwise-mask w)))
      (let loop ((n (abs n)) (ns '()))
        (if (zero? n) (if neg? (map - ns) ns)
          (loop (*logical-shift-right n w) (cons (bitwise-and n mask) ns)) ) ) ) ) )

(define *uword-size* (foreign-type-size "C_uword"))

(cond-expand
  (64bit
    (define uword-bitwise-count
      (foreign-lambda* unsigned-int ((integer64 n))
        "return( C_uword_bits( (C_uword) n ) );")) )
  (else ;32bit
    (define uword-bitwise-count
      (foreign-lambda* unsigned-int ((integer32 n))
        "return( C_uword_bits( (C_uword) n ) );")) ) )

(define (bitwise-count n)
  (if (fixnum? n) (uword-bitwise-count n)
    (foldl
      (lambda (c i) (+ c (uword-bitwise-count i)))
      0
      (bitwise-split n (* 8 *uword-size*))) ) )

) ;bitwise-utils