1;;; 2;;; srfi-143 - Fixnums 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-143 35 (use srfi-60 :only (bitwise-if rotate-bit-field reverse-bit-field)) 36 (use srfi-141 :only (balanced/)) 37 (export fx-width fx-greatest fx-least 38 fixnum? fx=? fx<? fx<=? fx>? fx>=? 39 fxzero? fxpositive? fxnegative? fxodd? fxeven? 40 fxmax fxmin 41 fx+ fx- fxneg fx* fxquotient fxremainder fxabs fxsquare fxsqrt 42 fxnot fxand fxior fxxor fxarithmetic-shift 43 fxarithmetic-shift-left fxarithmetic-shift-right 44 fxbit-count fxlength fxif fxbit-set? 45 fxcopy-bit fxfirst-set-bit 46 fxbit-field fxbit-field-rotate fxbit-field-reverse 47 fx+/carry fx-/carry fx*/carry)) 48(select-module srfi-143) 49 50;; We don't do define-constant, for these may differ among platforms 51;; and making them constant would interfere with cross-compilation 52(define fx-width (fixnum-width)) 53(define fx-greatest (greatest-fixnum)) 54(define fx-least (least-fixnum)) 55 56;; fixnum? - builtin 57 58;; In Gauche, using standard operators is the most efficient. 59(define-inline fx=? =) 60(define-inline fx<? <) 61(define-inline fx<=? <=) 62(define-inline fx>? >) 63(define-inline fx>=? >=) 64(define-inline fxzero? zero?) 65(define-inline fxpositive? positive?) 66(define-inline fxnegative? negative?) 67(define-inline fxodd? odd?) 68(define-inline fxeven? even?) 69(define-inline fxmax max) 70(define-inline fxmin min) 71 72(define-inline (fx+ i j) (+ i j)) 73(define-inline (fx- i j) (- i j)) 74(define-inline (fxneg i) (- i)) 75(define-inline (fx* i j) (* i j)) 76(define-inline (fxquotient i j) (quotient i j)) 77(define-inline (fxremainder i j) (remainder i j)) 78(define-inline (fxabs i) (abs i)) 79(define-inline (fxsquare i) (square i)) 80(define-inline (fxsqrt i) (exact-integer-sqrt i)) 81 82(define-inline (fxnot i) (lognot i)) 83(define-inline fxand logand) 84(define-inline fxior logior) 85(define-inline fxxor logxor) 86(define-inline (fxarithmetic-shift i c) (ash i c)) 87(define-inline (fxarithmetic-shift-left i c) (ash i c)) 88(define-inline (fxarithmetic-shift-right i c) (ash i (- c))) 89(define-inline (fxbit-count i) (logcount i)) 90(define-inline (fxlength i) (integer-length i)) 91(define-inline (fxif mask i j) (bitwise-if mask i j)) 92(define-inline (fxbit-set? index i) (logbit? index i)) 93(define-inline (fxcopy-bit index i boolean) (copy-bit index i boolean)) 94(define-inline (fxfirst-set-bit i) (twos-exponent-factor i)) 95(define-inline (fxbit-field i start end) (bit-field i start end)) 96(define-inline (fxbit-field-rotate i count start end) 97 (rotate-bit-field i count start end)) 98(define-inline (fxbit-field-reverse i start end) 99 (reverse-bit-field i start end)) 100 101;; Procedures that require additional definitions 102;; Can be more efficient. 103 104(define *modulo* (%expt 2 (fixnum-width))) 105 106(define (fx+/carry i j k) 107 (let1 v (+ i j k) 108 (receive (q r) (balanced/ v *modulo*) 109 (values r q)))) 110 111(define (fx-/carry i j k) 112 (let1 v (- i j k) 113 (receive (q r) (balanced/ v *modulo*) 114 (values r q)))) 115 116(define (fx*/carry i j k) 117 (let1 v (+ (* i j) k) 118 (receive (q r) (balanced/ v *modulo*) 119 (values r q)))) 120 121 122 123 124 125