1;; SRFI-60 implementation for Kawa (almost everything is already built 2;; in, but some of the names differ slightly). 3;; Copyright (C) 2014 by Jamison Hope. The implementations of 4;; integer->list, list->integer, and booleans->integer were taken with 5;; slight modifications from the reference implementation of SRFI-60, 6;; which is copyright (C) 1991, 1993, 2001, 2003, 2005 Aubrey Jaffer 7; 8;Permission to copy this software, to modify it, to redistribute it, 9;to distribute modified versions, and to use it for any purpose is 10;granted, subject to the following restrictions and understandings. 11; 12;1. Any copy made of this software must include this copyright notice 13;in full. 14; 15;2. I have made no warranty or representation that the operation of 16;this software will be error-free, and I am under no obligation to 17;provide any services, by way of maintenance, update, or otherwise. 18; 19;3. In conjunction with products arising from the use of this 20;material, there shall be no use of my name in any advertising, 21;promotional, or sales literature without prior written consent in 22;each case. 23 24(module-compile-options warn-unknown-member: #t) 25 26(provide 'srfi-60) 27 28;;; These procedures are already Kawa built-ins and do not need to be 29;;; defined here: logand/bitwise-and, logior/bitwise-ior, 30;;; logxor/bitwise-xor, lognot/bitwise-not, bitwise-if, logtest, 31;;; logcount, integer-length, and ash/arithmetic-shift. 32 33(define-alias arithmetic-shift gnu.kawa.functions.BitwiseOp:ashift) 34(define-alias ash gnu.kawa.functions.BitwiseOp:ashift) 35(define-alias bitwise-and gnu.kawa.functions.BitwiseOp:and) 36(define-alias logand gnu.kawa.functions.BitwiseOp:and) 37(define-alias bitwise-ior gnu.kawa.functions.BitwiseOp:ior) 38(define-alias logior gnu.kawa.functions.BitwiseOp:ior) 39(define-alias bitwise-not gnu.kawa.functions.BitwiseOp:not) 40(define-alias lognot gnu.kawa.functions.BitwiseOp:not) 41(define-alias bitwise-xor gnu.kawa.functions.BitwiseOp:xor) 42(define-alias logxor gnu.kawa.functions.BitwiseOp:xor) 43(define-alias integer-length kawa.lib.numbers:bitwise-length) 44(define-alias bitwise-if kawa.lib.numbers:bitwise-if) 45(define-alias logtest kawa.lib.numbers:logtest) 46(define-alias logcount kawa.lib.numbers:logcount) 47 48;;; These procedures alias functionality provided by built-ins with 49;;; differing names: 50 51(define bitwise-merge bitwise-if) 52(define any-bits-set? logtest) 53(define bit-count logcount) 54(define log2-binary-factors bitwise-first-bit-set) 55(define first-set-bit bitwise-first-bit-set) 56(define bit-field bitwise-bit-field) 57(define reverse-bit-field bitwise-reverse-bit-field) 58 59;;; These procedures are similar to built-ins but with arguments 60;;; reordered: 61 62(define (logbit? index::int n::integer) ::boolean 63 (bitwise-bit-set? n index)) 64(define bit-set? logbit?) 65 66(define (copy-bit-field to::integer from::integer start::int end::int) 67 ::integer 68 (bitwise-copy-bit-field to start end from)) 69 70(define (rotate-bit-field n::integer count::int start::int end::int) 71 ::integer 72 (bitwise-rotate-bit-field n start end count)) 73 74;;; This procedure has a slightly different signature compared to the 75;;; built-in bitwise-copy-bit: the first two arguments are swapped and 76;;; the last is a boolean instead of an int 77(define (copy-bit index::int from::integer bit::boolean) 78 ::integer 79 (bitwise-copy-bit from index (if bit 1 0))) 80 81;;; These procedures are entirely new, with implementations derived 82;;; from the SRFI-60 reference. 83(define (integer->list k::integer #!optional (len ::int (integer-length k))) 84 ::list 85 (do ((idx ::int (- len 1) (- idx 1)) 86 (k ::integer k (ash k -1)) 87 (lst ::list '() (cons (odd? k) lst))) 88 ((< idx 0) lst))) 89 90(define (list->integer bools::list) ::integer 91 (do ((bs bools (cdr bs)) 92 (acc ::integer 0 (if (car bs) (+ acc acc 1) (+ acc acc)))) 93 ((null? bs) acc))) 94 95(define (booleans->integer . bools) 96 (list->integer bools)) 97