module/rnrs/arithmetic/bitwise.scm

   1 ;;; bitwise.scm --- The R6RS bitwise arithmetic operations library
   2
   3 ;;      Copyright (C) 2010, 2013 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 \f
  19
  20 (library (rnrs arithmetic bitwise (6))
  21   (export bitwise-not
  22
  23           bitwise-and
  24           bitwise-ior
  25           bitwise-xor
  26
  27           bitwise-if
  28           bitwise-bit-count
  29           bitwise-length
  30
  31           bitwise-first-bit-set
  32           bitwise-bit-set?
  33           bitwise-copy-bit
  34           bitwise-bit-field
  35           bitwise-copy-bit-field
  36
  37           bitwise-arithmetic-shift
  38           bitwise-arithmetic-shift-left
  39           bitwise-arithmetic-shift-right
  40           bitwise-rotate-bit-field
  41           bitwise-reverse-bit-field)
  42   (import (rnrs base (6))
  43           (rnrs control (6))
  44           (rename (only (srfi srfi-60) bitwise-if
  45                                        integer-length
  46                                        first-set-bit
  47                                        copy-bit
  48                                        bit-field
  49                                        copy-bit-field
  50                                        rotate-bit-field
  51                                        reverse-bit-field)
  52                   (integer-length bitwise-length)
  53                   (first-set-bit bitwise-first-bit-set)
  54                   (bit-field bitwise-bit-field)
  55                   (reverse-bit-field bitwise-reverse-bit-field))
  56           (rename (only (guile) lognot
  57                                 logand
  58                                 logior
  59                                 logxor
  60                                 logcount
  61                                 logbit?
  62                                 modulo
  63                                 ash)
  64                   (lognot bitwise-not)
  65                   (logand bitwise-and)
  66                   (logior bitwise-ior)
  67                   (logxor bitwise-xor)
  68                   (ash bitwise-arithmetic-shift)))
  69
  70   (define (bitwise-bit-count ei)
  71     (if (negative? ei)
  72         (bitwise-not (logcount ei))
  73         (logcount ei)))
  74
  75   (define (bitwise-bit-set? ei1 ei2) (logbit? ei2 ei1))
  76
  77   (define (bitwise-copy-bit ei1 ei2 ei3)
  78     ;; The specification states that ei3 should be either 0 or 1.
  79     ;; However, other values have been tolerated by both Guile 2.0.x and
  80     ;; the sample implementation given the R6RS library document, so for
  81     ;; backward compatibility we continue to permit it.
  82     (copy-bit ei2 ei1 (logbit? 0 ei3)))
  83
  84   (define (bitwise-copy-bit-field ei1 ei2 ei3 ei4)
  85     (copy-bit-field ei1 ei4 ei2 ei3))
  86
  87   (define (bitwise-rotate-bit-field ei1 ei2 ei3 ei4)
  88     (rotate-bit-field ei1 ei4 ei2 ei3))
  89
  90   (define bitwise-arithmetic-shift-left bitwise-arithmetic-shift)
  91   (define (bitwise-arithmetic-shift-right ei1 ei2)
  92     (bitwise-arithmetic-shift ei1 (- ei2))))