Commit | Line | Data |
---|---|---|
2a435f1f JG |
1 | ;;; bitwise.scm --- The R6RS bitwise arithmetic operations library |
2 | ||
1f4f2a12 | 3 | ;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. |
2a435f1f JG |
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)) | |
aa439b39 | 43 | (rnrs control (6)) |
93da406f MW |
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)) | |
2a435f1f JG |
56 | (rename (only (guile) lognot |
57 | logand | |
58 | logior | |
59 | logxor | |
60 | logcount | |
aa439b39 JG |
61 | logbit? |
62 | modulo | |
2a435f1f JG |
63 | ash) |
64 | (lognot bitwise-not) | |
65 | (logand bitwise-and) | |
66 | (logior bitwise-ior) | |
67 | (logxor bitwise-xor) | |
2a435f1f JG |
68 | (ash bitwise-arithmetic-shift))) |
69 | ||
e8f32997 MW |
70 | (define (bitwise-bit-count ei) |
71 | (if (negative? ei) | |
72 | (bitwise-not (logcount ei)) | |
73 | (logcount ei))) | |
74 | ||
2a435f1f JG |
75 | (define (bitwise-bit-set? ei1 ei2) (logbit? ei2 ei1)) |
76 | ||
77 | (define (bitwise-copy-bit ei1 ei2 ei3) | |
93da406f MW |
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))) | |
2a435f1f JG |
83 | |
84 | (define (bitwise-copy-bit-field ei1 ei2 ei3 ei4) | |
93da406f | 85 | (copy-bit-field ei1 ei4 ei2 ei3)) |
2a435f1f | 86 | |
2a435f1f | 87 | (define (bitwise-rotate-bit-field ei1 ei2 ei3 ei4) |
93da406f | 88 | (rotate-bit-field ei1 ei4 ei2 ei3)) |
2a435f1f | 89 | |
93da406f MW |
90 | (define bitwise-arithmetic-shift-left bitwise-arithmetic-shift) |
91 | (define (bitwise-arithmetic-shift-right ei1 ei2) | |
92 | (bitwise-arithmetic-shift ei1 (- ei2)))) |