(define (b x- x x+)
(define (and a b) (fix:and a b))
(define (or a b) (fix:or a b))
(define (xor a b) (fix:xor a b))
(define (lsh a b) (fix:lsh a b))
(let* ((a0 (and x- x+)) (b0 (xor x- x+)) (c0 (xor x b0))
(d0 (lsh c0 -1)) (c1 (lsh c0 1)) (e0 (xor c1 d0))
(f1 (or (and b0 e0) (and c1 d0))) (c4 (or (and x b0) a0))
(b1 (lsh c4 1)) (c5 (lsh c4 -1)))
(and (xor (or (and b1 c5) (or a0 f1))
(or (and a0 f1) (or b1 c5)))
(or (xor b0 e0) x))))
このプログラムは, fixnumでも動くが, fixnumは24ビットしかないので, 実用的には長さが自由なbit-string型の方を使いたい. それに対処すべく, 上のプログラムでは, and, or等は別に定義してある.
MIT Schemeのreference manualでBit Stringを見ると, bit-string-and, bit-string-or, bit-string-xorはあるが, シフトはない. そこでシフトはbit-substringとbit-string-append使って実装することになる.
(define (bit-string-lsh a c)
(if (>= c 0)
(bit-string-append (make-bit-string c #f)
(bit-substring a 0 (- (bit-string-length a) c)))
(bit-string-append
(bit-substring a (- c) (bit-string-length a))
(make-bit-string (- c) #f))))
(define bs (unsigned-integer->bit-string 12 #b111010010111))
=>#*111010010111 ;12ビットのテスト用bit stringを作る.
(bit-string-lsh bs 2) => #*101001011100 ;左シフト
(bit-string-lsh bs -2) => #*001110100101 ;右シフト
こんな具合いである.
0 件のコメント:
コメントを投稿