module/srfi/srfi-60.scm

   1 ;;; srfi-60.scm --- Integers as Bits
   2
   3 ;; Copyright (C) 2005, 2006, 2010 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 3 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             bitwise-if bitwise-merge
  26             log2-binary-factors first-set-bit
  27             bit-set?
  28             copy-bit
  29             bit-field
  30             copy-bit-field
  31             arithmetic-shift
  32             rotate-bit-field
  33             reverse-bit-field
  34             integer->list
  35             list->integer
  36             booleans->integer)
  37   #:replace (bit-count)
  38   #:re-export (logand
  39                logior
  40                logxor
  41                integer-length
  42                logtest
  43                logcount
  44                logbit?
  45                ash))
  46
  47 (load-extension (string-append "libguile-" (effective-version))
  48                 "scm_init_srfi_60")
  49
  50 (define bitwise-and logand)
  51 (define bitwise-ior logior)
  52 (define bitwise-xor logxor)
  53 (define bitwise-not lognot)
  54 (define any-bits-set? logtest)
  55 (define bit-count logcount)
  56
  57 (define (bitwise-if mask n0 n1)
  58   (logior (logand mask n0)
  59           (logand (lognot mask) n1)))
  60 (define bitwise-merge bitwise-if)
  61
  62 (define first-set-bit log2-binary-factors)
  63 (define bit-set? logbit?)
  64 (define bit-field bit-extract)
  65
  66 (define (copy-bit-field n newbits start end)
  67   (logxor n (ash (logxor (bit-extract n start end)              ;; cancel old
  68                          (bit-extract newbits 0 (- end start))) ;; insert new
  69                  start)))
  70
  71 (define arithmetic-shift ash)
  72
  73 (cond-expand-provide (current-module) '(srfi-60))