1;;; 2;;; srfi-151 - Bitwise operations 3;;; 4;;; Copyright (c) 2017-2020 Shiro Kawai <shiro@acm.org> 5;;; 6;;; Redistribution and use in source and binary forms, with or without 7;;; modification, are permitted provided that the following conditions 8;;; are met: 9;;; 10;;; 1. Redistributions of source code must retain the above copyright 11;;; notice, this list of conditions and the following disclaimer. 12;;; 13;;; 2. Redistributions in binary form must reproduce the above copyright 14;;; notice, this list of conditions and the following disclaimer in the 15;;; documentation and/or other materials provided with the distribution. 16;;; 17;;; 3. Neither the name of the authors nor the names of its contributors 18;;; may be used to endorse or promote products derived from this 19;;; software without specific prior written permission. 20;;; 21;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 27;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 28;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 29;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 30;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 31;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32;;; 33 34(define-module srfi-151 35 (use srfi-1) 36 (use srfi-60) 37 (use srfi-133) 38 (use gauche.generator) 39 (export bitwise-not ; srfi-60 40 bitwise-and ; srfi-60 41 bitwise-ior ; srfi-60 42 bitwise-xor ; srfi-60 43 bitwise-eqv 44 bitwise-nand bitwise-nor 45 bitwise-andc1 bitwise-andc2 46 bitwise-orc1 bitwise-orc2 47 48 arithmetic-shift ; srfi-60 49 bit-count ; builtin 50 integer-length ; builtin 51 52 bitwise-if ; srfi-60 53 bit-set? ; builtin 54 copy-bit ; builtin 55 bit-swap 56 any-bit-set? 57 every-bit-set? 58 first-set-bit ; builtin 59 60 bit-field ; builtin 61 bit-field-any? 62 bit-field-every? 63 bit-field-clear 64 bit-field-set 65 bit-field-replace 66 bit-field-replace-same 67 bit-field-rotate 68 bit-field-reverse 69 70 bits->list 71 list->bits 72 bits->vector 73 vector->bits 74 bits 75 bitwise-fold 76 bitwise-for-each 77 bitwise-unfold 78 make-bitwise-generator)) 79(select-module srfi-151) 80 81(define (%bitwise-eqv-2 a b) (lognot (logxor a b))) 82 83(define bitwise-eqv 84 (case-lambda 85 [() -1] 86 [(a) a] 87 [(a b) (%bitwise-eqv-2 a b)] 88 [(a b . args) (apply bitwise-eqv (%bitwise-eqv-2 a b) args)])) 89 90;; TODO: These can be a lot more efficiently implemented natively, and 91;; eventually, we'd rather optimize expressons like (lognot (logand a b)) 92;; into built-in bitwise-nand etc. 93(define (bitwise-nand a b) (lognot (logand a b))) 94(define (bitwise-nor a b) (lognot (logior a b))) 95(define (bitwise-andc1 a b) (logand (lognot a) b)) 96(define (bitwise-andc2 a b) (logand a (lognot b))) 97(define (bitwise-orc1 a b) (logior (lognot a) b)) 98(define (bitwise-orc2 a b) (logior a (lognot b))) 99 100(define (bit-swap index1 index2 n) 101 (let ([a (bit-set? index1 n)] 102 [b (bit-set? index2 n)]) 103 (copy-bit index1 (copy-bit index2 n a) b))) 104 105(define (any-bit-set? test-bits n) (not (zero? (logand test-bits n)))) 106(define (every-bit-set? test-bits n) (= (logand test-bits n) test-bits)) 107 108(define (bit-field-any? n start end) (not (zero? (bit-field n start end)))) 109(define (bit-field-every? n start end) (zero? (bit-field (lognot n) start end))) 110 111(define (bit-field-clear n start end) (copy-bit-field n 0 start end)) 112(define (bit-field-set n start end) (copy-bit-field n -1 start end)) 113 114(define bit-field-replace copy-bit-field) 115 116(define (bit-field-replace-same dst src start end) 117 (copy-bit-field dst (bit-field src start end) start end)) 118 119(define bit-field-rotate rotate-bit-field) ;srfi-60 120(define bit-field-reverse reverse-bit-field) ;srfi-60 121 122(define (bits->list n . opts) 123 (assume (not (negative? n))) 124 (reverse (apply integer->list n opts))) 125 126(define (bits->vector n :optional len) 127 (assume (not (negative? n))) 128 (vector-unfold (cut bit-set? <> n) 129 (if (undefined? len) (integer-length n) len))) 130 131(define (list->bits bs) (list->integer (reverse bs))) 132(define (vector->bits bs) (list->integer (reverse-vector->list bs))) 133(define (bits . bs) (list->bits bs)) 134 135(define (bitwise-fold proc seed n) 136 (define len (integer-length n)) 137 (do ([len len (- len 1)] 138 [n n (ash n -1)] 139 [seed seed (proc (odd? n) seed)]) 140 [(<= len 0) seed])) 141 142(define (bitwise-for-each proc n) 143 (bitwise-fold (^[b _] (proc b)) 0 n)) 144 145(define (bitwise-unfold p f g seed) 146 (do ([seed seed (g seed)] 147 [i 0 (+ i 1)] 148 [r 0 (copy-bit i r (f seed))]) 149 [(p seed) r])) 150 151;; Unlike bits->generator in gauche.generator, this one is infinite. 152(define (make-bitwise-generator n) 153 (^[] (begin0 (odd? n) (set! n (ash n -1))))) 154 155 156 157