guile/module/srfi/srfi-151.sld

;; Copyright (C) John Cowan (2016). All Rights Reserved.

;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:

;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

(define-library (srfi srfi-151)
  (import (scheme base))
  (import (scheme case-lambda))

  (export bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-eqv
          bitwise-nand bitwise-nor bitwise-andc1 bitwise-andc2
          bitwise-orc1 bitwise-orc2)
  (export arithmetic-shift bit-count integer-length bitwise-if
          bit-set? copy-bit bit-swap any-bit-set? every-bit-set?  first-set-bit)
  (export bit-field bit-field-any? bit-field-every?  bit-field-clear bit-field-set
          bit-field-replace  bit-field-replace-same
          bit-field-rotate bit-field-reverse)
  (export bits->list list->bits bits->vector vector->bits bits
          bitwise-fold bitwise-for-each bitwise-unfold make-bitwise-generator)

  ;; Provide core functions
  (import (only (rnrs arithmetic bitwise)
                bitwise-not bitwise-and bitwise-ior bitwise-xor
                bitwise-bit-count))
  (import (rename (only (rnrs arithmetic bitwise)
                        bitwise-arithmetic-shift bitwise-length)
                  (bitwise-arithmetic-shift arithmetic-shift)
                  (bitwise-length integer-length)))

  (begin
    (define (bit-count i) ; Negative case different to R6RS bitwise-bit-count
      (if (>= i 0)
          (bitwise-bit-count i)
          (bitwise-bit-count (bitwise-not i)))))

  ;; Stable part of the implementation
  (include "srfi-151/bitwise-33.scm")
  (include "srfi-151/bitwise-60.scm")
  (include "srfi-151/bitwise-other.scm"))