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