1;;; 2;;; srfi-60 - integers as bits 3;;; 4;;; Since most procedures are already supported as builtins, this 5;;; module only provides a thin wrapper to cover the complete srfi-60 spec. 6 7(define-module srfi-60 8 (use gauche.sequence) 9 (use srfi-42) 10 (export logand bitwise-and 11 logior bitwise-ior 12 logxor bitwise-xor 13 lognot bitwise-not 14 bitwise-if bitwise-merge 15 logtest any-bits-set? 16 logcount bit-count 17 integer-length 18 log2-binary-factors first-set-bit 19 logbit? bit-set? 20 copy-bit 21 bit-field 22 copy-bit-field 23 ash arithmetic-shift 24 rotate-bit-field 25 reverse-bit-field 26 integer->list 27 list->integer 28 booleans->integer)) 29(select-module srfi-60) 30 31;;; 32;;; Bitwise operators 33;;; 34 35;; logand, logior, logxor, lognot, logtest - defined in gauche 36(define-inline bitwise-and logand) 37(define-inline bitwise-ior logior) 38(define-inline bitwise-xor logxor) 39(define-inline bitwise-not lognot) 40 41(define (bitwise-if mask n0 n1) 42 (logior (logand mask n0) (logand (lognot mask) n1))) 43(define bitwise-merge bitwise-if) 44 45(define-inline any-bits-set? logtest) 46 47;;; 48;;; Integer properties 49;;; 50 51;; logcount - defined in gauche 52(define-inline bit-count logcount) 53 54;; these two are the same as built-in twos-exponent-factor 55(define-inline log2-binary-factors twos-exponent-factor) 56(define-inline first-set-bit twos-exponent-factor) 57 58;;; 59;;; Bit within word 60;;; 61 62;; logbit?, copy-bit - defined in gauche 63(define-inline bit-set? logbit?) 64 65;;; 66;;; Field of bits 67;;; 68 69;; bit-field, copy-bit-field, ash - defined in gauche 70(define-inline arithmetic-shift ash) 71 72(define (rotate-bit-field n count start end) 73 (if (or (>= start end) (= count 0)) 74 n ; trivial path 75 (let* ([mask (logxor (- (expt 2 end) 1) (- (expt 2 start) 1))] 76 [target (logand mask n)] 77 [xcount (mod count (- end start))]) 78 (logior (logand (lognot mask) n) 79 (logand mask 80 (logior (ash target xcount) 81 (ash target (- (- (- end start) xcount))))))))) 82 83(define (reverse-bit-field n start end) 84 (if (>= start end) 85 n ; trivial path 86 (let1 mask (logxor (- (expt 2 end) 1) (- (expt 2 start) 1)) 87 (let loop ([m (logand n (lognot mask))] 88 [i start] 89 [j (- end 1)]) 90 (if (= i end) 91 m 92 (loop (copy-bit j m (logbit? i n)) (+ i 1) (- j 1))))))) 93 94;;; 95;;; Bits as booleans 96;;; 97 98(define (integer->list n :optional (len (integer-length n))) 99 (list-ec (: i (- len 1) -1 -1) (logbit? i n))) 100 101(define (list->integer lis) 102 (cond [(null? lis) 0] 103 [(<= (length lis) (integer-length (greatest-fixnum))) 104 ;; fixnum range - it's faster to calculate intermediate results 105 (fold (^(bit v) (+ v v (if bit 1 0))) 0 lis)] 106 [else 107 ;; bignum range - it's faster to create list of integers and merge 108 (apply logior 109 (fold-with-index (^(i bit ns) (if bit (cons (expt 2 i) ns) ns)) 110 '() (reverse lis)))])) 111 112(define (booleans->integer . lis) (list->integer lis)) 113 114 115