Commit | Line | Data |
---|---|---|
8884a084 KR |
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 | |
92205699 | 17 | ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
8884a084 KR |
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)) |