srfi/srfi-60.scm

   1 ;;; srfi-60.scm --- Integers as Bits
   2
   3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
   4 ;;
   5 ;; This library is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public
   7 ;; License as published by the Free Software Foundation; either
   8 ;; version 2.1 of the License, or (at your option) any later version.
   9 ;;
  10 ;; This library is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this library; if not, write to the Free Software
  17 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (srfi srfi-60)
  20   #:export (bitwise-and
  21             bitwise-ior
  22             bitwise-xor
  23             bitwise-not
  24             any-bits-set?
  25             bit-count
  26             bitwise-if bitwise-merge
  27             log2-binary-factors first-set-bit
  28             bit-set?
  29             copy-bit
  30             bit-field
  31             copy-bit-field
  32             arithmetic-shift
  33             rotate-bit-field
  34             reverse-bit-field
  35             integer->list
  36             list->integer
  37             booleans->integer)
  38   #:re-export (logand
  39                logior
  40                logxor
  41                integer-length
  42                logtest
  43                logcount
  44                logbit?
  45                ash))
  46
  47 (load-extension "libguile-srfi-srfi-60-v-1" "scm_init_srfi_60")
  48
  49 (define bitwise-and logand)
  50 (define bitwise-ior logior)
  51 (define bitwise-xor logxor)
  52 (define bitwise-not lognot)
  53 (define any-bits-set? logtest)
  54 (define bit-count logcount)
  55
  56 (define (bitwise-if mask n0 n1)
  57   (logior (logand mask n0)
  58           (logand (lognot mask) n1)))
  59 (define bitwise-merge bitwise-if)
  60
  61 (define first-set-bit log2-binary-factors)
  62 (define bit-set? logbit?)
  63 (define bit-field bit-extract)
  64
  65 (define (copy-bit-field n newbits start end)
  66   (logxor n (ash (logxor (bit-extract n start end)              ;; cancel old
  67                          (bit-extract newbits 0 (- end start))) ;; insert new
  68                  start)))
  69
  70 (define arithmetic-shift ash)
  71
  72 (cond-expand-provide (current-module) '(srfi-60))