tmtt/chez-openbsd
Archived
1
0
Fork 0
Code Issues Pull requests Releases 1 Activity
This repository has been archived on 2022-08-10. You can view files and clone it, but cannot push or open issues or pull requests.
chez-openbsd/mats/5_3.ms

7075 lines
256 KiB
Scheme
Raw Normal View History

feat: 9.5.9
2022-07-29 15:12:07 +02:00
;;; 5_3.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define interesting-numbers
(list 0 0.0 1 1.0 -1 -1.0 9007199254740992 9007199254740992.0 9007199254740993.0 9007199254740993 9007199254740992000 9007199254740992000.0 9007199254740993000.0 9007199254740993000 4.5035996273704996e-13 4.5035996273704994e-13 45035996273704996/100000000000000000000000000000 45035996273704994/100000000000000000000000000000))
(define-syntax test-transitive
(syntax-rules ()
[(_ ?op ?x ?y ?z)
(let ([x ?x][y ?y][z ?z])
(let ([xy (?op x y)]
[yz (?op y z)])
(if (and xy yz)
(and (?op x z)
(?op x y z))
#t)))]))
(define (test-transitive-permutations op)
(andmap (lambda (x)
(andmap (lambda (y)
(andmap (lambda (z)
(test-transitive op x y z))
interesting-numbers))
interesting-numbers))
interesting-numbers))
(mat number-syntax
(eqv? 0 (- (most-positive-fixnum) (most-positive-fixnum)))
(eqv? 3 (1+ (1+ (1+ 0))))
(eqv? 9 (* 3 3))
(eqv? 27 (* 3 9))
(eqv? +99 99)
(eqv? -99 (- 99))
(eqv? -19683 (expt -27 3))
(eqv? #e32 32)
(eqv? #E-32 -32)
(eqv? #12r-3b -47)
(eqv? #12R3b 47)
(eqv? #i+32 (inexact 32))
(eqv? #I32 (inexact 32))
(eqv? #b+101 5)
(eqv? #B-101 -5)
(eqv? #o-75 -61)
(eqv? #O75 61)
(eqv? #d91 91)
(eqv? #D-91 -91)
(eqv? #x-7f -127)
(eqv? #X+7f 127)
(eqv? #e#x-1e -30)
(eqv? #i321 (inexact 321))
(eqv? #i#b011 (inexact 3))
(eqv? #e#o-76 -62)
(eqv? #e#D+29 29)
(eqv? #e#x-abcd -43981)
(eqv? #i#32r+21 (inexact 65))
(eqv? #i#32R-21 (inexact -65))
(eqv? #20r#e10 20)
(eqv? #x#iabc (inexact 2748))
(eqv? .321
(inexact (/ 321 1000)))
(eqv? -20/317
(/ 20 -317))
(symbol? 'a)
(symbol? '+)
(eqv? +.91 .91)
(eqv? -.257 (- .257))
(symbol? '-a)
(eqv? 98.21
(* .9821 100))
(eqv? 98## 9800.0)
(eqv? #e98## 9800)
(eqv? 27e10 270000000000.0)
(fl~= -1e-9 (- (/ 1e9)))
(fl~= -1e-30 (- (/ 1e30)))
(eqv? #e27e10 270000000000)
(symbol? '1+)
(eqv? 23. (inexact 23))
(eqv? #e23. 23)
(eqv? 2.e3 2000.)
(eqv? 2s3 2000.)
(eqv? 2.0f3 2000.)
(eqv? 2.###d3 2000.)
(eqv? 2#.#l2 2000.)
(eqv? 2/1E3 2000.)
(eqv? 1/5S4 2000.)
(eqv? -1/5F4 -2000.)
(eqv? .2D4 2000.)
(eqv? 1##/5##L4 2000.)
(symbol? '2.a)
(eqv? 21#/2## (inexact 21/20))
(symbol? '21##.321)
(eqv? 21##e-2 21.)
(symbol? '98##9)
(symbol? '32/)
(symbol? '32/#)
(eqv? #i32/7 (inexact 32/7))
(symbol? '32/23#0)
(symbol? '...)
(eqv? #e.231 231/1000)
(eqv? #e.231## 231/1000)
(eqv? #e21##.#### 2100)
(symbol? '.231.)
(eqv? 2.3#E-2 .023)
(symbol? '-2.3e)
(eqv? #I#10r-32############.#e-12
-32.0)
(symbol? '-2/3ex)
(symbol? '2.1e-)
(symbol? '2e-1.0i)
(eqv? #e2/3e4 20000/3)
(symbol? '2.0e10a)
(eqv? +1.0i (make-rectangular 0 1.0))
(eqv? -1.0i (make-rectangular 0.0 -1))
(eqv? +1i (make-rectangular 0 1))
(eqv? -1i (make-rectangular 0 -1))
(symbol? 'i)
(eqv? -221.0i (make-rectangular 0.0 -221))
(eqv? +201.0i (make-rectangular 0.0 201))
(symbol? '201i)
(eqv? 3.0+1.0i (make-rectangular 3 1.0))
(eqv? -3-1.0i (make-rectangular -3.0 -1))
(eqv? 3.2-2/3i (make-rectangular 3.2 (inexact -2/3)))
(eqv? 1/2@1/3 (make-polar 1/2 1/3))
(eqv? 3+1i (make-rectangular 3 1))
(eqv? -3-1i (make-rectangular -3 -1))
(eqv? 3/2-2/3i (make-rectangular 3/2 -2/3))
(symbol? '2@3@4)
(symbol? '2@3+4i)
; check for float read bug introduced into 3.0:
(< -.039 -.038413 -.038)
)
(mat string->number
; error cases
(error? (string->number 'a))
(error? (string->number "a" 0))
(error? (string->number "a" 37))
(error? (string->number "a" 'a))
(error? (string->number "a" 10 10))
; one argument case
(not (string->number ""))
(eqv? (string->number "0") (- (most-positive-fixnum) (most-positive-fixnum)))
(eqv? (string->number "3") (1+ (1+ (1+ (string->number "0")))))
(eqv? (string->number "9") (* (string->number "3") (string->number "3")))
(eqv? (string->number "27") (* (string->number "3") (string->number "9")))
(eqv? (string->number "+99") (string->number "99"))
(eqv? (string->number "-99") (- (string->number "99")))
(eqv? (string->number "-19683") (expt (string->number "-27") 3))
(eqv? (string->number "#e32") (string->number "32"))
(eqv? (string->number "#E-32") (string->number "-32"))
(not (string->number "#"))
(eqv? (string->number "#12r-3b") (string->number "-47"))
(eqv? (string->number "#12R3b") (string->number "47"))
(eqv? (string->number "#i+32") (inexact (string->number "32")))
(eqv? (string->number "#I32") (inexact (string->number "32")))
(eqv? (string->number "#b+101") (string->number "5"))
(eqv? (string->number "#B-101") (string->number "-5"))
(eqv? (string->number "#o-75") (string->number "-61"))
(eqv? (string->number "#O75") (string->number "61"))
(eqv? (string->number "#d91") (string->number "91"))
(eqv? (string->number "#D-91") (string->number "-91"))
(eqv? (string->number "#x-7f") (string->number "-127"))
(eqv? (string->number "#X+7f") (string->number "127"))
(not (string->number "#a"))
(not (string->number "#32"))
(not (string->number "#32="))
(not (string->number "#47r0"))
(not (string->number "#110r0"))
(not (string->number "#e"))
(eqv? (string->number "#e#x-1e") (string->number "-30"))
(eqv? (string->number "#i321") (inexact (string->number "321")))
(not (string->number "#e#"))
(eqv? (string->number "#i#b011") (inexact (string->number "3")))
(eqv? (string->number "#e#o-76") (string->number "-62"))
(eqv? (string->number "#e#D+29") (string->number "29"))
(eqv? (string->number "#e#x-abcd") (string->number "-43981"))
(not (string->number "#e#*"))
(not (string->number "#i#32"))
(eqv? (string->number "#i#32r+21") (inexact (string->number "65")))
(eqv? (string->number "#i#32R-21") (inexact (string->number "-65")))
(not (string->number "#i#321r"))
(not (string->number "#e#39r"))
(not (string->number "#20r"))
(eqv? (string->number "#20r#e10") (string->number "20"))
(not (string->number "#20r#"))
(eqv? (string->number "#x#iabc") (inexact (string->number "2748")))
(not (string->number "#x##"))
(not (string->number "#e#x"))
(eqv? (string->number ".321")
(inexact (/ (string->number "321") (string->number "1000"))))
(eqv? (string->number "-20/317")
(/ (string->number "20") (string->number "-317")))
(not (string->number "a"))
(not (string->number "+"))
(eqv? (string->number "+.91") (string->number ".91"))
(eqv? (string->number "-.257") (- (string->number ".257")))
(not (string->number "-a"))
(eqv? (string->number "98.21")
(* (string->number ".9821") (string->number "100")))
(eqv? (string->number "98##") (string->number "9800.0"))
(eqv? (string->number "#e98##") (string->number "9800"))
(eqv? (string->number "27e10") (string->number "270000000000.0"))
(eqv? (string->number "#e27e10") (string->number "270000000000"))
(not (string->number "1+"))
(eqv? (string->number "23.") (inexact (string->number "23")))
(eqv? (string->number "#e23.") (string->number "23"))
(eqv? (string->number "2.e3") (string->number "2000."))
(eqv? (string->number "2s3") (string->number "2000."))
(eqv? (string->number "2.0f3") (string->number "2000."))
(eqv? (string->number "2.###d3") (string->number "2000."))
(eqv? (string->number "2#.#l2") (string->number "2000."))
(eqv? (string->number "2/1E3") (string->number "2000."))
(eqv? (string->number "1/5S4") (string->number "2000."))
(eqv? (string->number "-1/5F4") (string->number "-2000."))
(eqv? (string->number ".2D4") (string->number "2000."))
(eqv? (string->number "1##/5##L4") (string->number "2000."))
(not (string->number "2.a"))
(eqv? (string->number "21#/2##") (inexact (string->number "21/20")))
(not (string->number "21##.321"))
(eqv? (string->number "21##e-2") (string->number "21."))
(not (string->number "98##9"))
(not (string->number "32/"))
(not (string->number "32/#"))
(eqv? (string->number "#i32/7") (inexact (string->number "32/7")))
(not (string->number "32/23#0"))
(not (string->number "."))
(not (string->number "..."))
(eqv? (string->number "#e.231") (string->number "231/1000"))
(eqv? (string->number "#e.231##") (string->number "231/1000"))
(eqv? (string->number "#e21##.####") (string->number "2100"))
(not (string->number ".231."))
(eqv? (string->number "2.3#E-2") (string->number ".023"))
(not (string->number "-2.3e"))
(eqv? (string->number "#I#10r-32############.#e-12")
(string->number "-32.0"))
(not (string->number "-2/3ex"))
(not (string->number "2.1e-"))
(not (string->number "2e-i"))
(eqv? (string->number "#e2/3e4") (string->number "20000/3"))
(not (string->number "2.0e10a"))
; complex cases
(equal? (string->number "+i") +i)
(equal? (string->number "-i") -i)
(not (string->number "i"))
(equal? (string->number "-221i") -221i)
(equal? (string->number "+201i") +201i)
(not (string->number "201i"))
(equal? (string->number "3+i") 3+i)
(equal? (string->number "-3+i") -3+i)
(equal? (string->number "3.2-2/3i") 3.2-2/3i)
(equal? (string->number "1/2@1/2") 1/2@1/2)
(not (string->number "2@3@4"))
(not (string->number "2@3+4i"))
; two argument case
(eqv? (string->number "+101" 2) (string->number "5"))
(eqv? (string->number "#B-101" 7) (string->number "-5"))
(eqv? (string->number "-75" 8) (string->number "-61"))
(eqv? (string->number "#O75" 10) (string->number "61"))
(eqv? (string->number "91" 10) (string->number "91"))
(eqv? (string->number "#D-91" 16) (string->number "-91"))
(eqv? (string->number "-7f" 16) (string->number "-127"))
(eqv? (string->number "#X+7f" 35) (string->number "127"))
(eqv? (string->number "22" 35) (string->number "72"))
(eqv? (string->number "#35r22" 17) (string->number "72"))
; getting division by zero right
(eqv? (string->number "0/0") #f)
(== (string->number "0/0#") +nan.0)
(eqv? (string->number "0#/0") #f)
(== (string->number "0/0e20") +nan.0)
(== (string->number "0/0#e20") +nan.0)
(== (string->number "0#/0#") +nan.0)
(== (string->number "#i0/0") +nan.0)
(== (string->number "#i0/0#") +nan.0)
(== (string->number "#i0#/0") +nan.0)
(== (string->number "#i0#/0#") +nan.0)
(== (string->number "#i0/0e20") +nan.0)
(== (string->number "#i0/0#e20") +nan.0)
(eqv? (string->number "#e0/0") #f)
(eqv? (string->number "#e0/0#") #f)
(eqv? (string->number "#e0#/0") #f)
(eqv? (string->number "#e0#/0#") #f)
(eqv? (string->number "#e0/0e20") #f)
(eqv? (string->number "#e0/0#e20") #f)
(eqv? (string->number "1/0") #f)
(eqv? (string->number "1/0#") +inf.0)
(eqv? (string->number "1#/0") #f)
(eqv? (string->number "1#/0#") +inf.0)
(eqv? (string->number "#i1/0") +inf.0)
(eqv? (string->number "#i1/0#") +inf.0)
(eqv? (string->number "#i1#/0") +inf.0)
(eqv? (string->number "#i1#/0#") +inf.0)
(eqv? (string->number "#e1/0") #f)
(eqv? (string->number "#e1/0#") #f)
(eqv? (string->number "#e1#/0") #f)
(eqv? (string->number "#e1#/0#") #f)
(eqv? (string->number "1/0+1.0i") #f)
(eqv? (string->number "1.0+1/0i") #f)
(== (string->number "1/0###+0/0###i") +inf.0+nan.0i)
(== (string->number "0/0###+1/0###i") +nan.0+inf.0i)
(== (string->number "0###/0###+1/0###i") +nan.0+inf.0i)
(eqv? (string->number "#e1e1000") (expt 10 1000))
(eqv? (string->number "#e1#e1000") (expt 10 1001))
; same set, with minus signs
(eqv? (string->number "-0/0") #f)
(== (string->number "-0/0#") +nan.0)
(eqv? (string->number "-0#/0") #f)
(== (string->number "-0#/0#") +nan.0)
(== (string->number "#i-0/0") +nan.0)
(== (string->number "#i-0/0#") +nan.0)
(== (string->number "#i-0#/0") +nan.0)
(== (string->number "#i-0#/0#") +nan.0)
(eqv? (string->number "#e-0/0") #f)
(eqv? (string->number "#e-0/0#") #f)
(eqv? (string->number "#e-0#/0") #f)
(eqv? (string->number "#e-0#/0#") #f)
(eqv? (string->number "-1/0") #f)
(eqv? (string->number "-1/0#") -inf.0)
(eqv? (string->number "-1#/0") #f)
(eqv? (string->number "-1#/0#") -inf.0)
(eqv? (string->number "#i-1/0") -inf.0)
(eqv? (string->number "#i-1/0#") -inf.0)
(eqv? (string->number "#i-1#/0") -inf.0)
(eqv? (string->number "#i-1#/0#") -inf.0)
(eqv? (string->number "#e-1/0") #f)
(eqv? (string->number "#e-1/0#") #f)
(eqv? (string->number "#e-1#/0") #f)
(eqv? (string->number "#e-1#/0#") #f)
(eqv? (string->number "-1/0+1.0i") #f)
(eqv? (string->number "1.0-1/0i") #f)
(== (string->number "-1/0###-0/0###i") -inf.0+nan.0i)
(== (string->number "-0/0###-1/0###i") +nan.0-inf.0i)
(== (string->number "-0###/0###-1/0###i") +nan.0-inf.0i)
(eqv? (string->number "#e-1e1000") (- (expt 10 1000)))
(eqv? (string->number "#e-1#e1000") (- (expt 10 1001)))
; same set, with plus signs
(eqv? (string->number "+0/0") #f)
(== (string->number "+0/0#") +nan.0)
(eqv? (string->number "+0#/0") #f)
(== (string->number "+0#/0#") +nan.0)
(== (string->number "#i+0/0") +nan.0)
(== (string->number "#i+0/0#") +nan.0)
(== (string->number "#i+0#/0") +nan.0)
(== (string->number "#i+0#/0#") +nan.0)
(eqv? (string->number "#e+0/0") #f)
(eqv? (string->number "#e+0/0#") #f)
(eqv? (string->number "#e+0#/0") #f)
(eqv? (string->number "#e+0#/0#") #f)
(eqv? (string->number "+1/0") #f)
(eqv? (string->number "+1/0#") +inf.0)
(eqv? (string->number "+1#/0") #f)
(eqv? (string->number "+1#/0#") +inf.0)
(eqv? (string->number "#i+1/0") +inf.0)
(eqv? (string->number "#i+1/0#") +inf.0)
(eqv? (string->number "#i+1#/0") +inf.0)
(eqv? (string->number "#i+1#/0#") +inf.0)
(eqv? (string->number "#e+1/0") #f)
(eqv? (string->number "#e+1/0#") #f)
(eqv? (string->number "#e+1#/0") #f)
(eqv? (string->number "#e+1#/0#") #f)
(eqv? (string->number "+1/0+1.0i") #f)
(eqv? (string->number "1.0+1/0i") #f)
(== (string->number "+1/0###+0/0###i") +inf.0+nan.0i)
(== (string->number "+0/0###+1/0###i") +nan.0+inf.0i)
(== (string->number "+0###/0###+1/0###i") +nan.0+inf.0i)
(eqv? (string->number "#e+1e1000") (expt 10 1000))
(eqv? (string->number "#e+1#e1000") (expt 10 1001))
; misc. similar tests
(eqv? (string->number "1/0000") #f)
(eqv? (string->number "-1/0000") #f)
(eqv? (string->number "#e-1/0000") #f)
(eqv? (string->number "#i-1/0000") -inf.0)
(eqv? (string->number "#e1/0###") #f)
(eqv? (string->number "#e-1/0###") #f)
(eqv? (string->number "1/0###") +inf.0)
(eqv? (string->number "-1/0###") -inf.0)
(eqv? (string->number "1###/0") #f)
(eqv? (string->number "-1###/0") #f)
(eqv? (string->number "-1###/0###") -inf.0)
(eqv? (string->number "0/0000") #f)
(eqv? (string->number "-0/0000") #f)
(eqv? (string->number "#e-0/0000") #f)
(== (string->number "#i-0/0000") +nan.0)
(eqv? (string->number "#e0/0###") #f)
(eqv? (string->number "#e-0/0###") #f)
(== (string->number "0/0###") +nan.0)
(== (string->number "-0/0###") +nan.0)
(== (string->number "0/0e10") +nan.0)
(== (string->number "#i0/0e10") +nan.0)
(== (string->number "0/0###e10") +nan.0)
(eqv? (string->number "1/0e10") +inf.0)
(eqv? (string->number "#i1/0e10") +inf.0)
(eqv? (string->number "1/0###e10") +inf.0)
(eqv? (string->number "-1/0e10") -inf.0)
(eqv? (string->number "#i-1/0e10") -inf.0)
(eqv? (string->number "-1/0###e10") -inf.0)
(eqv? (string->number "-1/2e10000") -inf.0)
(eqv? (string->number "1/2e10000") +inf.0)
(eqv? (string->number "#e-1/2e10000") (* -1/2 (expt 10 10000)))
(eqv? (string->number "#e1/2e10000") (* 1/2 (expt 10 10000)))
(eqv? (string->number "0e25") 0.0)
(eqv? (string->number "-0e25") -0.0)
(eqv? (string->number "0/1e25") 0.0)
(eqv? (string->number "-0/1e25") -0.0)
; can't have no exact nans and infinities
(eqv? (string->number "#e+nan.0") #f)
(eqv? (string->number "#e+inf.0") #f)
(eqv? (string->number "#e-inf.0") #f)
; don't make no sense
(eqv? (string->number "3@4i") #f)
(eqv? (string->number "3@-i") #f)
; zero with large exponent
(eqv? (string->number "0.0e3000") 0.0)
(eqv? (string->number "-0.0e3000") -0.0)
; exact polar complex numbers. r6rs says anything w/o radix point, exponent sign, or precision is exact.
; we also include polar numbers w/o #e prefix that can't be represented exactly
(eqv? (string->number "0@0") 0)
(eqv? (string->number "1@0") 1)
(eqv? (string->number "0@1") 0)
(eqv? (string->number "1@1") (string->number "1.0@1.0"))
(not (string->number "#e1@1"))
(eqv? (string->number "#i1@1") (make-polar 1.0 1.0))
(eqv? (string->number "1.0@1") (make-polar 1.0 1.0))
(eqv? (string->number "1@1.0") (make-polar 1.0 1.0))
(eqv? (string->number "1.0@1.0") (make-polar 1.0 1.0))
; filling in some cases shown missing by profiling
(eqv? (string->number "1e-5000000000") 0.0)
(eqv? (string->number "-1e-5000000000") -0.0)
(eqv? (string->number "#e0e2000") 0)
(eqv? (string->number "#e0e-2000") 0)
(eqv? (string->number "1/0@5") #f)
(eqv? (string->number "1/0+5") #f)
(eqv? (string->number "#e1e20@0") (expt 10 20))
(eqv? (string->number "+1/0+5i") #f)
(eqv? (string->number "-1/0+5i") #f)
(eqv? (string->number "+1/0i") #f)
(eqv? (string->number "-1/0i") #f)
(eqv? (string->number "#e+inf.0+1i") #f)
(eqv? (string->number "1|21") 1.0)
(eqv? (string->number "1.5|21") 1.5)
(eqv? (string->number "1.5e2|21") 150.)
(eqv? (string->number "1.5e2|21+2i") 150.0+2.0i)
(eqv? (string->number "1.5e2|") #f)
(eqv? (string->number "1.5e2@") #f)
(eqv? (string->number "1.5e2@.5") (make-polar 1.5e2 .5))
(eqv? (string->number "1.5e2@+.5") (make-polar 1.5e2 .5))
(eqv? (string->number "1.5e2@-.5") (make-polar 1.5e2 -.5))
(eqv? (string->number "+in") #f)
(eqv? (string->number "+inf") #f)
(eqv? (string->number "+inf.") #f)
(eqv? (string->number "-in") #f)
(eqv? (string->number "-inf") #f)
(eqv? (string->number "-inf.") #f)
(eqv? (string->number "+n") #f)
(eqv? (string->number "+na") #f)
(eqv? (string->number "+nan") #f)
(eqv? (string->number "+nan.") #f)
(eqv? (string->number "-n") #f)
(eqv? (string->number "-na") #f)
(eqv? (string->number "-nan") #f)
(eqv? (string->number "-nan.") #f)
)
(mat r6rs:string->number
; error cases
(error? (r6rs:string->number 'a))
(error? (r6rs:string->number "a" 0))
(error? (r6rs:string->number "a" 37))
(error? (r6rs:string->number "a" 3))
(error? (r6rs:string->number "a" 4))
(error? (r6rs:string->number "a" 12))
(error? (r6rs:string->number "a" 20))
(error? (r6rs:string->number "a" 32))
(error? (r6rs:string->number "a" 36))
(error? (r6rs:string->number "a" 'a))
(error? (r6rs:string->number "a" 10 10))
; r6rs number syntax doesn't have # digits
(not (r6rs:string->number "-1/0###e10"))
(not (r6rs:string->number "1###"))
(not (r6rs:string->number "1/3###"))
(not (r6rs:string->number "1.3###"))
(not (r6rs:string->number ".1###"))
(not (r6rs:string->number "1#e17"))
(not (r6rs:string->number "98##"))
(not (r6rs:string->number "#e98##"))
(not (r6rs:string->number "#12r-3b"))
(not (r6rs:string->number "#12R3b"))
(not (r6rs:string->number "#i#32r+21"))
(not (r6rs:string->number "#i#32R-21"))
(not (r6rs:string->number "#20r#e10"))
(not (r6rs:string->number "2.###d3"))
(not (r6rs:string->number "2#.#l2"))
(not (r6rs:string->number "1##/5##L4"))
(not (r6rs:string->number "21#/2##"))
(not (r6rs:string->number "21##e-2"))
(not (r6rs:string->number "#e.231##"))
(not (r6rs:string->number "#e21##.####"))
(not (r6rs:string->number "2.3#E-2"))
(not (r6rs:string->number "#I#10r-32############.#e-12"))
; one argument case
(not (r6rs:string->number ""))
(eqv? (r6rs:string->number "0") (- (most-positive-fixnum) (most-positive-fixnum)))
(eqv? (r6rs:string->number "3") (1+ (1+ (1+ (string->number "0")))))
(eqv? (r6rs:string->number "9") (* (string->number "3") (string->number "3")))
(eqv? (r6rs:string->number "27") (* (string->number "3") (string->number "9")))
(eqv? (r6rs:string->number "+99") (string->number "99"))
(eqv? (r6rs:string->number "-99") (- (string->number "99")))
(eqv? (r6rs:string->number "-19683") (expt (string->number "-27") 3))
(eqv? (r6rs:string->number "#e32") (string->number "32"))
(eqv? (r6rs:string->number "#E-32") (string->number "-32"))
(not (r6rs:string->number "#"))
(eqv? (r6rs:string->number "#i+32") (inexact (string->number "32")))
(eqv? (r6rs:string->number "#I32") (inexact (string->number "32")))
(eqv? (r6rs:string->number "#b+101") (string->number "5"))
(eqv? (r6rs:string->number "#B-101") (string->number "-5"))
(eqv? (r6rs:string->number "#o-75") (string->number "-61"))
(eqv? (r6rs:string->number "#O75") (string->number "61"))
(eqv? (r6rs:string->number "#d91") (string->number "91"))
(eqv? (r6rs:string->number "#D-91") (string->number "-91"))
(eqv? (r6rs:string->number "#x-7f") (string->number "-127"))
(eqv? (r6rs:string->number "#X+7f") (string->number "127"))
(not (r6rs:string->number "#a"))
(not (r6rs:string->number "#32"))
(not (r6rs:string->number "#32="))
(not (r6rs:string->number "#47r0"))
(not (r6rs:string->number "#110r0"))
(not (r6rs:string->number "#e"))
(eqv? (r6rs:string->number "#e#x-1e") (string->number "-30"))
(eqv? (r6rs:string->number "#i321") (inexact (string->number "321")))
(not (r6rs:string->number "#e#"))
(eqv? (r6rs:string->number "#i#b011") (inexact (string->number "3")))
(eqv? (r6rs:string->number "#e#o-76") (string->number "-62"))
(eqv? (r6rs:string->number "#e#D+29") (string->number "29"))
(eqv? (r6rs:string->number "#e#x-abcd") (string->number "-43981"))
(not (r6rs:string->number "#e#*"))
(not (r6rs:string->number "#i#32"))
(not (r6rs:string->number "#i#321r"))
(not (r6rs:string->number "#e#39r"))
(not (r6rs:string->number "#20r"))
(not (r6rs:string->number "#20r#"))
(eqv? (r6rs:string->number "#x#iabc") (inexact (string->number "2748")))
(not (r6rs:string->number "#x##"))
(not (r6rs:string->number "#e#x"))
(eqv? (r6rs:string->number ".321")
(inexact (/ (r6rs:string->number "321") (string->number "1000"))))
(eqv? (r6rs:string->number "-20/317")
(/ (r6rs:string->number "20") (string->number "-317")))
(not (r6rs:string->number "a"))
(not (r6rs:string->number "+"))
(eqv? (r6rs:string->number "+.91") (string->number ".91"))
(eqv? (r6rs:string->number "-.257") (- (string->number ".257")))
(not (r6rs:string->number "-a"))
(eqv? (r6rs:string->number "98.21")
(* (r6rs:string->number ".9821") (string->number "100")))
(eqv? (r6rs:string->number "27e10") (string->number "270000000000.0"))
(eqv? (r6rs:string->number "#e27e10") (string->number "270000000000"))
(not (r6rs:string->number "1+"))
(eqv? (r6rs:string->number "23.") (inexact (string->number "23")))
(eqv? (r6rs:string->number "#e23.") (string->number "23"))
(eqv? (r6rs:string->number "2.e3") (string->number "2000."))
(eqv? (r6rs:string->number "2s3") (string->number "2000."))
(eqv? (r6rs:string->number "2.0f3") (string->number "2000."))
(eqv? (r6rs:string->number "2/1E3") #f)
(eqv? (r6rs:string->number "1/5S4") #f)
(eqv? (r6rs:string->number "-1/5F4") #f)
(eqv? (r6rs:string->number ".2D4") (string->number "2000."))
(not (r6rs:string->number "2.a"))
(not (r6rs:string->number "21##.321"))
(not (r6rs:string->number "98##9"))
(not (r6rs:string->number "32/"))
(not (r6rs:string->number "32/#"))
(eqv? (r6rs:string->number "#i32/7") (inexact (string->number "32/7")))
(not (r6rs:string->number "32/23#0"))
(not (r6rs:string->number "."))
(not (r6rs:string->number "..."))
(eqv? (r6rs:string->number "#e.231") (string->number "231/1000"))
(not (r6rs:string->number ".231."))
(not (r6rs:string->number "-2.3e"))
(not (r6rs:string->number "-2/3ex"))
(not (r6rs:string->number "2.1e-"))
(not (r6rs:string->number "2e-i"))
(eqv? (r6rs:string->number "#e2/3e4") #f)
(not (r6rs:string->number "2.0e10a"))
; complex cases
(equal? (r6rs:string->number "+i") +i)
(equal? (r6rs:string->number "-i") -i)
(not (r6rs:string->number "i"))
(equal? (r6rs:string->number "-221i") -221i)
(equal? (r6rs:string->number "+201i") +201i)
(not (r6rs:string->number "201i"))
(equal? (r6rs:string->number "3+i") 3+i)
(equal? (r6rs:string->number "-3+i") -3+i)
(equal? (r6rs:string->number "3.2-2/3i") 3.2-2/3i)
(equal? (r6rs:string->number "1/2@1/2") 1/2@1/2)
(not (r6rs:string->number "2@3@4"))
(not (r6rs:string->number "2@3+4i"))
; two argument case
(eqv? (r6rs:string->number "+101" 2) (string->number "5"))
(eqv? (r6rs:string->number "-75" 8) (string->number "-61"))
(eqv? (r6rs:string->number "#O75" 10) (string->number "61"))
(eqv? (r6rs:string->number "91" 10) (string->number "91"))
(eqv? (r6rs:string->number "#D-91" 16) (string->number "-91"))
(eqv? (r6rs:string->number "-7f" 16) (string->number "-127"))
; getting division by zero right
(eqv? (r6rs:string->number "0/0") #f)
(== (r6rs:string->number "#i0/0") +nan.0)
(eqv? (r6rs:string->number "#e0/0") #f)
(eqv? (r6rs:string->number "1/0") #f)
(eqv? (r6rs:string->number "1#/0") #f)
(eqv? (r6rs:string->number "#i1/0") +inf.0)
(eqv? (r6rs:string->number "#e1/0") #f)
(eqv? (r6rs:string->number "1/0+1.0i") #f)
(eqv? (r6rs:string->number "1.0+1/0i") #f)
(eqv? (r6rs:string->number "#e1e1000") (expt 10 1000))
; same set, with minus signs
(eqv? (r6rs:string->number "-0/0") #f)
(== (r6rs:string->number "#i-0/0") +nan.0)
(eqv? (r6rs:string->number "#e-0/0") #f)
(eqv? (r6rs:string->number "-1/0") #f)
(eqv? (r6rs:string->number "#i-1/0") -inf.0)
(eqv? (r6rs:string->number "#e-1/0") #f)
(eqv? (r6rs:string->number "-1/0+1.0i") #f)
(eqv? (r6rs:string->number "1.0-1/0i") #f)
(eqv? (r6rs:string->number "#e-1e1000") (- (expt 10 1000)))
; same set, with plus signs
(eqv? (r6rs:string->number "+0/0") #f)
(== (r6rs:string->number "#i+0/0") +nan.0)
(eqv? (r6rs:string->number "#e+0/0") #f)
(eqv? (r6rs:string->number "+1/0") #f)
(eqv? (r6rs:string->number "#i+1/0") +inf.0)
(eqv? (r6rs:string->number "#e+1/0") #f)
(eqv? (r6rs:string->number "+1/0+1.0i") #f)
(eqv? (r6rs:string->number "1.0+1/0i") #f)
(eqv? (r6rs:string->number "#e+1e1000") (expt 10 1000))
; misc. similar tests
(eqv? (r6rs:string->number "1/0000") #f)
(eqv? (r6rs:string->number "-1/0000") #f)
(eqv? (r6rs:string->number "#e-1/0000") #f)
(eqv? (r6rs:string->number "#i-1/0000") -inf.0)
(eqv? (r6rs:string->number "0/0000") #f)
(eqv? (r6rs:string->number "-0/0000") #f)
(eqv? (r6rs:string->number "#e-0/0000") #f)
(== (r6rs:string->number "#i-0/0000") +nan.0)
(eqv? (r6rs:string->number "0/0e10") #f)
(eqv? (r6rs:string->number "#i0/0e10") #f)
(eqv? (r6rs:string->number "#e0/0e10") #f)
(eqv? (r6rs:string->number "1/0e10") #f)
(eqv? (r6rs:string->number "#i1/0e10") #f)
(eqv? (r6rs:string->number "#e1/0e10") #f)
(eqv? (r6rs:string->number "-1/0e10") #f)
(eqv? (r6rs:string->number "#i-1/0e10") #f)
(eqv? (r6rs:string->number "#e-1/0e10") #f)
(eqv? (r6rs:string->number "-1/2e10000") #f)
(eqv? (r6rs:string->number "1/2e10000") #f)
(eqv? (r6rs:string->number "#e-1/2e10000") #f)
(eqv? (r6rs:string->number "#e1/2e10000") #f)
(eqv? (r6rs:string->number "0e25") 0.0)
(eqv? (r6rs:string->number "-0e25") -0.0)
(eqv? (r6rs:string->number "0/1e25") #f)
(eqv? (r6rs:string->number "-0/1e25") #f)
; can't have no exact nans and infinities
(eqv? (r6rs:string->number "#e+nan.0") #f)
(eqv? (r6rs:string->number "#e+inf.0") #f)
(eqv? (r6rs:string->number "#e-inf.0") #f)
; don't make no sense
(eqv? (r6rs:string->number "3@4i") #f)
(eqv? (r6rs:string->number "3@-i") #f)
; filling in some cases shown missing by profiling
(eqv? (r6rs:string->number "1e-5000000000") 0.0)
(eqv? (r6rs:string->number "-1e-5000000000") -0.0)
(eqv? (r6rs:string->number "#e0e2000") 0)
(eqv? (r6rs:string->number "#e0e-2000") 0)
(eqv? (r6rs:string->number "1/0@5") #f)
(eqv? (r6rs:string->number "1/0+5") #f)
(eqv? (r6rs:string->number "#e1e20@0") (expt 10 20))
(eqv? (r6rs:string->number "+1/0+5i") #f)
(eqv? (r6rs:string->number "-1/0+5i") #f)
(eqv? (r6rs:string->number "+1/0i") #f)
(eqv? (r6rs:string->number "-1/0i") #f)
(eqv? (r6rs:string->number "#e+inf.0+1i") #f)
(eqv? (r6rs:string->number "1|21") 1.0)
(eqv? (r6rs:string->number "1.5|21") 1.5)
(eqv? (r6rs:string->number "1.5e2|21") 150.)
(eqv? (r6rs:string->number "1.5e2|21+2i") 150.0+2.0i)
(eqv? (r6rs:string->number "1.5e2|") #f)
(eqv? (r6rs:string->number "1.5e2@") #f)
(eqv? (r6rs:string->number "1.5e2@.5") (make-polar 1.5e2 .5))
(eqv? (r6rs:string->number "1.5e2@+.5") (make-polar 1.5e2 .5))
(eqv? (r6rs:string->number "1.5e2@-.5") (make-polar 1.5e2 -.5))
(eqv? (r6rs:string->number "+in") #f)
(eqv? (r6rs:string->number "+inf") #f)
(eqv? (r6rs:string->number "+inf.") #f)
(eqv? (r6rs:string->number "-in") #f)
(eqv? (r6rs:string->number "-inf") #f)
(eqv? (r6rs:string->number "-inf.") #f)
(eqv? (r6rs:string->number "+n") #f)
(eqv? (r6rs:string->number "+na") #f)
(eqv? (r6rs:string->number "+nan") #f)
(eqv? (r6rs:string->number "+nan.") #f)
(eqv? (r6rs:string->number "-n") #f)
(eqv? (r6rs:string->number "-na") #f)
(eqv? (r6rs:string->number "-nan") #f)
(eqv? (r6rs:string->number "-nan.") #f)
(eqv? (r6rs:string->number "1.0e+5000") +inf.0)
(eqv? (r6rs:string->number "-1.0e+5000") -inf.0)
(eqv? (r6rs:string->number "0@1") 0)
(eqv? (r6rs:string->number "#e1@1") #f)
)
(mat number->string
(error? ; not a number
(number->string 'a))
(error? ; not a number
(number->string 'a 24))
(error? ; not a number
(number->string 'a 16 24))
(error? ; invalid radix
(number->string 0.0 'a))
(error? ; invalid radix
(number->string 0.0 -1))
(error? ; invalid radix
(number->string 0.0 0))
(error? ; invalid radix
(number->string 0.0 1))
(error? ; invalid radix
(number->string 0.0 'a 24))
(error? ; invalid radix
(number->string 0.0 -1 24))
(error? ; invalid radix
(number->string 0.0 0 24))
(error? ; invalid radix
(number->string 0.0 1 24))
(error? ; invalid precision
(number->string 0.0 10 'a))
(error? ; invalid precision
(number->string 0.0 10 0))
(error? ; invalid precision
(number->string 0.0 10 -24))
(error? ; invalid precision
(number->string 0.0 10 (- (most-negative-fixnum) 1)))
(error? ; precision given w/exact number
(number->string 1 10 24))
(equal? (number->string 3) "3")
(equal? (number->string 3/4) "3/4")
(equal? (number->string 3.024) "3.024")
(eqv? (string->number (number->string #i2/3)) #i2/3)
(equal? (number->string 3.000) "3.0")
(equal? (number->string 3.2e20) "3.2e20")
(equal? (number->string 3.2e2) "320.0")
(equal? (number->string 3200000) "3200000")
(equal? (number->string 320000) "320000")
(equal? (number->string 3+4.0i) "3.0+4.0i")
(equal? (number->string 3-4.0i) "3.0-4.0i")
(equal? (number->string 1.003-4i) "1.003-4.0i")
(equal? (number->string 3+4i) "3+4i")
(equal? (number->string 3-4i) "3-4i")
(equal? (number->string (make-rectangular 3.0 4)) "3.0+4.0i")
(equal? (number->string (make-rectangular 3 4.0)) "3.0+4.0i")
(equal? (number->string (make-rectangular 3 4)) "3+4i")
(equal? (number->string 100.5 10 53) "100.5|53")
(equal? (number->string #x100 16) "100")
(equal? (number->string #x100 8) "400")
(equal? (number->string #x100 16) "100")
)
(mat r6rs:number->string
(error? ; not a number
(r6rs:number->string 'a))
(error? ; not a number
(r6rs:number->string 'a 24))
(error? ; not a number
(r6rs:number->string 'a 16 24))
(error? ; invalid radix
(r6rs:number->string 0.0 'a))
(error? ; invalid radix
(r6rs:number->string 0.0 -1))
(error? ; invalid radix
(r6rs:number->string 0.0 0))
(error? ; invalid radix
(r6rs:number->string 0.0 1))
(error? ; invalid radix
(r6rs:number->string 0.0 'a 24))
(error? ; invalid radix
(r6rs:number->string 0.0 -1 24))
(error? ; invalid radix
(r6rs:number->string 0.0 0 24))
(error? ; invalid radix
(r6rs:number->string 0.0 1 24))
(error? ; invalid precision
(r6rs:number->string 0.0 10 'a))
(error? ; invalid precision
(r6rs:number->string 0.0 10 0))
(error? ; invalid precision
(r6rs:number->string 0.0 10 -24))
(error? ; invalid precision
(r6rs:number->string 0.0 10 (- (most-negative-fixnum) 1)))
(error? ; precision given w/exact number
(r6rs:number->string 1 10 24))
(error? ; precision given radix other than 10
(r6rs:number->string 1 16 24))
(equal? (r6rs:number->string 3) "3")
(equal? (r6rs:number->string 3/4) "3/4")
(equal? (r6rs:number->string 3.024) "3.024")
(eqv? (string->number (r6rs:number->string #i2/3)) #i2/3)
(equal? (r6rs:number->string 3.000) "3.0")
(equal? (r6rs:number->string 3.2e20) "3.2e20")
(equal? (r6rs:number->string 3.2e2) "320.0")
(equal? (r6rs:number->string 3200000) "3200000")
(equal? (r6rs:number->string 320000) "320000")
(equal? (r6rs:number->string 3+4.0i) "3.0+4.0i")
(equal? (r6rs:number->string 3-4.0i) "3.0-4.0i")
(equal? (r6rs:number->string 1.003-4i) "1.003-4.0i")
(equal? (r6rs:number->string 3+4i) "3+4i")
(equal? (r6rs:number->string 3-4i) "3-4i")
(equal? (r6rs:number->string (make-rectangular 3.0 4)) "3.0+4.0i")
(equal? (r6rs:number->string (make-rectangular 3 4.0)) "3.0+4.0i")
(equal? (r6rs:number->string (make-rectangular 3 4)) "3+4i")
(equal? (r6rs:number->string 100.5 10 53) "100.5|53")
(equal? (r6rs:number->string #x100 16) "100")
(equal? (r6rs:number->string #x100 8) "400")
(equal? (r6rs:number->string #x100 16) "100")
)
(mat most-positive-fixnum
(procedure? most-positive-fixnum)
(fixnum? (most-positive-fixnum))
(not (bignum? (most-positive-fixnum)))
(fixnum? (1- (most-positive-fixnum)))
(not (bignum? (1- (most-positive-fixnum))))
(not (fixnum? (1+ (most-positive-fixnum))))
(bignum? (1+ (most-positive-fixnum)))
)
(mat most-negative-fixnum
(fixnum? (most-negative-fixnum))
(not (bignum? (most-negative-fixnum)))
(fixnum? (1+ (most-negative-fixnum)))
(not (bignum? (1+ (most-negative-fixnum))))
(not (fixnum? (1- (most-negative-fixnum))))
(bignum? (1- (most-negative-fixnum)))
)
(mat fixnum?
(fixnum? 3)
(fixnum? 18/2)
(fixnum? 1+0i)
(not (fixnum? 23084982309482034820348023423048230482304))
(not (fixnum? 203480234802384/23049821))
(not (fixnum? -3/4))
(fixnum? -1)
(fixnum? 0)
(fixnum? 1)
(fixnum? -12)
(fixnum? (most-positive-fixnum))
(not (fixnum? (1+ (most-positive-fixnum))))
(fixnum? (most-negative-fixnum))
(not (fixnum? (1- (most-negative-fixnum))))
(not (fixnum? 3.5))
(not (fixnum? 1.8e-10))
(not (fixnum? -3e5))
(not (fixnum? -1231.2344))
(not (fixnum? 3+5.0i))
(not (fixnum? 1.8e10@10))
(not (fixnum? -3e5+1.0i))
(not (fixnum? -1.0i))
(not (fixnum? +1.0i))
(not (fixnum? 'a))
(not (fixnum? "hi"))
(not (fixnum? (cons 3 4)))
)
(mat bignum?
(not (bignum? 3))
(not (bignum? 18/2))
(not (bignum? 1+0i))
(bignum? 23084982309482034820348023423048230482304)
(not (bignum? 203480234802384/23049821))
(not (bignum? -3/4))
(not (bignum? -1))
(not (bignum? 0))
(not (bignum? -12))
(not (bignum? (most-positive-fixnum)))
(bignum? (1+ (most-positive-fixnum)))
(not (bignum? (most-negative-fixnum)))
(bignum? (1- (most-negative-fixnum)))
(not (bignum? 3.5))
(not (bignum? 1.8e-10))
(not (bignum? -3e5))
(not (bignum? -1231.2344))
(not (bignum? 3+5.0i))
(not (bignum? 1.8e10@10))
(not (bignum? -3e5+1.0i))
(not (bignum? -1.0i))
(not (bignum? +1.0i))
(not (bignum? 'a))
(not (bignum? "hi"))
(not (bignum? (cons 3 4)))
)
(mat ratnum?
(not (ratnum? 3))
(not (ratnum? 18/2))
(not (ratnum? 1+0i))
(not (ratnum? 23084982309482034820348023423048230482304))
(ratnum? 203480234802384/23049821)
(ratnum? -3/4)
(not (ratnum? -1))
(not (ratnum? 0))
(not (ratnum? -12))
(not (ratnum? 3.5))
(not (ratnum? 1.8e-10))
(not (ratnum? -3e5))
(not (ratnum? -1231.2344))
(not (ratnum? 3+5.0i))
(not (ratnum? 1.8e10@10))
(not (ratnum? -3e5+1.0i))
(not (ratnum? -1.0i))
(not (ratnum? +1.0i))
(not (ratnum? 'a))
(not (ratnum? "hi"))
(not (ratnum? (cons 3 4)))
(not (ratnum? 3/2+2/3i))
)
(mat flonum?
(not (flonum? 3))
(not (flonum? 18/2))
(not (flonum? 1+0i))
(not (flonum? 23084982309482034820348023423048230482304))
(not (flonum? 203480234802384/23049821))
(not (flonum? -3/4))
(not (flonum? -1))
(not (flonum? 0))
(not (flonum? -12))
(flonum? 3.5)
(flonum? 1.8e-10)
(flonum? -3e5)
(flonum? -1231.2344)
(not (flonum? 3+5.0i))
(not (flonum? 1.8e10@10))
(not (flonum? -3e5+1.0i))
(not (flonum? -1.0i))
(not (flonum? +1.0i))
(not (flonum? 'a))
(not (flonum? "hi"))
(not (flonum? (cons 3 4)))
)
(mat exact?
(error? (exact? 'a))
(exact? 1)
(exact? 112310831023012)
(exact? 3/4)
(not (exact? 3.4))
(not (exact? 3+4.0i))
(exact? 3+4i)
(exact? 3+0i)
)
(mat inexact?
(error? (inexact? '()))
(not (inexact? -1))
(not (inexact? -112310831023012))
(not (inexact? 3/4))
(inexact? 3.4)
(inexact? 3+4.0i)
(not (inexact? 3+4i))
(not (inexact? 3+0i))
)
(mat =
(error? (=))
(error? (= 'a))
(error? (= 3 'a))
(error? (= 'a 3))
(error? (= 3 3 'a))
(error? (= 4 3 'a))
(error? (= 'a 3 4))
(error? (= 4 'a 3))
(error? (= 3 4 'a 5))
(= 3 3)
(not (= 3 4))
(= -3 -3)
(not (= -3 -4))
(= -2.3e10 -2.3e10)
(not (= -2.3e10 -2.3e9))
(= 3 3.0)
(not (= 3 2.9))
(= 7/3 7/3)
(not (= 7/3 8/3))
(= 1/2 0.5)
(not (= 1/2 0.4))
(= 2)
(= 1 1.0 1 1.0)
(= 1/2 0.5 1/2 0.5)
(not (= 1 1.1 1 1.0))
(not (= 1/2 0.5 1/3 0.5))
(not (= 1 99999999999999999999999999999))
(not (= -1 99999999999999999999999999999))
(not (= 1 -99999999999999999999999999999))
(not (= -1 -99999999999999999999999999999))
(not (= 99999999999999999999999999999 -99999999999999999999999999999))
(not (= -99999999999999999999999999999 99999999999999999999999999999))
(not (= 99999999999999999999999999999 99999999999999999999999999998))
(not (= 99999999999999999999999999998 99999999999999999999999999999))
(= 99999999999999999999999999999 99999999999999999999999999999)
(= 2.0+1.0i 2.0+1.0i)
(not (= 2.0+1.0i 2.0+1.1i))
(= 2-1/2i 2-1/2i)
(= 2-1/2i 2.0-0.5i)
(test-transitive = 1 1.0 1)
(test-transitive = 1 2 3)
(test-transitive = 1 2 1)
(test-transitive = (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive = 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive = 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations =)
)
(mat <
(error? (<))
(error? (< 'a))
(error? (< 3 'a))
(error? (< 'a 3))
(error? (< 3 4 'a))
(error? (< 4 3 'a))
(error? (< 'a 3 4))
(error? (< 4 'a 3))
(error? (< 3 5 'a 4))
(error? (< 3+1i))
(error? (< 3+1i 4))
(error? (< 2 3+1i))
(error? (< 2 3 3+1i))
(error? (< 3.4+0.0i))
(error? (< 3.4+0.0i 3.5))
(error? (< 3.2 3.4+0.0i))
(error? (< 3.2 3.3 3.4+0.0i))
(not (< 3 3))
(< 3 4)
(not (< -3 -3))
(not (< -3 -4))
(not (< -2.3e10 -2.3e10))
(< -2.3e10 -2.3e9)
(not (< 3 3.0))
(not (< 3 2.9))
(not (< 7/3 7/3))
(< 7/3 8/3)
(not (< 1/2 0.5))
(not (< 1/2 0.4))
(< 1)
(< 1 2 3)
(< 1 2 3 4)
(not (< 1 2 2 4))
(not (< 4 3 2 1))
(not (< 4 2 2 1))
(not (< 1 3 2 4))
(< 1.0 3/2 2 2.5 1000000000023)
(< 1 99999999999999999999999999999)
(< -1 99999999999999999999999999999)
(not (< 1 -99999999999999999999999999999))
(not (< -1 -99999999999999999999999999999))
(not (< 99999999999999999999999999999 -99999999999999999999999999999))
(< -99999999999999999999999999999 99999999999999999999999999999)
(not (< 99999999999999999999999999999 99999999999999999999999999998))
(< 99999999999999999999999999998 99999999999999999999999999999)
(not (< 99999999999999999999999999999 99999999999999999999999999999))
(error? (< 2.0+1.0i 3.0))
(error? (< 2+i 3))
(error? (< 2 3+i))
(guard (c [#t #t]) (< (#3%length (error #f "oops")) 0))
(test-transitive < 1 1.0 1)
(test-transitive < 1 2 3)
(test-transitive < 1 2 1)
(test-transitive < (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive < 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive < 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations <)
)
(mat <=
(error? (<=))
(error? (<= 'a))
(error? (<= 3 'a))
(error? (<= 'a 3))
(error? (<= 3 4 'a))
(error? (<= 4 3 'a))
(error? (<= 'a 3 4))
(error? (<= 4 'a 3))
(error? (<= 3 5 'a 4))
(error? (<= 3+1i))
(error? (<= 3+1i 4))
(error? (<= 2 3+1i))
(error? (<= 2 3 3+1i))
(error? (<= 3.4+0.0i))
(error? (<= 3.4+0.0i 3.5))
(error? (<= 3.2 3.4+0.0i))
(error? (<= 3.2 3.3 3.4+0.0i))
(<= 3 3)
(<= 3 4)
(<= -3 -3)
(not (<= -3 -4))
(<= -2.3e10 -2.3e10)
(<= -2.3e10 -2.3e9)
(<= 3 3.0)
(not (<= 3 2.9))
(<= 7/3 7/3)
(<= 7/3 8/3)
(<= 1/2 0.5)
(not (<= 1/2 0.4))
(<= 1)
(<= 1 2 3)
(<= 1 2 3 4)
(<= 1 2 2 4)
(not (<= 4 3 2 1))
(not (<= 4 2 2 1))
(not (<= 1 3 2 4))
(<= 1.0 3/2 2 2.5 1000000000023)
(<= 1 99999999999999999999999999999)
(<= -1 99999999999999999999999999999)
(not (<= 1 -99999999999999999999999999999))
(not (<= -1 -99999999999999999999999999999))
(not (<= 99999999999999999999999999999 -99999999999999999999999999999))
(<= -99999999999999999999999999999 99999999999999999999999999999)
(not (<= 99999999999999999999999999999 99999999999999999999999999998))
(<= 99999999999999999999999999998 99999999999999999999999999999)
(<= 99999999999999999999999999999 99999999999999999999999999999)
(error? (<= 2.0+1.0i 3.0))
(error? (<= 2+i 3))
(error? (<= 2 3+i))
(test-transitive <= 1 1.0 1)
(test-transitive <= 1 2 3)
(test-transitive <= 1 2 1)
(test-transitive <= (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive <= 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive <= 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations <=)
)
(mat >
(error? (>))
(error? (> 'a))
(error? (> 3 'a))
(error? (> 'a 3))
(error? (> 3 4 'a))
(error? (> 4 3 'a))
(error? (> 'a 3 4))
(error? (> 4 'a 3))
(error? (> 3 5 'a 4))
(error? (> 3+1i))
(error? (> 3+1i 4))
(error? (> 2 3+1i))
(error? (> 2 3 3+1i))
(error? (> 3.4+0.0i))
(error? (> 3.4+0.0i 3.5))
(error? (> 3.2 3.4+0.0i))
(error? (> 3.2 3.3 3.4+0.0i))
(not (> 3 3))
(not (> 3 4))
(not (> -3 -3))
(> -3 -4)
(not (> -2.3e10 -2.3e10))
(not (> -2.3e10 -2.3e9))
(not (> 3 3.0))
(> 3 2.9)
(not (> 7/3 7/3))
(not (> 7/3 8/3))
(not (> 1/2 0.5))
(> 1/2 0.4)
(> 1)
(> 3 2 1)
(not (> 1 2 3 4))
(not (> 1 2 2 4))
(> 4 3 2 1)
(not (> 4 2 2 1))
(not (> 4 2 3 1))
(> 1000000000023 2.5 2 3/2 1.0)
(not (> 1 99999999999999999999999999999))
(not (> -1 99999999999999999999999999999))
(> 1 -99999999999999999999999999999)
(> -1 -99999999999999999999999999999)
(> 99999999999999999999999999999 -99999999999999999999999999999)
(not (> -99999999999999999999999999999 99999999999999999999999999999))
(> 99999999999999999999999999999 99999999999999999999999999998)
(not (> 99999999999999999999999999998 99999999999999999999999999999))
(not (> 99999999999999999999999999999 99999999999999999999999999999))
(error? (> 2.0+1.0i 3.0))
(error? (> 2+i 3))
(error? (> 2 3+i))
(test-transitive > 1 1.0 1)
(test-transitive > 1 2 3)
(test-transitive > 1 2 1)
(test-transitive > (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive > 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive > 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations >)
)
(mat >=
(error? (>=))
(error? (>= 'a))
(error? (>= 3 'a))
(error? (>= 'a 3))
(error? (>= 3 4 'a))
(error? (>= 4 3 'a))
(error? (>= 'a 3 4))
(error? (>= 4 'a 3))
(error? (>= 3 5 'a 4))
(error? (>= 3+1i))
(error? (>= 3+1i 4))
(error? (>= 2 3+1i))
(error? (>= 2 3 3+1i))
(error? (>= 3.4+0.0i))
(error? (>= 3.4+0.0i 3.5))
(error? (>= 3.2 3.4+0.0i))
(error? (>= 3.2 3.3 3.4+0.0i))
(>= 3 3)
(not (>= 3 4))
(>= -3 -3)
(>= -3 -4)
(>= -2.3e10 -2.3e10)
(not (>= -2.3e10 -2.3e9))
(>= 3 3.0)
(>= 3 2.9)
(>= 7/3 7/3)
(not (>= 7/3 8/3))
(>= 1/2 0.5)
(>= 1/2 0.4)
(>= 1)
(>= 3 2 1)
(not (>= 1 2 3 4))
(not (>= 1 2 2 4))
(>= 4 3 2 1)
(>= 4 2 2 1)
(not (>= 4 2 3 1))
(>= 1000000000023 2.5 2 3/2 1.0)
(not (>= #x40000000 #x80000000))
(not (>= 1 99999999999999999999999999999))
(not (>= -1 99999999999999999999999999999))
(>= 1 -99999999999999999999999999999)
(>= -1 -99999999999999999999999999999)
(>= 99999999999999999999999999999 -99999999999999999999999999999)
(not (>= -99999999999999999999999999999 99999999999999999999999999999))
(>= 99999999999999999999999999999 99999999999999999999999999998)
(not (>= 99999999999999999999999999998 99999999999999999999999999999))
(>= 99999999999999999999999999999 99999999999999999999999999999)
(error? (>= 2.0+1.0i 3.0))
(error? (>= 2+i 3))
(error? (>= 2 3+i))
(guard (c [#t #t]) (not (>= (#3%length (error #f "oops")) 0)))
(test-transitive >= 1 1.0 1)
(test-transitive >= 1 2 3)
(test-transitive >= 1 2 1)
(test-transitive >= (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive >= 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive >= 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations >=)
)
(mat r6rs:=
(error? (r6rs:=))
(error? (r6rs:= 3))
(error? (r6rs:= 3 'a))
(error? (r6rs:= 'a 3))
(error? (r6rs:= 3 3 'a))
(error? (r6rs:= 4 3 'a))
(error? (r6rs:= 'a 3 4))
(error? (r6rs:= 4 'a 3))
(error? (r6rs:= 3 4 'a 5))
(r6rs:= 3 3)
(not (r6rs:= 3 4))
(r6rs:= -3 -3)
(not (r6rs:= -3 -4))
(r6rs:= -2.3e10 -2.3e10)
(not (r6rs:= -2.3e10 -2.3e9))
(r6rs:= 3 3.0)
(not (r6rs:= 3 2.9))
(r6rs:= 7/3 7/3)
(not (r6rs:= 7/3 8/3))
(r6rs:= 1/2 0.5)
(not (r6rs:= 1/2 0.4))
(r6rs:= 1 1.0 1 1.0)
(r6rs:= 1/2 0.5 1/2 0.5)
(not (r6rs:= 1 1.1 1 1.0))
(not (r6rs:= 1/2 0.5 1/3 0.5))
(not (r6rs:= 1 99999999999999999999999999999))
(not (r6rs:= -1 99999999999999999999999999999))
(not (r6rs:= 1 -99999999999999999999999999999))
(not (r6rs:= -1 -99999999999999999999999999999))
(not (r6rs:= 99999999999999999999999999999 -99999999999999999999999999999))
(not (r6rs:= -99999999999999999999999999999 99999999999999999999999999999))
(not (r6rs:= 99999999999999999999999999999 99999999999999999999999999998))
(not (r6rs:= 99999999999999999999999999998 99999999999999999999999999999))
(r6rs:= 99999999999999999999999999999 99999999999999999999999999999)
(r6rs:= 2.0+1.0i 2.0+1.0i)
(not (r6rs:= 2.0+1.0i 2.0+1.1i))
(r6rs:= 2-1/2i 2-1/2i)
(r6rs:= 2-1/2i 2.0-0.5i)
(test-transitive r6rs:= 1 1.0 1)
(test-transitive r6rs:= 1 2 3)
(test-transitive r6rs:= 1 2 1)
(test-transitive r6rs:= (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive r6rs:= 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive r6rs:= 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations r6rs:=)
)
(mat r6rs:<
(error? (r6rs:<))
(error? (r6rs:< 3))
(error? (r6rs:< 3 'a))
(error? (r6rs:< 'a 3))
(error? (r6rs:< 3 4 'a))
(error? (r6rs:< 4 3 'a))
(error? (r6rs:< 'a 3 4))
(error? (r6rs:< 4 'a 3))
(error? (r6rs:< 3 5 'a 4))
(not (r6rs:< 3 3))
(r6rs:< 3 4)
(not (r6rs:< -3 -3))
(not (r6rs:< -3 -4))
(not (r6rs:< -2.3e10 -2.3e10))
(r6rs:< -2.3e10 -2.3e9)
(not (r6rs:< 3 3.0))
(not (r6rs:< 3 2.9))
(not (r6rs:< 7/3 7/3))
(r6rs:< 7/3 8/3)
(not (r6rs:< 1/2 0.5))
(not (r6rs:< 1/2 0.4))
(r6rs:< 1 2 3)
(r6rs:< 1 2 3 4)
(not (r6rs:< 1 2 2 4))
(not (r6rs:< 4 3 2 1))
(not (r6rs:< 4 2 2 1))
(not (r6rs:< 1 3 2 4))
(r6rs:< 1.0 3/2 2 2.5 1000000000023)
(r6rs:< 1 99999999999999999999999999999)
(r6rs:< -1 99999999999999999999999999999)
(not (r6rs:< 1 -99999999999999999999999999999))
(not (r6rs:< -1 -99999999999999999999999999999))
(not (r6rs:< 99999999999999999999999999999 -99999999999999999999999999999))
(r6rs:< -99999999999999999999999999999 99999999999999999999999999999)
(not (r6rs:< 99999999999999999999999999999 99999999999999999999999999998))
(r6rs:< 99999999999999999999999999998 99999999999999999999999999999)
(not (r6rs:< 99999999999999999999999999999 99999999999999999999999999999))
(error? (r6rs:< 2.0+1.0i 3.0))
(error? (r6rs:< 2+i 3))
(error? (r6rs:< 2 3+i))
(test-transitive r6rs:< 1 1.0 1)
(test-transitive r6rs:< 1 2 3)
(test-transitive r6rs:< 1 2 1)
(test-transitive r6rs:< (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive r6rs:< 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive r6rs:< 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations r6rs:<)
)
(mat r6rs:<=
(error? (r6rs:<=))
(error? (r6rs:<= 3))
(error? (r6rs:<= 3 'a))
(error? (r6rs:<= 'a 3))
(error? (r6rs:<= 3 4 'a))
(error? (r6rs:<= 4 3 'a))
(error? (r6rs:<= 'a 3 4))
(error? (r6rs:<= 4 'a 3))
(error? (r6rs:<= 3 5 'a 4))
(r6rs:<= 3 3)
(r6rs:<= 3 4)
(r6rs:<= -3 -3)
(not (r6rs:<= -3 -4))
(r6rs:<= -2.3e10 -2.3e10)
(r6rs:<= -2.3e10 -2.3e9)
(r6rs:<= 3 3.0)
(not (r6rs:<= 3 2.9))
(r6rs:<= 7/3 7/3)
(r6rs:<= 7/3 8/3)
(r6rs:<= 1/2 0.5)
(not (r6rs:<= 1/2 0.4))
(r6rs:<= 1 2 3)
(r6rs:<= 1 2 3 4)
(r6rs:<= 1 2 2 4)
(not (r6rs:<= 4 3 2 1))
(not (r6rs:<= 4 2 2 1))
(not (r6rs:<= 1 3 2 4))
(r6rs:<= 1.0 3/2 2 2.5 1000000000023)
(r6rs:<= 1 99999999999999999999999999999)
(r6rs:<= -1 99999999999999999999999999999)
(not (r6rs:<= 1 -99999999999999999999999999999))
(not (r6rs:<= -1 -99999999999999999999999999999))
(not (r6rs:<= 99999999999999999999999999999 -99999999999999999999999999999))
(r6rs:<= -99999999999999999999999999999 99999999999999999999999999999)
(not (r6rs:<= 99999999999999999999999999999 99999999999999999999999999998))
(r6rs:<= 99999999999999999999999999998 99999999999999999999999999999)
(r6rs:<= 99999999999999999999999999999 99999999999999999999999999999)
(error? (r6rs:<= 2.0+1.0i 3.0))
(error? (r6rs:<= 2+i 3))
(error? (r6rs:<= 2 3+i))
(test-transitive r6rs:<= 1 1.0 1)
(test-transitive r6rs:<= 1 2 3)
(test-transitive r6rs:<= 1 2 1)
(test-transitive r6rs:<= (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive r6rs:<= 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive r6rs:<= 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations r6rs:<=)
)
(mat r6rs:>
(error? (r6rs:>))
(error? (r6rs:> 3))
(error? (r6rs:> 3 'a))
(error? (r6rs:> 'a 3))
(error? (r6rs:> 3 4 'a))
(error? (r6rs:> 4 3 'a))
(error? (r6rs:> 'a 3 4))
(error? (r6rs:> 4 'a 3))
(error? (r6rs:> 3 5 'a 4))
(not (r6rs:> 3 3))
(not (r6rs:> 3 4))
(not (r6rs:> -3 -3))
(r6rs:> -3 -4)
(not (r6rs:> -2.3e10 -2.3e10))
(not (r6rs:> -2.3e10 -2.3e9))
(not (r6rs:> 3 3.0))
(r6rs:> 3 2.9)
(not (r6rs:> 7/3 7/3))
(not (r6rs:> 7/3 8/3))
(not (r6rs:> 1/2 0.5))
(r6rs:> 1/2 0.4)
(r6rs:> 3 2 1)
(not (r6rs:> 1 2 3 4))
(not (r6rs:> 1 2 2 4))
(r6rs:> 4 3 2 1)
(not (r6rs:> 4 2 2 1))
(not (r6rs:> 4 2 3 1))
(r6rs:> 1000000000023 2.5 2 3/2 1.0)
(not (r6rs:> 1 99999999999999999999999999999))
(not (r6rs:> -1 99999999999999999999999999999))
(r6rs:> 1 -99999999999999999999999999999)
(r6rs:> -1 -99999999999999999999999999999)
(r6rs:> 99999999999999999999999999999 -99999999999999999999999999999)
(not (r6rs:> -99999999999999999999999999999 99999999999999999999999999999))
(r6rs:> 99999999999999999999999999999 99999999999999999999999999998)
(not (r6rs:> 99999999999999999999999999998 99999999999999999999999999999))
(not (r6rs:> 99999999999999999999999999999 99999999999999999999999999999))
(error? (r6rs:> 2.0+1.0i 3.0))
(error? (r6rs:> 2+i 3))
(error? (r6rs:> 2 3+i))
(test-transitive r6rs:> 1 1.0 1)
(test-transitive r6rs:> 1 2 3)
(test-transitive r6rs:> 1 2 1)
(test-transitive r6rs:> (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive r6rs:> 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive r6rs:> 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations r6rs:>)
)
(mat r6rs:>=
(error? (r6rs:>=))
(error? (r6rs:>= 3))
(error? (r6rs:>= 3 'a))
(error? (r6rs:>= 'a 3))
(error? (r6rs:>= 3 4 'a))
(error? (r6rs:>= 4 3 'a))
(error? (r6rs:>= 'a 3 4))
(error? (r6rs:>= 4 'a 3))
(error? (r6rs:>= 3 5 'a 4))
(r6rs:>= 3 3)
(not (r6rs:>= 3 4))
(r6rs:>= -3 -3)
(r6rs:>= -3 -4)
(r6rs:>= -2.3e10 -2.3e10)
(not (r6rs:>= -2.3e10 -2.3e9))
(r6rs:>= 3 3.0)
(r6rs:>= 3 2.9)
(r6rs:>= 7/3 7/3)
(not (r6rs:>= 7/3 8/3))
(r6rs:>= 1/2 0.5)
(r6rs:>= 1/2 0.4)
(r6rs:>= 3 2 1)
(not (r6rs:>= 1 2 3 4))
(not (r6rs:>= 1 2 2 4))
(r6rs:>= 4 3 2 1)
(r6rs:>= 4 2 2 1)
(not (r6rs:>= 4 2 3 1))
(r6rs:>= 1000000000023 2.5 2 3/2 1.0)
(not (r6rs:>= #x40000000 #x80000000))
(not (r6rs:>= 1 99999999999999999999999999999))
(not (r6rs:>= -1 99999999999999999999999999999))
(r6rs:>= 1 -99999999999999999999999999999)
(r6rs:>= -1 -99999999999999999999999999999)
(r6rs:>= 99999999999999999999999999999 -99999999999999999999999999999)
(not (r6rs:>= -99999999999999999999999999999 99999999999999999999999999999))
(r6rs:>= 99999999999999999999999999999 99999999999999999999999999998)
(not (r6rs:>= 99999999999999999999999999998 99999999999999999999999999999))
(r6rs:>= 99999999999999999999999999999 99999999999999999999999999999)
(error? (r6rs:>= 2.0+1.0i 3.0))
(error? (r6rs:>= 2+i 3))
(error? (r6rs:>= 2 3+i))
(test-transitive r6rs:>= 1 1.0 1)
(test-transitive r6rs:>= 1 2 3)
(test-transitive r6rs:>= 1 2 1)
(test-transitive r6rs:>= (expt 2 66) (inexact (expt 2 66)) (expt 2 66))
(test-transitive r6rs:>= 9007199254740992 9007199254740993.0 9007199254740993)
(test-transitive r6rs:>= 9007199254740992000 9007199254740993000.0 9007199254740993000)
(test-transitive-permutations r6rs:>=)
)
(mat +
(error? (+ 'a))
(error? (+ 'a 3))
(error? (+ 'a 3 4))
(error? (+ 3 5 'a 4))
(eqv? (+ 1 2) 3)
(fl~= (+ 1.0 2) 3.0)
(fl~= (+ 1 2.0) 3.0)
(eqv? (+ 3/5 2/5) 1)
(eqv? (+ 1/2 3) 7/2)
(eqv? (+ 2/3 5/3) 7/3)
(fl~= (+ 3.2 1/2) 3.7)
(fl~= (+ 3.2 -2.5) 0.7)
(eqv? (+) 0)
(eqv? (+ 2) 2)
(eqv? (+ 2 3 4) 9)
(eqv? (+ 2 3 4 5) 14)
(eqv? (+ 2/3 3/4 4/5 5/6) 61/20)
(cfl~= (+ 1.0+2.2i -3.7+5.3i) -2.7+7.5i)
(cfl~= (+ 1.0+2.2i -3.7) -2.7+2.2i)
(cfl~= (+ 1.0 -3.7+5.3i) -2.7+5.3i)
(cfl~= (+ 1.0+2.2i +5.3i) 1.0+7.5i)
(cfl~= (+ +2.2i -3.7+5.3i) -3.7+7.5i)
(let ([v '#(2 3.2 2/3 4-7i 2.1+4.2i)])
(let f ([i 0])
(or (= i (vector-length v))
(let g ([j 0])
(if (= j (vector-length v))
(f (+ i 1))
(let ([x (vector-ref v i)] [y (vector-ref v j)])
(and (~= (+ x y) (+ y x))
(~= (- (+ x y) y) x)
(if (exact? (+ x y))
(and (exact? x) (exact? y))
(or (inexact? x) (inexact? y)))
(g (+ j 1)))))))))
(error? ; oops
(+ 'a 'b (error #f "oops")))
(error? ; oops
(+ 'a (error #f "oops") 'c))
(error? ; oops
(+ (error #f "oops") 'b 'c))
(error? ; #f is not a fixnum
(+ 3 #f))
(error? ; #f is not a fixnum
(+ #f 3))
; see also misc.ms mat cp0-partial-folding
(eqv?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(+ 3 4 5 6)))
18)
(test-cp0-expansion eqv? '(+ 1 2) 3)
(test-cp0-expansion fl~= '(+ 1.0 2) 3.0)
(test-cp0-expansion fl~= '(+ 1 2.0) 3.0)
(test-cp0-expansion eqv? '(+ 3/5 2/5) 1)
(test-cp0-expansion eqv? '(+ 1/2 3) 7/2)
(test-cp0-expansion eqv? '(+ 2/3 5/3) 7/3)
(test-cp0-expansion fl~= '(+ 3.2 1/2) 3.7)
(test-cp0-expansion fl~= '(+ 3.2 -2.5) 0.7)
(test-cp0-expansion eqv? '(+) 0)
(test-cp0-expansion eqv? '(+ 2) 2)
(test-cp0-expansion eqv? '(+ 2 3 4) 9)
(test-cp0-expansion eqv? '(+ 2 3 4 5) 14)
(test-cp0-expansion eqv? '(+ 2/3 3/4 4/5 5/6) 61/20)
(test-cp0-expansion cfl~= '(+ 1.0+2.2i -3.7+5.3i) -2.7+7.5i)
(test-cp0-expansion cfl~= '(+ 1.0+2.2i -3.7) -2.7+2.2i)
(test-cp0-expansion cfl~= '(+ 1.0 -3.7+5.3i) -2.7+5.3i)
(test-cp0-expansion cfl~= '(+ 1.0+2.2i +5.3i) 1.0+7.5i)
(test-cp0-expansion cfl~= '(+ +2.2i -3.7+5.3i) -3.7+7.5i)
)
(mat -
(error? (-))
(error? (- 'a))
(error? (- 'a 3))
(error? (- 'a 3 4))
(error? (- 3 5 'a 4))
(eqv? (- 1 2) -1)
(fl~= (- 1.0 2) -1.0)
(fl~= (- 1 2.0) -1.0)
(eqv? (- 3/5 2/5) 1/5)
(eqv? (- 1/2 3) -5/2)
(eqv? (- 2/3 5/3) -1)
(fl~= (- 3.2 1/2) 2.7)
(fl~= (- 3.2 -2.5) 5.7)
(eqv? (- 2) -2)
(eqv? (- 2 3 4) -5)
(eqv? (- 2 3 4 5) -10)
(eqv? (- 2/3 3/4 4/5 5/6) -103/60)
(cfl~= (- 1.0+2.2i -3.7+5.3i) 4.7-3.1i)
(cfl~= (- 1.0+2.2i -3.7) 4.7+2.2i)
(cfl~= (- 1.0 -3.7+5.3i) 4.7-5.3i)
(cfl~= (- 1.0+2.2i +5.3i) 1.0-3.1i)
(cfl~= (- +2.2i -3.7+5.3i) 3.7-3.1i)
(let ([v '#(100 32.23 22/33 44-79i 2.9+8.7i)])
(let f ([i 0])
(or (= i (vector-length v))
(let g ([j 0])
(if (= j (vector-length v))
(f (+ i 1))
(let ([x (vector-ref v i)] [y (vector-ref v j)])
(and (~= (+ (- x y) (- y x)) 0)
(~= (+ (- x y) y) x)
(if (exact? (- x y))
(and (exact? x) (exact? y))
(or (inexact? x) (inexact? y)))
(g (+ j 1)))))))))
(error? ; #f is not a fixnum
(- 3 #f))
(error? ; #f is not a fixnum
(- #f 3))
((lambda (x ls) (and (member x ls) #t))
(with-output-to-string
(lambda ()
(write (- (begin
(write 'x)
(+ (begin (write 'a) 3) (begin (write 'b) 4)))
(begin
(write 'y)
(+ (begin (write 'c) 5) (begin (write 'd) 7)))))))
'("xabycd-5" "xbaycd-5" "xabydc-5" "xbaydc-5"
"ycdxab-5" "ycdxba-5" "ydcxab-5" "ydcxba-5"))
(test-cp0-expansion eqv? '(- 1 2) -1)
(test-cp0-expansion fl~= '(- 1.0 2) -1.0)
(test-cp0-expansion fl~= '(- 1 2.0) -1.0)
(test-cp0-expansion eqv? '(- 3/5 2/5) 1/5)
(test-cp0-expansion eqv? '(- 1/2 3) -5/2)
(test-cp0-expansion eqv? '(- 2/3 5/3) -1)
(test-cp0-expansion fl~= '(- 3.2 1/2) 2.7)
(test-cp0-expansion fl~= '(- 3.2 -2.5) 5.7)
(test-cp0-expansion eqv? '(- 2) -2)
(test-cp0-expansion eqv? '(- 2 3 4) -5)
(test-cp0-expansion eqv? '(- 2 3 4 5) -10)
(test-cp0-expansion eqv? '(- 2/3 3/4 4/5 5/6) -103/60)
(test-cp0-expansion cfl~= '(- 1.0+2.2i -3.7+5.3i) 4.7-3.1i)
(test-cp0-expansion cfl~= '(- 1.0+2.2i -3.7) 4.7+2.2i)
(test-cp0-expansion cfl~= '(- 1.0 -3.7+5.3i) 4.7-5.3i)
(test-cp0-expansion cfl~= '(- 1.0+2.2i +5.3i) 1.0-3.1i)
(test-cp0-expansion cfl~= '(- +2.2i -3.7+5.3i) 3.7-3.1i)
)
(mat *
(error? (* 'a))
(error? (* 'a 3))
(error? (* 'a 3 4))
(error? (* 3 5 'a 4))
(eqv? (* 1 2) 2)
(eqv? (* 23170 23170) 536848900)
(eqv? (* 23170 -23170) -536848900)
(eqv? (* -23170 23170) -536848900)
(eqv? (* -23170 -23170) 536848900)
(eqv? (* 23171 23170) 536872070)
(eqv? (* 23171 -23170) -536872070)
(eqv? (* -23171 23170) -536872070)
(eqv? (* -23171 -23170) 536872070)
(eqv? (* 23171 23171) 536895241)
(eqv? (* 23171 -23171) -536895241)
(eqv? (* -23171 23171) -536895241)
(eqv? (* -23171 -23171) 536895241)
(eqv? (* #x3FFFFFFF #x3FFFFFFF) #xFFFFFFF80000001)
(eqv? (* #x3FFFFFFF #x-3FFFFFFF) #x-FFFFFFF80000001)
(eqv? (* #x-3FFFFFFF #x3FFFFFFF) #x-FFFFFFF80000001)
(eqv? (* #x-3FFFFFFF #x-3FFFFFFF) #xFFFFFFF80000001)
(eqv? (* #x40000000 #x3FFFFFFF) #xFFFFFFFC0000000)
(eqv? (* #x40000000 #x-3FFFFFFF) #x-FFFFFFFC0000000)
(eqv? (* #x-40000000 #x3FFFFFFF) #x-FFFFFFFC0000000)
(eqv? (* #x-40000000 #x-3FFFFFFF) #xFFFFFFFC0000000)
(eqv? (* #x40000000 #x40000000) #x1000000000000000)
(eqv? (* #x40000000 #x-40000000) #x-1000000000000000)
(eqv? (* #x-40000000 #x40000000) #x-1000000000000000)
(eqv? (* #x-40000000 #x-40000000) #x1000000000000000)
(fl~= (* 1.0 2) 2.0)
(fl~= (* 1 2.0) 2.0)
(eqv? (* 3/5 2/5) 6/25)
(eqv? (* 1/2 3) 3/2)
(eqv? (* 2/3 5/3) 10/9)
(fl~= (* 3.2 1/2) 1.6)
(fl~= (* 3.2 -2.5) -8.0)
(eqv? (*) 1)
(eqv? (* 2) 2)
(eqv? (* 2 3 4) 24)
(eqv? (* 2 3 4 5) 120)
(eqv? (* 2/3 3/4 4/5 5/6) 1/3)
(cfl~= (* 1.0+2.0i 3.0+4.0i) -5.0+10.0i)
(cfl~= (* 1.0+2.0i 3.0) 3.0+6.0i)
(cfl~= (* -2.0 3.0+4.0i) -6.0-8.0i)
(cfl~= (* 1.0+2.0i +4.0i) -8.0+4.0i)
(cfl~= (* +2.0i 3.0+4.0i) -8.0+6.0i)
(let ([v '#(18 3.23 2/33 4-79i 2.9+.7i)])
(let f ([i 0])
(or (= i (vector-length v))
(let g ([j 0])
(if (= j (vector-length v))
(f (+ i 1))
(let ([x (vector-ref v i)] [y (vector-ref v j)])
(and (~= (* x y) (* y x))
(~= (/ (* x y) y) x)
(if (exact? (* x y))
(and (exact? x) (exact? y))
(or (inexact? x) (inexact? y)))
(g (+ j 1)))))))))
(error? ; #f is not a fixnum
(* 3 #f))
(error? ; #f is not a fixnum
(* #f 3))
(test-cp0-expansion eqv? '(* 1 2) 2)
(test-cp0-expansion fl~= '(* 1.0 2) 2.0)
(test-cp0-expansion fl~= '(* 1 2.0) 2.0)
(test-cp0-expansion eqv? '(* 3/5 2/5) 6/25)
(test-cp0-expansion eqv? '(* 1/2 3) 3/2)
(test-cp0-expansion eqv? '(* 2/3 5/3) 10/9)
(test-cp0-expansion fl~= '(* 3.2 1/2) 1.6)
(test-cp0-expansion fl~= '(* 3.2 -2.5) -8.0)
(test-cp0-expansion eqv? '(*) 1)
(test-cp0-expansion eqv? '(* 2) 2)
(test-cp0-expansion eqv? '(* 2 3 4) 24)
(test-cp0-expansion eqv? '(* 2 3 4 5) 120)
(test-cp0-expansion eqv? '(* 2/3 3/4 4/5 5/6) 1/3)
(test-cp0-expansion cfl~= '(* 1.0+2.0i 3.0+4.0i) -5.0+10.0i)
(test-cp0-expansion cfl~= '(* 1.0+2.0i 3.0) 3.0+6.0i)
(test-cp0-expansion cfl~= '(* -2.0 3.0+4.0i) -6.0-8.0i)
(test-cp0-expansion cfl~= '(* 1.0+2.0i +4.0i) -8.0+4.0i)
(test-cp0-expansion cfl~= '(* +2.0i 3.0+4.0i) -8.0+6.0i)
)
(mat /
(error? (/))
(error? (/ 'a))
(error? (/ 'a 3))
(error? (/ 'a 3 4))
(error? (/ 3 5 'a 4))
(eqv? (/ 1 2) 1/2)
(eqv? (/ 1 -2) -1/2)
(eqv? (/ 1/2 -2) -1/4)
(eqv? (/ 1 -1/2) -2)
(fl~= (/ 1.0 2) 0.5)
(fl~= (/ 1 2.0) 0.5)
(eqv? (/ 3/5 2/5) 3/2)
(eqv? (/ -3/5 2/5) -3/2)
(eqv? (/ 3/5 -2/5) -3/2)
(eqv? (/ -3/5 -2/5) 3/2)
(eqv? (/ 1/2 3) 1/6)
(eqv? (/ 2/3 5/3) 2/5)
(fl~= (/ 3.2 1/2) 6.4)
(fl~= (/ 3.2 -2.5) -1.28)
(eqv? (/ 2) 1/2)
(eqv? (/ 2 3 4) 1/6)
(eqv? (/ 2 3 4 5) 1/30)
(eqv? (/ 2/3 3/4 4/5 5/6) 4/3)
(cfl~= (/ -5.0+10.0i 1.0+2.0i) 3.0+4.0i)
(cfl~= (/ -6.0-8.0i -2.0) 3.0+4.0i)
(cfl~= (/ 26.0 3.0-2.0i) 6.0+4.0i)
(cfl~= (/ -8.0+6.0i +2.0i) 3.0+4.0i)
(cfl~= (/ +26.0i 3.0+2.0i) 4.0+6.0i)
(let ([v '#(100 32.23 22/33 44-79i 2.9+8.7i)])
(let f ([i 0])
(or (= i (vector-length v))
(let g ([j 0])
(if (= j (vector-length v))
(f (+ i 1))
(let ([x (vector-ref v i)] [y (vector-ref v j)])
(and (~= (* (/ x y) (/ y x)) 1)
(~= (* (/ x y) y) x)
(if (exact? (/ x y))
(and (exact? x) (exact? y))
(or (inexact? x) (inexact? y)))
(g (+ j 1)))))))))
(eqv? (/ 1.0 #e1e500) 0.0) ; catch bug found in 4.0a
;; following returns incorrect result in all versions prior to 5.9b
(eq? (/ (most-negative-fixnum) (- (most-negative-fixnum))) -1)
(let ([x (/ 9 50000000000)])
(and (eqv? (numerator x) 9)
(eqv? (denominator x) 50000000000)))
(== (/ 3.5 0) +inf.0)
(== (/ -3.5 0) -inf.0)
(== (/ 0.0 0) (nan))
(test-cp0-expansion eqv? '(/ 1 2) 1/2)
(test-cp0-expansion eqv? '(/ 1 -2) -1/2)
(test-cp0-expansion eqv? '(/ 1/2 -2) -1/4)
(test-cp0-expansion eqv? '(/ 1 -1/2) -2)
(test-cp0-expansion fl~= '(/ 1.0 2) 0.5)
(test-cp0-expansion fl~= '(/ 1 2.0) 0.5)
(test-cp0-expansion eqv? '(/ 3/5 2/5) 3/2)
(test-cp0-expansion eqv? '(/ -3/5 2/5) -3/2)
(test-cp0-expansion eqv? '(/ 3/5 -2/5) -3/2)
(test-cp0-expansion eqv? '(/ -3/5 -2/5) 3/2)
(test-cp0-expansion eqv? '(/ 1/2 3) 1/6)
(test-cp0-expansion eqv? '(/ 2/3 5/3) 2/5)
(test-cp0-expansion fl~= '(/ 3.2 1/2) 6.4)
(test-cp0-expansion fl~= '(/ 3.2 -2.5) -1.28)
(test-cp0-expansion eqv? '(/ 2) 1/2)
(test-cp0-expansion eqv? '(/ 2 3 4) 1/6)
(test-cp0-expansion eqv? '(/ 2 3 4 5) 1/30)
(test-cp0-expansion eqv? '(/ 2/3 3/4 4/5 5/6) 4/3)
(test-cp0-expansion cfl~= '(/ -5.0+10.0i 1.0+2.0i) 3.0+4.0i)
(test-cp0-expansion cfl~= '(/ -6.0-8.0i -2.0) 3.0+4.0i)
(test-cp0-expansion cfl~= '(/ 26.0 3.0-2.0i) 6.0+4.0i)
(test-cp0-expansion cfl~= '(/ -8.0+6.0i +2.0i) 3.0+4.0i)
(test-cp0-expansion cfl~= '(/ +26.0i 3.0+2.0i) 4.0+6.0i)
(test-cp0-expansion == '(/ 3.5 0) +inf.0)
(test-cp0-expansion == '(/ -3.5 0) -inf.0)
(test-cp0-expansion == '(/ 0.0 0) (nan))
)
(mat nan?
(error? (nan? 'a))
(error? (nan? 3+4i))
(error? (nan? 3.0-0.0i))
(not (nan? 3))
(not (nan? (* (most-positive-fixnum) 15)))
(not (nan? (/ 3 40)))
(nan? (nan))
(not (nan? 5.0))
(not (nan? +inf.0))
(not (nan? -inf.0))
)
(mat finite?
(error? (finite? 'a))
(error? (finite? 3+4i))
(error? (finite? 3.0-0.0i))
(finite? 3)
(finite? (* (most-positive-fixnum) 15))
(finite? (/ 3 40))
(not (finite? (nan)))
(finite? 5.0)
(not (finite? +inf.0))
(not (finite? -inf.0))
; r6rs:
(not (finite? +inf.0))
(finite? 5.0)
)
(mat infinite?
(error? (infinite? 'a))
(error? (infinite? 3+4i))
(error? (infinite? 3.0-0.0i))
(not (infinite? 3))
(not (infinite? (* (most-positive-fixnum) 15)))
(not (infinite? (/ 3 40)))
(not (infinite? 5.0))
(infinite? +inf.0)
(infinite? -inf.0)
; r6rs:
(not (infinite? 5.0))
(infinite? +inf.0)
)
(mat zero?
(error? (zero?))
(error? (zero? 0 1))
(error? (zero? 'a))
(zero? 0)
(zero? 0.0)
(zero? 0/5)
(not (zero? 234))
(not (zero? 23423423/234241211))
(not (zero? 23.4))
(not (zero? -1734234))
(not (zero? -2/3))
(not (zero? -0.1))
)
(mat positive?
(error? (positive?))
(error? (positive? 0 1))
(error? (positive? 'a))
(error? (positive? 1+1.0i))
(error? (positive? 1+1i))
(error? (positive? 1.0+0.0i))
(not (positive? 0))
(not (positive? 0.0))
(not (positive? 0/5))
(positive? 234)
(positive? 23423423/234241211)
(positive? 23.4)
(not (positive? -1734234))
(not (positive? -2/3))
(not (positive? -0.1))
)
(mat nonpositive?
(error? (nonpositive?))
(error? (nonpositive? 0 1))
(error? (nonpositive? 'a))
(error? (nonpositive? 1+1.0i))
(error? (nonpositive? 1+1i))
(error? (nonpositive? 1.0+0.0i))
(nonpositive? 0)
(nonpositive? 0.0)
(nonpositive? 0/5)
(not (nonpositive? 234))
(not (nonpositive? 23423423/234241211))
(not (nonpositive? 23.4))
(nonpositive? -1734234)
(nonpositive? -2/3)
(nonpositive? -0.1)
)
(mat negative?
(error? (negative?))
(error? (negative? 0 1))
(error? (negative? 'a))
(error? (negative? 1+1.0i))
(error? (negative? 1+1i))
(error? (negative? 1.0+0.0i))
(not (negative? 0))
(not (negative? 0.0))
(not (negative? 0/5))
(not (negative? 234))
(not (negative? 23423423/234241211))
(not (negative? 23.4))
(negative? -1734234)
(negative? -2/3)
(negative? -0.1)
)
(mat nonnegative?
(error? (nonnegative?))
(error? (nonnegative? 0 1))
(error? (nonnegative? 'a))
(error? (nonnegative? 1+1i))
(error? (nonnegative? 1.0+1.0i))
(error? (nonnegative? 1.0+0.0i))
(nonnegative? 0)
(nonnegative? 0.0)
(nonnegative? 0/5)
(nonnegative? 234)
(nonnegative? 23423423/234241211)
(nonnegative? 23.4)
(not (nonnegative? -1734234))
(not (nonnegative? -2/3))
(not (nonnegative? -0.1))
)
(mat even?
(error? (even?))
(error? (even? 0 1))
(error? (even? 'a))
(not (even? -3))
(even? 2)
(not (even? 1208312083280477))
(even? 1208312083280478)
(even? 4.0)
(not (even? 3.0))
(error? (even? 3.2))
(error? (even? 3.0+1.0i))
(error? (even? 1+1i))
(error? (even? +inf.0))
(error? (even? +nan.0))
)
(mat odd?
(error? (odd?))
(error? (odd? 0 1))
(error? (odd? 'a))
(odd? -3)
(not (odd? 2))
(odd? 1208312083280477)
(not (odd? 1208312083280478))
(not (odd? 4.0))
(odd? 3.0)
(error? (odd? 3.2))
(error? (odd? 3.0+1.0i))
(error? (odd? 3+1i))
(error? (odd? +inf.0))
(error? (odd? +nan.0))
)
(mat 1+
(error? (1+))
(error? (1+ 0 1))
(error? (1+ 'a))
(eqv? (1+ 1) 2)
(eqv? (1+ -1 ) 0)
(eqv? (1+ 10231231208412) 10231231208413)
(eqv? (1+ -10231231208412) -10231231208411)
(eqv? (1+ 2/3) 5/3)
(fl~= (1+ -9.6) -8.6)
(eqv? (1+ 1+1.0i) 2+1.0i)
(eqv? (1+ 1+1i) 2+1i)
)
(mat add1
(error? (add1))
(error? (add1 0 1))
(error? (add1 'a))
(eqv? (add1 1) 2)
(eqv? (add1 -1 ) 0)
(eqv? (add1 10231231208412) 10231231208413)
(eqv? (add1 -10231231208412) -10231231208411)
(eqv? (add1 2/3) 5/3)
(fl~= (add1 -9.6) -8.6)
(eqv? (add1 1+1.0i) 2+1.0i)
(eqv? (add1 1+1i) 2+1i)
)
(mat 1-
(error? (1-))
(error? (1- 0 1))
(error? (1- 'a))
(eqv? (1- 1) 0)
(eqv? (1- -1 ) -2)
(eqv? (1- 10231231208412) 10231231208411)
(eqv? (1- -10231231208412) -10231231208413)
(eqv? (1- 2/3) -1/3)
(fl~= (1- -9.6) -10.6)
(eqv? (1- 1+1.0i) +1.0i)
(eqv? (1- 1+1i) +1i)
)
(mat sub1
(error? (sub1))
(error? (sub1 0 1))
(error? (sub1 'a))
(eqv? (sub1 1) 0)
(eqv? (sub1 -1 ) -2)
(eqv? (sub1 10231231208412) 10231231208411)
(eqv? (sub1 -10231231208412) -10231231208413)
(eqv? (sub1 2/3) -1/3)
(fl~= (sub1 -9.6) -10.6)
(eqv? (sub1 1+1.0i) +1.0i)
(eqv? (sub1 1+1i) +1i)
)
(mat -1+
(error? (-1+))
(error? (-1+ 0 1))
(error? (-1+ 'a))
(eqv? (-1+ 1) 0)
(eqv? (-1+ -1 ) -2)
(eqv? (-1+ 10231231208412) 10231231208411)
(eqv? (-1+ -10231231208412) -10231231208413)
(eqv? (-1+ 2/3) -1/3)
(fl~= (-1+ -9.6) -10.6)
(eqv? (-1+ 1+1.0i) +1.0i)
(eqv? (-1+ 1+1i) +1i)
)
(mat quotient
(error? (quotient))
(error? (quotient 1))
(error? (quotient 1 0))
(error? (quotient 1 2 3))
(error? (quotient 'a 1))
(error? (quotient 1 'a))
(eqv? (quotient 1 2) 0)
(eqv? (quotient (most-positive-fixnum) -1) (- (most-positive-fixnum)))
(eqv? (quotient (most-negative-fixnum) -1) (- (most-negative-fixnum)))
(not (eqv? (quotient 1.0 2) 0))
(not (eqv? (quotient 1 2.0) 0))
(error? (quotient 3/5 2/5))
(error? (quotient 1/2 3))
(error? (quotient 2/3 5/3))
(error? (quotient 3.2 1/2))
(error? (quotient 3.2 -2.5))
(error? (quotient 3.2 2))
(error? (quotient 3 2.1))
(error? (quotient 3 2+i))
(error? (quotient 2+i 3))
(error? (quotient 2.0+i 3))
(fl= (quotient 4 2.0) 2.0)
(fl= (quotient 4.0 2) 2.0)
(fl= (quotient 4.0 2.0) 2.0)
(fl= (quotient 4.0 2.0) 2.0)
(fl= (quotient 3.0 -2.0) -1.0)
(fl= (quotient -3.0 -2.0) 1.0)
(fl= (quotient -3.0 2) -1.0)
;; following returns incorrect result in all versions prior to 5.9b
(eq? (quotient (most-negative-fixnum) (- (most-negative-fixnum))) -1)
)
(mat remainder
(error? (remainder))
(error? (remainder 1))
(error? (remainder 1 0))
(error? (remainder 1 2 3))
(error? (remainder 'a 1))
(error? (remainder 1 'a))
(eqv? (remainder 1 2) 1)
(not (eqv? (remainder 1.0 2) 1))
(not (eqv? (remainder 1 2.0) 1))
(fl= (remainder 1.0 2) 1.0)
(fl= (remainder 1 2.0) 1.0)
(error? (remainder 3/5 2/5))
(error? (remainder 1/2 3))
(error? (remainder 2/3 5/3))
(error? (remainder 3.2 1/2))
(error? (remainder 3.2 -2.5))
(error? (remainder -3.2 2.5))
(error? (remainder -3.2 2.5))
(error? (remainder -3+2i 2))
(fl= (remainder 5 2.0) 1.0)
(fl= (remainder 5.0 2) 1.0)
(fl= (remainder 5.0 2.0) 1.0)
(fl= (remainder 5.0 2.0) 1.0)
(fl= (remainder -5.0 3.0) -2.0)
(fl= (remainder 5.0 -3.0) 2.0)
(eqv? (remainder -4.0 2.0) 0.0)
(eqv? (remainder 4.0 -2.0) 0.0)
(eqv? (remainder 0 2.0) 0)
(fl= (remainder 5.842423430828094e+60 10) 4.0)
(fl= (remainder 5.842423430828094e+60 10.0) 4.0)
(fl= (remainder 5.842423430828094e+60 -10) 4.0)
(fl= (remainder 5.842423430828094e+60 -10.0) 4.0)
(fl= (remainder -5.842423430828094e+60 10) -4.0)
(fl= (remainder -5.842423430828094e+60 10.0) -4.0)
(fl= (remainder -5.842423430828094e+60 -10) -4.0)
(fl= (remainder -5.842423430828094e+60 -10.0) -4.0)
(fl= (remainder (exact 5.842423430828094e+60) 10.0) 4.0)
(fl= (remainder (exact 5.842423430828094e+60) -10.0) 4.0)
(fl= (remainder (exact -5.842423430828094e+60) 10.0) -4.0)
(fl= (remainder (exact -5.842423430828094e+60) -10.0) -4.0)
(eqv? (remainder (exact 5.842423430828094e+60) 10) 4)
(eqv? (remainder (exact 5.842423430828094e+60) -10) 4)
(eqv? (remainder (exact -5.842423430828094e+60) 10) -4)
(eqv? (remainder (exact -5.842423430828094e+60) -10) -4)
;; following returns incorrect result with naive algorithm,
;; i.e., remainder = (lambda (x,y) (- x (* (quotient x y) y)))
(fl= (remainder 1e194 10.0) 8.0)
;; following returns incorrect result in all versions prior to 5.9b
(eq? (remainder (most-negative-fixnum) (- (most-negative-fixnum))) 0)
)
(mat modulo
(error? (modulo))
(error? (modulo 1))
(error? (modulo 1 2 3))
(error? (modulo 'a 1))
(error? (modulo 1 'a))
(eqv? (modulo 1 2) 1)
(not (eqv? (modulo 1.0 2) 1))
(not (eqv? (modulo 1 2.0) 1))
(fl= (modulo 1.0 2) 1.0)
(fl= (modulo 1 2.0) 1.0)
(error? (modulo 3/5 2/5))
(error? (modulo 1/2 3))
(error? (modulo 2/3 5/3))
(error? (modulo 3.2 1/2))
(error? (modulo 3.2 -2.5))
(error? (modulo -3.2 2.5))
(error? (modulo -3+2i 2))
(fl= (modulo 5 2.0) 1.0)
(fl= (modulo 5.0 2) 1.0)
(fl= (modulo 5.0 2.0) 1.0)
(fl= (modulo 5.0 2.0) 1.0)
(eqv? (modulo -4.0 2.0) 0.0)
(eqv? (modulo 4.0 -2.0) 0.0)
(eqv? (modulo 0 2.0) 0)
(fl= (modulo 5.842423430828094e+60 10) 4.0)
(fl= (modulo 5.842423430828094e+60 10.0) 4.0)
(fl= (modulo -5.842423430828094e+60 10) 6.0)
(fl= (modulo -5.842423430828094e+60 10.0) 6.0)
(fl= (modulo 5.842423430828094e+60 -10) -6.0)
(fl= (modulo 5.842423430828094e+60 -10.0) -6.0)
(fl= (modulo -5.842423430828094e+60 -10) -4.0)
(fl= (modulo -5.842423430828094e+60 -10.0) -4.0)
(fl= (modulo (exact 5.842423430828094e+60) 10.0) 4.0)
(fl= (modulo (exact -5.842423430828094e+60) 10.0) 6.0)
(fl= (modulo (exact 5.842423430828094e+60) -10.0) -6.0)
(fl= (modulo (exact -5.842423430828094e+60) -10.0) -4.0)
(eqv? (modulo (exact 5.842423430828094e+60) 10) 4)
(eqv? (modulo (exact -5.842423430828094e+60) 10) 6)
(eqv? (modulo (exact 5.842423430828094e+60) -10) -6)
(eqv? (modulo (exact -5.842423430828094e+60) -10) -4)
)
(mat truncate
(error? (truncate))
(error? (truncate 2 3))
(error? (truncate 'a))
(error? (truncate 2+1.0i))
(error? (truncate 2+1i))
(error? (truncate 2.0+0.0i))
(eqv? (truncate 19) 19)
(eqv? (truncate 2/3) 0)
(eqv? (truncate -2/3) 0)
(fl= (truncate 17.3) 17.0)
(eqv? (truncate -17/2) -8)
(fl= (truncate 2.5) 2.0)
)
(mat floor
(error? (floor))
(error? (floor 2 3))
(error? (floor 'a))
(error? (floor 2+1.0i))
(error? (floor 2+1i))
(error? (floor 2.0+0.0i))
(eqv? (floor 19) 19)
(eqv? (floor 2/3) 0)
(eqv? (floor -2/3) -1)
(fl= (floor 17.3) 17.0)
(eqv? (floor -17/2) -9)
(fl= (floor 2.5) 2.0)
)
(mat ceiling
(error? (ceiling))
(error? (ceiling 2 3))
(error? (ceiling 'a))
(error? (ceiling 2+1.0i))
(error? (ceiling -1.7+0.i))
(error? (ceiling 2.0+0.0i))
(eqv? (ceiling 19) 19)
(eqv? (ceiling 2/3) 1)
(eqv? (ceiling -2/3) 0)
(fl= (ceiling 17.3) 18.0)
(eqv? (ceiling -17/2) -8)
(fl= (ceiling 2.5) 3.0)
)
(mat round
(error? (round))
(error? (round 2 3))
(error? (round 'a))
(error? (round 2+1.0i))
(error? (round 2+1i))
(error? (round 2.0+0.0i))
(eqv? (round 19) 19)
(eqv? (round 2/3) 1)
(eqv? (round -2/3) -1)
(fl= (round 17.3) 17.0)
(eqv? (round -17/2) -8)
(fl= (round 2.5) 2.0)
(fl= (round 0.5000000000000000) 0.0)
(fl= (round 0.5000000000000001) 1.0)
)
(mat abs
(error? (abs))
(error? (abs 1 2))
(error? (abs 'a))
(eqv? (abs 1) 1)
(eqv? (abs -15) 15)
(eqv? (abs (most-negative-fixnum)) (- (most-negative-fixnum)))
(eqv? (abs (+ (most-positive-fixnum) 1)) (+ (most-positive-fixnum) 1))
(eqv? (abs (- (most-negative-fixnum) 1)) (- 1 (most-negative-fixnum)))
(eqv? (abs -3/4) 3/4)
(eqv? (abs -1152263041152514306628192408100392992507/32981512763495262007329078307916574411635755078241)
1152263041152514306628192408100392992507/32981512763495262007329078307916574411635755078241)
(error? (abs 3+4i))
(fl~= (abs 1.83) 1.83)
(fl~= (abs -0.093) 0.093)
(error? (abs 3.0+4.0i))
)
(mat magnitude
(error? (magnitude))
(error? (magnitude 1 2))
(error? (magnitude 'a))
(eqv? (magnitude 1) 1)
(eqv? (magnitude -3/4) 3/4)
(eqv? (magnitude 3+4i) 5)
(fl~= (magnitude 1.83) 1.83)
(fl~= (magnitude -0.093) 0.093)
(fl~= (magnitude 3+4.0i) 5.0)
(fl~= (magnitude 0.0-0.093i) 0.093)
(fl~= (magnitude 1+1.0i) (sqrt 2.0))
(fl~= (magnitude 99.9+88.8i) (sqrt (+ (* 99.9 99.9) (* 88.8 88.8))))
(fl~= (magnitude 1e20+1.0i) 1e20)
)
(mat max
(error? (max))
(error? (max 'a))
(error? (max 1 'a))
(error? (max 1 'a 2))
(error? (max 1 2 3 'a))
(error? (max 1 2 3 0+1.0i))
(error? (max 1 2 3 +1i))
(eqv? (max 1) 1)
(eqv? (max 3 -3) 3)
(fl= (max 3.2 1.0) 3.2)
(fl= (max 3.2 1.0) 3.2)
(fl= (max 1/2 0.5) 0.5)
(fl= (max 1/2 -0.5) 0.5)
(eqv? (max 3 5 1 4 6 2) 6)
)
(mat min
(error? (min))
(error? (min 'a))
(error? (min 1 'a))
(error? (min 1 'a 2))
(error? (min 1 2 3 'a))
(error? (min 1 2 3 0+1.0i))
(error? (min 1 2 3 +1i))
(error? (min 3.0+0.0i))
(error? (min 2 3.0+0.0i))
(error? (min 2 3.0+0.0i 3))
(error? (min 1 2 2 3.0+0.0i))
(eqv? (min -17) -17)
(eqv? (min 3 -3) -3)
(eqv? (min 3.2 1.0) 1.0)
(fl= (min 3.2 1.0) 1.0)
(fl= (min 1/2 0.5) 0.5)
(fl= (min -1/2 0.5) -0.5)
(eqv? (min 3 5 1 4 6 2) 1)
)
(mat gcd
(error? (gcd 'a))
(error? (gcd 3.4))
(error? (gcd 3/4))
(error? (gcd +inf.0))
(error? (gcd +nan.0))
(error? (gcd 1 3.4))
(error? (gcd 1 2/3 2))
(error? (gcd 1 2 3 'a))
(error? (gcd 1 2 3 1+1.0i))
(error? (gcd 1 2 3 1+1i))
(error? (gcd 3.0+0.0i))
(error? (gcd 2 3.0+0.0i))
(error? (gcd 2 3.0+0.0i 3))
(error? (gcd 1 2 2 3.0+0.0i))
(error? (gcd 0 +inf.0))
(error? (gcd -inf.0 0))
(error? (gcd 1 +inf.0))
(error? (gcd -inf.0 1))
(error? (gcd +inf.0 15 27))
(error? (gcd 15 +inf.0 27))
(error? (gcd 15 27 +inf.0))
(error? (gcd +nan.0 15 27))
(error? (gcd 15 +nan.0 27))
(error? (gcd 15 27 +nan.0))
(eqv? (gcd) 0)
(eqv? (gcd 1123123) 1123123)
(eqv? (gcd 33 15) 3)
(eqv? (gcd 28 -14) 14)
(eqv? (gcd 0 15) 15)
(fl= (gcd 0 15.0) 15.0)
(fl= (gcd 0.0 15) 15.0)
(fl= (gcd 0.0 15.0) 15.0)
(eqv? (gcd 0 0) 0)
(eqv? (gcd 2 4 8 16) 2)
(eqv? (gcd 12 6 15) 3)
(let f ([n 5])
(or (= n 0)
(and (let ((gcd-test
(lambda (count seed size)
(do ((x seed (+ y (* (1+ (random size)) x)))
(y 0 x)
(n count (1- n)))
((zero? n)
(= (gcd x y) seed)
#t)))))
(and (gcd-test 100 73 100)
(gcd-test 50 73 1000000)
(gcd-test 50 73 100000000000)
(gcd-test 25 73 #e1e200)))
(f (- n 1)))))
(eqv? (gcd 0 -333333333333333333) 333333333333333333)
)
(mat lcm
(error? (lcm 'a))
(error? (lcm 3.4))
(error? (lcm 3/4))
(error? (lcm +inf.0))
(error? (lcm +nan.0))
(error? (lcm 1 3.4))
(error? (lcm 1 2/3 2))
(error? (lcm 1 2 3 'a))
(error? (lcm 1 2 3 1+1.0i))
(error? (lcm 1 2 3 1+1i))
(error? (lcm 1 +inf.0))
(error? (lcm -inf.0 1))
(error? (lcm +inf.0 15 27))
(error? (lcm 15 +inf.0 27))
(error? (lcm 15 27 +inf.0))
(error? (lcm +nan.0 15 27))
(error? (lcm 15 +nan.0 27))
(error? (lcm 15 27 +nan.0))
(error? (lcm +inf.0 0 27))
(error? (lcm 15 +inf.0 0))
(error? (lcm 0 27 +inf.0))
(error? (lcm +nan.0 0 27))
(error? (lcm 15 +nan.0 0))
(error? (lcm 0 27 +nan.0))
(eqv? (lcm) 1)
(eqv? (lcm 13) 13)
(eqv? (lcm -13) 13)
(eqv? (lcm 7 5) 35)
(eqv? (lcm -7 5) 35)
(eqv? (lcm 15 15) 15)
(eqv? (lcm 15 25) 75)
(fl= (lcm 15 25.0) 75.0)
(fl= (lcm 15.0 25) 75.0)
(fl= (lcm -15.0 25) 75.0)
(fl= (lcm 15.0 25.0) 75.0)
(eqv? (lcm 15 25 30) 150)
(eqv? (lcm 15 -25 30) 150)
(eqv? (lcm 0 0) 0)
(eqv? (lcm 10 0) 0)
(eqv? (lcm 0 10) 0)
(eqv? (lcm 0 0 0) 0)
(eqv? (lcm 10 0 0) 0)
(eqv? (lcm 0 10 0) 0)
(eqv? (lcm 0 0 10) 0)
(eqv? (lcm 0 6 10) 0)
(eqv? (lcm 6 0 10) 0)
(eqv? (lcm 6 10 0) 0)
(eqv? (lcm 0 0 0 10) 0)
(eqv? (lcm 10 0 0 0) 0)
(eqv? (lcm 0 6 7 10) 0)
(eqv? (lcm 10 6 7 0) 0)
(eqv? (lcm 0.0 0.0) 0.0)
(eqv? (lcm 10.0 0.0) 0.0)
(eqv? (lcm 0.0 10.0) 0.0)
(eqv? (lcm 0.0 0.0 0.0) 0.0)
(eqv? (lcm 10.0 0.0 0.0) 0.0)
(eqv? (lcm 0.0 10.0 0.0) 0.0)
(eqv? (lcm 0.0 0.0 10.0) 0.0)
(eqv? (lcm 0.0 6.0 10.0) 0.0)
(eqv? (lcm 6.0 0.0 10.0) 0.0)
(eqv? (lcm 6.0 10.0 0.0) 0.0)
(eqv? (lcm 0.0 0.0 0.0 10.0) 0.0)
(eqv? (lcm 10.0 0.0 0.0 0.0) 0.0)
(eqv? (lcm 0.0 6.0 7.0 10.0) 0.0)
(eqv? (lcm 10.0 6.0 7.0 0.0) 0.0)
)
(mat expt
(error? (expt))
(error? (expt 5))
(error? (expt 3 4 5))
(error? (expt 'a 3))
(error? (expt 3 'a))
(error? (expt 0 -1))
(error? (expt 0 +1i))
(eqv? (expt 2+2i 4) -64)
(eqv? (expt 10.0 -20) 1e-20)
(eqv? (expt 2 10) 1024)
(eqv? (expt 0 0) 1)
(eqv? (expt 0 2) 0)
(eqv? (expt 100 0) 1)
(eqv? (expt 2 -10) 1/1024)
(eqv? (expt -1/2 5) -1/32)
(fl~= (expt 9 1/2) 3.0)
(fl~= (expt 3.0 3) 27.0)
(~= (expt -0.5 2) .25)
(~= (expt -0.5 -2) 4.0)
(~= (expt 3 2.5) (sqrt (* 3 3 3 3 3)))
(fl= (expt 0.0 2.0) 0.0)
(fl= (expt 0.0 0.0) 1.0)
(fl= (expt 2.0 0.0) 1.0)
(eqv? (expt -2/3 -3) -27/8)
(fl= (expt 10.0 -1000) 0.0)
(fl= (expt .1 1000) 0.0)
(cfl~= (expt -1 1/2) +1.0i)
(cfl~= (expt 2.4-.3i 3.0) (* 2.4-.3i 2.4-.3i 2.4-.3i))
(cfl~= (expt 2.4-.3i 3) (* 2.4-.3i 2.4-.3i 2.4-.3i))
(cfl~= (expt 7.7-11.11i -2.0) (* (/ 1.0 7.7-11.11i) (/ 1.0 7.7-11.11i)))
(~= (expt 11 1/2) (sqrt 11))
(fl~= (expt 1.5e-20 0.5) (sqrt 1.5e-20))
; test cp0 handling of expt
(begin
(define $probably-should-not-use
(lambda () (expt 1000000 10000000000000000)))
(procedure? $probably-should-not-use))
(equal?
(let ([ls '(a b c)])
(let ([n (expt (begin (set! ls (append ls ls)) 2)
(begin (set! ls (reverse ls)) 3))])
(cons n ls)))
'(8 c b a c b a))
)
(mat expt-mod
(error? (expt-mod))
(error? (expt-mod 5))
(error? (expt-mod 4 5))
(error? (expt-mod 3 4 5 6))
(error? (expt-mod 'a 3 4))
(error? (expt-mod 1 -2 3))
(error? (expt-mod 1 -2 0))
(eqv? (expt-mod 2 4 3) 1)
(eqv? (expt-mod 2 76543 76543) 2)
(eqv? (expt-mod 2 10 7) 2)
(let ([x 3] [y 10] [z 8]) (eqv? (expt-mod x y z) (modulo (expt x y) z)))
(let ([x 3] [y 10] [z -8]) (eqv? (expt-mod x y z) (modulo (expt x y) z)))
(let ([x -3] [y 10] [z 8]) (eqv? (expt-mod x y z) (modulo (expt x y) z)))
(let ([x -3] [y 10] [z -8]) (eqv? (expt-mod x y z) (modulo (expt x y) z)))
)
(mat random
(error? (random))
(error? (random +1i))
(error? (random 1 2))
(error? (random 'a))
(error? (random -3))
(error? (random 0))
(error? (random 'a))
(error? (random 0.0))
(error? (random -1.0))
(error? (random 1/2))
(error? (random 3.0+0.0i))
(let f ((n 1000))
(or (zero? n)
(and
(let ((r (random n)))
(and (>= r 0) (< r n)))
(f (1- n)))))
(let f ((n 1000001000))
(or (= n 1000000000)
(and
(let ((r (random n)))
(and (>= r 0) (< r n)))
(f (1- n)))))
(let f ((n 1000.0))
(or (<= n 0.0)
(and (let ((r (random n)))
(and (>= r 0.0) (< r n)))
(let ((r (random (+ n 1e30))))
(and (>= r 0) (< r (+ n 1e30))))
(f (- n (random 2.0))))))
)
(mat random-seed
(integer? (random-seed))
(= (random-seed) (random-seed))
(error? (random-seed 'a))
(error? (random-seed 0))
(error? (random-seed -1))
(error? (random-seed (expt 2 32)))
(= 100 (begin (random-seed 100) (random-seed)))
(let ([r (random-seed)])
(let ([s (random 10)])
(random-seed r)
(= s (random 10))))
(begin
; test bug with return address saving in the assemblers; if this
; fails to terminate, it's likely that return addresses are not
; saved properly in the foreign-procedure (for random-seed) =>
; dofretuns => get-room => (C)get_more_room call chain,
(let f ((n 0))
(unless (>= (random-seed) (expt 2 29)) (f (random 2))))
(let f ((n 1000)) (unless (fx= n 0) (random-seed) (f (fx- n 1))))
#t)
)
(mat inexact
(error? (inexact))
(error? (inexact 1 2))
(error? (inexact 'a))
(fl= (inexact 3.2) 3.2)
(fl= (inexact -1/2) -0.5)
(fl= (inexact 19) 19.0)
(fl~= (inexact 87000000000000000) 8.7e+16)
(cfl~= (inexact 3+1/2i) 3.0+.5i)
)
(mat exact
(error? (exact))
(error? (exact 1 2))
(error? (exact 'a))
(eqv? (exact -15) -15)
(eqv? (exact 19/3) 19/3)
(rational? (exact 3.272))
(fl~= (inexact (exact 3.272)) 3.272)
(eqv? (exact 3.0+.5i) 3+1/2i)
)
(mat rationalize
(error? (rationalize))
(error? (rationalize 3 4 5))
(error? (rationalize 3))
(error? (rationalize 'a 1))
(error? (rationalize 3.4 'a))
(error? (rationalize 3.4+0.0i 1))
(eqv? (rationalize -15 0) -15)
(eqv? (rationalize 19/3 1/10) 19/3)
(fl= (rationalize 3.272 0) 3.272)
(fluid-let ([*fuzz* .0001]) (fl~= (rationalize 3.272 0.0001) 3.272))
(eqv? (rationalize (exact 2/3) 1/10) 2/3)
;; from r3.99rs
(eqv? (rationalize (exact .3) 1/10) 1/3)
(eqv? (rationalize .3 1/10) #i1/3)
)
(mat numerator
(error? (numerator))
(error? (numerator 3 4))
(error? (numerator 'a))
(error? (numerator +1i))
(error? (numerator 2.2+1.1i))
(eqv? (numerator 3.25) 13.0)
(eqv? (numerator 9) 9)
(eqv? (numerator 2/3) 2)
(eqv? (numerator -9/4) -9)
(error? (numerator +inf.0))
(error? (numerator -inf.0))
(error? (numerator +nan.0))
)
(mat denominator
(error? (denominator))
(error? (denominator 3 4))
(error? (denominator 'a))
(error? (denominator +1i))
(error? (denominator 2.2+1.1i))
(eqv? (denominator 3.25) 4.0)
(eqv? (denominator 9) 1)
(eqv? (denominator 2/3) 3)
(eqv? (denominator -9/4) 4)
(error? (denominator +inf.0))
(error? (denominator -inf.0))
(error? (denominator +nan.0))
)
(mat real-part
(error? (real-part))
(error? (real-part 3 4))
(error? (real-part 'a))
(eqv? (real-part 3+4.0i) 3.0)
(eqv? (real-part 3.001-4.0i) 3.001)
(eqv? (real-part -.1+4.0i) -.1)
(eqv? (real-part 3+4i) 3)
(eqv? (real-part -1/10+4i) -1/10)
)
(mat imag-part
(error? (imag-part))
(error? (imag-part 3 4))
(error? (imag-part 'a))
(eqv? (imag-part 3.0+4/3i) (inexact 4/3))
(eqv? (imag-part 3+4.01i) 4.01)
(eqv? (imag-part -.1-4e20i) -4e20)
(eqv? (imag-part 3+4i) 4)
; r6rs says (real? -2.5) is #t and real? returns #t only when
; imaginary part is exact 0, thus (imag-part -2.5) is 0
(eqv? (imag-part -2.5) 0)
(eqv? (imag-part -1-420/840i) -1/2)
)
(mat make-rectangular
(error? (make-rectangular 3 'a))
(error? (make-rectangular 'b 4))
(error? (make-rectangular 3.4+0.0i 2.3))
(error? (make-rectangular 2.3 3.4+0.0i))
(eqv? (make-rectangular 3.0 -4) 3.0-4.0i)
(eqv? (make-rectangular 3 -4.0) 3.0-4.0i)
(eqv? (make-rectangular 3 -4) 3-4i)
)
(mat make-polar
(error? (make-polar 3 'a))
(error? (make-polar 'b 4))
(error? (make-polar 3.4+0.0i 2.3))
(error? (make-polar 2.3 3.4+0.0i))
(eqv? (make-polar 3 -4) 3@-4)
)
(mat angle
(error? (angle))
(error? (angle 3 4))
(error? (angle 'a))
(if (memq (machine-type) '(i3qnx ti3qnx))
(fl~= (angle 3.0@2.0) 2.0)
(fl= (angle 3.0@2.0) 2.0))
(let ([z 24.3-200.2i]) (cfl~= z (make-polar (magnitude z) (angle z))))
(= (angle 3+1i) (angle 3.0+1.0i))
)
(mat sqrt
(error? (sqrt))
(error? (sqrt 3 4))
(error? (sqrt 'a))
(= (sqrt -1.0) 0.0+1.0i)
(eqv? (sqrt -1) +1i)
(= (sqrt 9) 3)
(= (sqrt 1/4) 1/2)
(~= (* (sqrt 189) (sqrt 189)) 189)
(fl~= (* (sqrt 2) (sqrt 2.0)) 2.0)
(cfl~= (* (sqrt 3+3.0i) (sqrt 3+3.0i)) 3+3.0i)
(let ([x 8-1.5i]) (~= (sqrt (* x x)) x))
(let ([x 8-3/2i]) (eqv? (sqrt (* x x)) x))
(~= (sqrt 5+12i) (sqrt 5.0+12.0i))
(~= (sqrt -5+12i) (sqrt -5.0+12.0i))
(~= (sqrt 5-12i) (sqrt 5.0-12.0i))
(~= (sqrt -5-12i) (sqrt -5.0-12.0i))
(~= (sqrt 1e38) (sqrt #e1e38))
)
(mat isqrt
(error? (isqrt))
(error? (isqrt 3 4))
(error? (isqrt 1.1))
(error? (isqrt 'a))
(error? (isqrt -1))
(error? (isqrt 10.0+0.0i))
(eqv? (isqrt 1.0) 1.0)
(eqv? (isqrt 9.0) 3.0)
(eqv? (isqrt 9) 3)
(eqv? (isqrt 10) 3)
(eqv? (isqrt 1000) 31)
(let ([x 11111111111111111111111111111111111111111111111111111111111111111])
(let ([i (isqrt x)])
(and (<= (* i i) x) (> (* (+ i 1) (+ i 1)) x))))
)
(mat exp
(error? (exp))
(error? (exp 3 4))
(error? (exp 'a))
(fl= (exp 0.0) 1.0)
(~= (* (exp 1) (exp 1)) (exp 2))
(fl~= (/ (exp 24.2) (exp 2)) (exp 22.2))
(fluid-let ([*fuzz* 1.1e-14])
(let ([x 24.2+3.1i] [y 2.1-2.0i])
(cfl~= (* (exp x) (exp y)) (exp (+ x y)))))
(cfl~= (exp 34.2+5.8i) (* (exp 34.2) (+ (cos 5.8) (* +1.0i (sin 5.8)))))
)
(mat log
(error? (log))
(error? (log 'a))
(error? (log 0))
(= (log 1) 0)
(fl= (log 1.0) 0.0)
(~= (log (exp 7)) 7)
(fl~= (log (exp 10.2)) 10.2)
(cfl~= (log -1) (* pi +1.0i))
(let ([x -1-2.0i]) (cfl~= (exp (log (* x x))) (exp (+ (log x) (log x)))))
(cfl~= (exp (log (exp +4.0i))) (exp +4.0i))
(cfl~= (exp (log (exp 34.2+5.8i))) (exp 34.2+5.8i))
(~= (log 1e30) (log #e1e30))
(cfl~= (log -1e30) (log #e-1e30))
(~= (/ (log (expt 10 500)) (log 10)) 500)
(~= (log 3/4) (log .75))
(~= (log 10 10) 1.0)
(~= (log 50 50) 1.0)
(~= (log -50 -50) 1.0+0.0i)
(~= (log 1000 10) 3)
)
(mat sin
(and (> pi 3.14159265) (< pi 3.14159266))
(error? (sin))
(error? (sin 3 4))
(error? (sin 'a))
(fl~= (sin (/ pi 6)) 0.5)
)
(mat cos
(error? (cos))
(error? (cos 3 4))
(error? (cos 'a))
(fl~= (cos (/ pi 3)) 0.5)
(let ([x 3.3])
(let ([s (sin x)] [c (cos x)])
(~= (+ (* s s) (* c c)) 1.0)))
(fluid-let ([*fuzz* 1e-13])
(let ([x 3.3+3.3i])
(let ([s (sin x)] [c (cos x)])
(cfl~= (+ (* s s) (* c c)) 1.0))))
)
(mat tan
(error? (tan))
(error? (tan 3 4))
(error? (tan 'a))
(fl~= (tan (/ pi 4)) 1.0)
(let ([x 4.4]) (~= (tan x) (/ (sin x) (cos x))))
(fluid-let ([*fuzz* 3e-12])
(let ([x 4.4-5.5i]) (cfl~= (tan x) (/ (sin x) (cos x)))))
)
(mat asin
(error? (asin))
(error? (asin 3 4))
(error? (asin 'a))
(fl~= (asin 1.0) (/ pi 2))
(let ([x 1.0]) (fl~= (asin (sin x)) x))
(let ([x 1.0+1.0i]) (cfl~= (asin (sin x)) x))
(let ([x 0.5]) (fl~= (asin (sin x)) x))
(let ([x 0.5+1.5i]) (cfl~= (asin (sin x)) x))
(let ([x 0.5-1.5i]) (cfl~= (asin (sin x)) x))
(let ([z 2.2-1.1i]) (cfl~= (asin z) (/ (asinh (* +1.0i z)) +1.0i)))
)
(mat acos
(error? (acos))
(error? (acos 3 4))
(error? (acos 'a))
(fl~= (acos 0.5) (/ pi 3))
(let ([x 0.5]) (fl~= (acos (cos x)) x))
(let ([x 0.5+1.5i]) (cfl~= (acos (cos x)) x))
(let ([x 0.5-1.5i]) (cfl~= (acos (cos x)) x))
(fluid-let ([*fuzz* 2.4e-13])
(let ([z 99+.99i]) (cfl~= (cos (acos z)) z)))
(let ([z +9.0i])
(cfl~= (acos z)
(/ (* 2 (log (+ (sqrt (/ (+ 1 z) 2))
(* +1.0i (sqrt (/ (- 1 z) 2))))))
+1.0i)))
(let ([x 10+10.0i]) (cfl~= (+ (asin x) (acos x)) (/ pi 2)))
)
(mat atan
(error? (atan))
(error? (atan 3 4 5))
(error? (atan 'a))
(error? (atan 'a 3))
(error? (atan 3 'a))
(error? (atan +i))
(error? (atan -i))
(error? (atan 3.0+0.0i 3.2))
(fl~= (atan 1.0) (/ pi 4))
(fl~= (atan 2.0 2.0) (/ pi 4))
(let ([x 0.5]) (fl~= (atan (tan x)) x))
(let ([x 0.5+1.5i]) (cfl~= (atan (tan x)) x))
(let ([x 0.5-1.5i]) (cfl~= (atan (tan x)) x))
(let ([z 2.2-1.1i]) (cfl~= (atan z) (/ (atanh (* +1.0i z)) +1.0i)))
(let ([z 2.2-1.1i]) (cfl~= (atan z) (/ (atanh (* +1.0i z)) +1.0i)))
(fl~= (atan 10.0 -10.0) (angle -10+10i))
(fl~= (atan 10.0 -10.0) (angle -10.0+10.0i))
(fl~= (atan 10 -10.0) (atan 10.0 -10.0))
(fl~= (atan 10 -10.0) (atan 10.0 -10))
)
(mat sinh
(let ([x 23]) (~= (sinh x) (* 1/2 (- (exp x) (exp (- x))))))
(let ([x 3-3.2i]) (~= (sinh x) (* 1/2 (- (exp x) (exp (- x))))))
(let ([x 50]) (~= (- (sinh x)) (sinh (- x))))
(let ([x 4-12i]) (~= (- (sinh x)) (sinh (- x))))
(let ([x 5.4+4.5i]) (~= (sinh (* +i x)) (* +i (sin x))))
(let ([x 5.4+4.5i])
(let ([s (sinh x)]) (~= (* s s) (* 1/2 (- (cosh (* 2 x)) 1)))))
(let ([x 5.4+4.5i])
(let ([s (sinh x)])
(~= (* s s s) (* 1/4 (+ (* -3 (sinh x)) (sinh (* 3 x)))))))
)
(mat cosh
(let ([x 9]) (~= (cosh x) (* 1/2 (+ (exp x) (exp (- x))))))
(let ([x 4+4i]) (~= (cosh x) (* 1/2 (+ (exp x) (exp (- x))))))
(let ([x 50]) (~= (cosh x) (cosh (- x))))
(let ([x 4-12i]) (~= (cosh x) (cosh (- x))))
(fluid-let ([*fuzz* 1e-12])
(let ([x 5.4])
(let ([c (cosh x)] [s (sinh x)])
(~= (- (* c c) (* s s)) 1))))
(let ([x +4.5i])
(let ([c (cosh x)] [s (sinh x)]) (~= (- (* c c) (* s s)) 1)))
(fluid-let ([*fuzz* 1e-11])
(let ([x 5.4+4.5i])
(let ([c (cosh x)] [s (sinh x)]) (~= (- (* c c) (* s s)) 1))))
(let ([x 5.4+4.5i]) (~= (cosh (* +i x)) (cos x)))
(let ([x 5.4+4.5i])
(let ([c (cosh x)]) (~= (* c c) (* 1/2 (+ (cosh (* 2 x)) 1)))))
(let ([x 5.4+4.5i])
(let ([c (cosh x)])
(~= (* c c c) (* 1/4 (+ (* 3 (cosh x)) (cosh (* 3 x)))))))
)
(mat tanh
(let ([x 50]) (~= (- (tanh x)) (tanh (- x))))
(let ([x 4-12i]) (~= (- (tanh x)) (tanh (- x))))
(let ([x -5]) (~= (tanh x) (/ (sinh x) (cosh x))))
(fluid-let ([*fuzz* 1e-13])
(let ([x 3-2i]) (~= (tanh x) (/ (sinh x) (cosh x)))))
(let ([x 5.4+4.5i]) (~= (tanh (* +i x)) (* +i (tan x))))
)
(mat asinh
(error? (asinh))
(error? (asinh 3 4))
(error? (asinh 'a))
(fl~= (asinh (sinh 5.7)) 5.7)
(let ([x 0.5]) (fl~= (asinh (sinh x)) x))
(let ([x 0.5+1.5i]) (cfl~= (asinh (sinh x)) x))
(let ([x 0.5-1.5i]) (cfl~= (asinh (sinh x)) x))
(let ([z 3+3.0i]) (cfl~= (asinh z) (log (+ z (sqrt (+ 1 (* z z)))))))
(let ([z -3.1-9.9i]) (cfl~= (asinh z) (* -1.0i (asin (* +1.0i z)))))
(let ([z 10+999.0i]) (cfl~= (asinh z) (* -1.0i (asin (* +1.0i z)))))
(let ([z 9.5]) (cfl~= (asinh z) (* -1.0i (asin (* +1.0i z)))))
)
(mat acosh
(error? (acosh))
(error? (acosh 3 4))
(error? (acosh 'a))
(fl~= (acosh (cosh 13.3)) 13.3)
(let ([x 0.5]) (fl~= (acosh (cosh x)) x))
(let ([x 0.5+1.5i]) (cfl~= (acosh (cosh x)) x))
(let ([x 0.5-1.5i]) (cfl~= (acosh (cosh x)) x))
(let ([z 3+3.0i])
(cfl~= (acosh z)
(* 2 (log (+ (sqrt (/ (+ z 1) 2)) (sqrt (/ (- z 1) 2)))))))
(let ([z -3.1-9.9i]) (cfl~= (acosh z) (* -1.0i (acos z))))
(let ([z 10+999.0i]) (cfl~= (acosh z) (* +1.0i (acos z))))
)
(mat atanh
(error? (atanh))
(error? (atanh 3 4))
(error? (atanh 'a))
(error? (atanh -1))
(error? (atanh 1))
(fl~= (atanh (tanh 1.0)) 1.0)
(fl~= (atanh (tanh 1.0)) 1.0)
(let ([x 0.5]) (fl~= (atanh (tanh x)) x))
(let ([x 0.5+1.5i]) (cfl~= (atanh (tanh x)) x))
(let ([x 0.5-1.5i]) (cfl~= (atanh (tanh x)) x))
(let ([z 3+3.0i]) (cfl~= (atanh z) (/ (- (log (+ 1 z)) (log (- 1 z))) 2)))
(let ([z -3.1-9.9i]) (cfl~= (atanh z) (* -1.0i (atan (* +1.0i z)))))
(not (= (imag-part (atanh 2)) 0))
(not (= (imag-part (atanh -2)) 0))
(let ([z 3.2+2.3i]) (cfl~= (sinh z) (* (tanh z) (cosh z))))
(let ([z 100+99.0i]) (cfl~= (atanh z) (- (atanh (- z)))))
(let ([z 2.3-3.2i])
(let ([c (cosh z)] [s (sinh z)])
(cfl~= (- (* c c) (* s s)) 1.0)))
)
(mat ash
(error? (ash))
(error? (ash 1))
(error? (ash 1 1 1))
(error? (ash .1 1))
(error? (ash 1 .1))
#;(error? (ash 1 (+ (most-positive-fixnum) 1)))
#;(error? (ash 1 (- (most-negative-fixnum) 1)))
(= (ash 234 0) 234)
(= (ash 1 4) 16)
(= (ash 8 -4) 0)
(= (ash (ash 4 4) -4) 4)
(= (ash 1 100) (expt 2 100))
(= (ash 1 -100) 0)
(= (ash (ash 1 100) -100) 1)
(= (ash 100 100) (* 100 (expt 2 100)))
(let ([x 11111111111111111111111111111111111111111111111] [n 10])
(= (ash x n) (* x (expt 2 n))))
(let ([x 11111111111111111111111111111111111111111111111] [n -10])
(= (ash x n) (floor (* x (expt 2 n)))))
(let ([x -11111111111111111111111111111111111111111111111] [n 10])
(= (ash x n) (* x (expt 2 n))))
(let ([x -11111111111111111111111111111111111111111111111] [n -10])
(= (ash x n) (floor (* x (expt 2 n)))))
(let ([x (- (expt 2 29))] [n -1])
(= (ash x n) (floor (* x (expt 2 n)))))
(let ([x (- (expt 2 30))] [n -1])
(= (ash x n) (floor (* x (expt 2 n)))))
(let ([x (most-negative-fixnum)] [n -1])
(= (ash x n) (floor (* x (expt 2 n)))))
(let ([x (- (most-negative-fixnum) 1)] [n -1])
(= (ash x n) (floor (* x (expt 2 n)))))
; check for bugs with large negative shift counts
(= (ash 1 -32) 0)
(= (ash 1 -33) 0)
(= (ash 1 -96) 0)
(= (ash 987239487293874234 -1000) 0)
(= (ash -987239487293874234 -1000) -1)
(let f ([i -1000])
(or (fx= i 0)
(and (negative? (ash -232342342340033477676766821733948948594358 i))
(f (fx+ i 1)))))
(eqv? (ash #x-8000000000000000 -31) #x-100000000)
(eqv? (ash #x-8000000000000000 -32) #x-80000000)
(eqv? (ash #x-8000000000000000 -33) #x-40000000)
(begin
(define ($test-right-shift srl)
(define ($go q x n expected)
(let ([got (srl x n)])
(unless (eqv? got expected)
(syntax-error q (format "expected ~x, got ~x" expected got)))))
(define-syntax go
(lambda (q)
(syntax-case q ()
[(_ x n expected) #`($go #'#,q x n expected)])))
(let* ([$x (expt 2 1024)]
[$-x (- $x)]
[$x+1 (+ $x 1)]
[$-x-1 (- $x+1)]
[$x-1 (- $x 1)]
[$-x+1 (- $x-1)]
[$x+8 (+ $x 8)]
[$-x-8 (- $x+8)]
[$x+2^31 (+ $x (expt 2 32))]
[$-x-2^31 (- $x+2^31)]
[$x+2^32 (+ $x (expt 2 32))]
[$-x-2^32 (- $x+2^32)]
[$x+2^40 (+ $x (expt 2 40))]
[$-x-2^40 (- $x+2^40)]
[$x+2^63 (+ $x (expt 2 63))]
[$-x-2^63 (- $x+2^63)]
[$x+2^65 (+ $x (expt 2 65))]
[$-x-2^65 (- $x+2^65)]
[$x*3/2 (ash 3 1023)]
[$-x*3/2 (- $x*3/2)]
; answers
[$2^64 (expt 2 64)]
[$-2^64 (- $2^64)]
[$-2^64-1 (- -1 $2^64)]
[$x>>64 (expt 2 (- 1024 64))]
[$-x>>64 (- $x>>64)]
[$-x>>64-1 (- -1 $x>>64)]
[$x>>64+2 (+ $x>>64 2)]
[$-x>>64-2 (- $x>>64+2 )]
[$x>>80 (expt 2 (- 1024 80))]
[$-x>>80 (- $x>>80)]
[$-x>>80-1 (- -1 $x>>80)]
)
(go $x 1024 1)
(go $-x 1024 -1)
(go $x 1025 0)
(go $-x 1025 -1)
(go $x+1 1024 1)
(go $-x-1 1024 -2)
(go $x+1 1025 0)
(go $-x-1 1025 -1)
(go $x (- 1024 64) $2^64)
(go $-x (- 1024 64) $-2^64)
(go $x+1 (- 1024 64) $2^64)
(go $-x-1 (- 1024 64) $-2^64-1)
(go $x+8 (- 1024 64) $2^64)
(go $-x-8 (- 1024 64) $-2^64-1)
(go $x+2^32 (- 1024 64) $2^64)
(go $-x-2^32 (- 1024 64) $-2^64-1)
(go $x+2^65 (- 1024 64) $2^64)
(go $-x-2^65 (- 1024 64) $-2^64-1)
(go $x 64 $x>>64)
(go $-x 64 $-x>>64)
(go $x+1 64 $x>>64)
(go $-x-1 64 $-x>>64-1)
(go $x+8 64 $x>>64)
(go $-x-8 64 $-x>>64-1)
(go $x+2^31 64 $x>>64)
(go $-x-2^31 64 $-x>>64-1)
(go $x+2^40 64 $x>>64)
(go $-x-2^40 64 $-x>>64-1)
(go $x+2^63 64 $x>>64)
(go $-x-2^63 64 $-x>>64-1)
(go $x+2^65 64 $x>>64+2)
(go $-x-2^65 64 $-x>>64-2)
(go $x 80 $x>>80)
(go $-x 80 $-x>>80)
(go $x+1 80 $x>>80)
(go $-x-1 80 $-x>>80-1)
(go $x+8 80 $x>>80)
(go $-x-8 80 $-x>>80-1)
(go $x+2^31 80 $x>>80)
(go $-x-2^31 80 $-x>>80-1)
(go $x+2^32 80 $x>>80)
(go $-x-2^32 80 $-x>>80-1)
(go $x+2^40 80 $x>>80)
(go $-x-2^40 80 $-x>>80-1)
(go $x+2^63 80 $x>>80)
(go $-x-2^63 80 $-x>>80-1)
(go $x+2^65 80 $x>>80)
(go $-x-2^65 80 $-x>>80-1)
(go $x*3/2 1023 3)
(go $-x*3/2 1023 -3)
(go $x*3/2 1024 1)
(go $-x*3/2 1024 -2)
(go $x*3/2 1025 0)
(go $-x*3/2 1025 -1)
)
#t)
#t)
($test-right-shift (lambda (x n) (ash x (- n))))
)
(mat bitwise-arithmetic-shift
(error? (bitwise-arithmetic-shift))
(error? (bitwise-arithmetic-shift 1))
(error? (bitwise-arithmetic-shift 1 1 1))
(error? (bitwise-arithmetic-shift .1 1))
(error? (bitwise-arithmetic-shift 1 .1))
(= (bitwise-arithmetic-shift 234 0) 234)
(= (bitwise-arithmetic-shift 1 4) 16)
(= (bitwise-arithmetic-shift 8 -4) 0)
(= (bitwise-arithmetic-shift (bitwise-arithmetic-shift 4 4) -4) 4)
(= (bitwise-arithmetic-shift 1 100) (expt 2 100))
(= (bitwise-arithmetic-shift 1 -100) 0)
(= (bitwise-arithmetic-shift (bitwise-arithmetic-shift 1 100) -100) 1)
(= (bitwise-arithmetic-shift 100 100) (* 100 (expt 2 100)))
(let ([x 11111111111111111111111111111111111111111111111] [n 10])
(= (bitwise-arithmetic-shift x n) (* x (expt 2 n))))
(let ([x 11111111111111111111111111111111111111111111111] [n -10])
(= (bitwise-arithmetic-shift x n) (floor (* x (expt 2 n)))))
(let ([x -11111111111111111111111111111111111111111111111] [n 10])
(= (bitwise-arithmetic-shift x n) (* x (expt 2 n))))
(let ([x -11111111111111111111111111111111111111111111111] [n -10])
(= (bitwise-arithmetic-shift x n) (floor (* x (expt 2 n)))))
(let ([x (- (expt 2 29))] [n -1])
(= (bitwise-arithmetic-shift x n) (floor (* x (expt 2 n)))))
(let ([x (- (expt 2 30))] [n -1])
(= (bitwise-arithmetic-shift x n) (floor (* x (expt 2 n)))))
(let ([x (most-negative-fixnum)] [n -1])
(= (bitwise-arithmetic-shift x n) (floor (* x (expt 2 n)))))
(let ([x (- (most-negative-fixnum) 1)] [n -1])
(= (bitwise-arithmetic-shift x n) (floor (* x (expt 2 n)))))
; check for bugs with large negative shift counts
(= (bitwise-arithmetic-shift 1 -32) 0)
(= (bitwise-arithmetic-shift 1 -33) 0)
(= (bitwise-arithmetic-shift 1 -96) 0)
(= (bitwise-arithmetic-shift 987239487293874234 -1000) 0)
(= (bitwise-arithmetic-shift -987239487293874234 -1000) -1)
(let f ([i -1000])
(or (fx= i 0)
(and (negative? (bitwise-arithmetic-shift -232342342340033477676766821733948948594358 i))
(f (fx+ i 1)))))
(eqv? (bitwise-arithmetic-shift #x-8000000000000000 -31) #x-100000000)
(eqv? (bitwise-arithmetic-shift #x-8000000000000000 -32) #x-80000000)
(eqv? (bitwise-arithmetic-shift #x-8000000000000000 -33) #x-40000000)
(eqv? (- (expt 16 232)) (bitwise-arithmetic-shift (- 307 (expt 16 240)) -32))
($test-right-shift (lambda (x n) (bitwise-arithmetic-shift x (- n))))
)
(mat bitwise-arithmetic-shift-left/right
(error? (bitwise-arithmetic-shift-left))
(error? (bitwise-arithmetic-shift-left 1))
(error? (bitwise-arithmetic-shift-left 1 1 1))
(error? (bitwise-arithmetic-shift-left .1 1))
(error? (bitwise-arithmetic-shift-left 1 .1))
(= (bitwise-arithmetic-shift-left 234 0) 234)
(= (bitwise-arithmetic-shift-left 1 4) 16)
(= (bitwise-arithmetic-shift-right 8 4) 0)
(= (bitwise-arithmetic-shift-right (bitwise-arithmetic-shift-left 4 4) 4) 4)
(= (bitwise-arithmetic-shift-left 1 100) (expt 2 100))
(= (bitwise-arithmetic-shift-right 1 100) 0)
(= (bitwise-arithmetic-shift-right (bitwise-arithmetic-shift-left 1 100) 100) 1)
(= (bitwise-arithmetic-shift-left 100 100) (* 100 (expt 2 100)))
(let ([x 11111111111111111111111111111111111111111111111] [n 10])
(= (bitwise-arithmetic-shift-left x n) (* x (expt 2 n))))
(let ([x 11111111111111111111111111111111111111111111111] [n -10])
(= (bitwise-arithmetic-shift-right x (- n)) (floor (* x (expt 2 n)))))
(let ([x -11111111111111111111111111111111111111111111111] [n 10])
(= (bitwise-arithmetic-shift-left x n) (* x (expt 2 n))))
(let ([x -11111111111111111111111111111111111111111111111] [n -10])
(= (bitwise-arithmetic-shift-right x (- n)) (floor (* x (expt 2 n)))))
(let ([x (- (expt 2 29))] [n -1])
(= (bitwise-arithmetic-shift-right x (- n)) (floor (* x (expt 2 n)))))
(let ([x (- (expt 2 30))] [n -1])
(= (bitwise-arithmetic-shift-right x (- n)) (floor (* x (expt 2 n)))))
(let ([x (most-negative-fixnum)] [n -1])
(= (bitwise-arithmetic-shift-right x (- n)) (floor (* x (expt 2 n)))))
(let ([x (- (most-negative-fixnum) 1)] [n -1])
(= (bitwise-arithmetic-shift-right x (- n)) (floor (* x (expt 2 n)))))
; check for bugs with large negative shift counts
(= (bitwise-arithmetic-shift-right 1 32) 0)
(= (bitwise-arithmetic-shift-right 1 33) 0)
(= (bitwise-arithmetic-shift-right 1 96) 0)
(= (bitwise-arithmetic-shift-right 987239487293874234 1000) 0)
(= (bitwise-arithmetic-shift-right -987239487293874234 1000) -1)
(let f ([i -1000])
(or (fx= i 0)
(and (negative? (bitwise-arithmetic-shift-right -232342342340033477676766821733948948594358 (- i)))
(f (fx+ i 1)))))
(eqv? (bitwise-arithmetic-shift-right #x-8000000000000000 31) #x-100000000)
(eqv? (bitwise-arithmetic-shift-right #x-8000000000000000 32) #x-80000000)
(eqv? (bitwise-arithmetic-shift-right #x-8000000000000000 33) #x-40000000)
(eqv? (- (expt 16 232)) (bitwise-arithmetic-shift-right (- 307 (expt 16 240)) 32))
($test-right-shift (lambda (x n) (bitwise-arithmetic-shift-right x n)))
)
(mat bitwise-bit-field
(error? (bitwise-bit-field))
(error? (bitwise-bit-field 35))
(error? (bitwise-bit-field 35 5))
(error? (bitwise-bit-field 35 5 8 15))
(error? (bitwise-bit-field 35.0 5 8))
(error? (bitwise-bit-field 35 5.0 8))
(error? (bitwise-bit-field 35 5 8.0))
(error? (bitwise-bit-field 'a 5 8))
(error? (bitwise-bit-field 35 '(a b) 8))
(error? (bitwise-bit-field 35 5 "hello"))
(error? (bitwise-bit-field 35 -5 8))
(error? (bitwise-bit-field 35 5 -8))
(error? (bitwise-bit-field 35 5 3))
(error? (bitwise-bit-field 35 (+ (* (greatest-fixnum) 2) 10) (* (greatest-fixnum) 2)))
(eqv? (bitwise-bit-field 35 100 150) 0)
(eqv? (bitwise-bit-field -35 100 150) (- (expt 2 50) 1))
(do ([n 1000 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (expt 10 1000))])
(let ([len (integer-length x)])
(let ([i (random len)] [j (random len)])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (= (bitwise-ior (bitwise-arithmetic-shift-left (bitwise-bit-field x i j) i)
(bitwise-arithmetic-shift-left (bitwise-bit-field x j len) j)
(bitwise-bit-field x 0 i))
x)
(errorf #f "failed for ~s, ~s, ~s" x i j)))))))
(do ([n 1000 (fx- n 1)])
((fx= n 0) #t)
(let ([x (- (random (expt 10 1000)))])
(let ([len (integer-length x)])
(let ([i (random len)] [j (random len)])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (= (bitwise-ior (bitwise-arithmetic-shift-left -1 len)
(bitwise-arithmetic-shift-left (bitwise-bit-field x i j) i)
(bitwise-arithmetic-shift-left (bitwise-bit-field x j len) j)
(bitwise-bit-field x 0 i))
x)
(errorf #f "failed for ~s, ~s, ~s" x i j)))))))
(eqv?
(bitwise-bit-field 35 (* (greatest-fixnum) 2) (+ (* (greatest-fixnum) 2) 10))
0)
(eqv?
(bitwise-bit-field -35 (* (greatest-fixnum) 2) (+ (* (greatest-fixnum) 2) 10))
#b1111111111)
(eqv?
(bitwise-bit-field (+ (greatest-fixnum) 1) (* (greatest-fixnum) 2) (+ (* (greatest-fixnum) 2) 10))
0)
(eqv?
(bitwise-bit-field (- (least-fixnum) 1) (* (greatest-fixnum) 2) (+ (* (greatest-fixnum) 2) 10))
#b1111111111)
)
(mat bitwise-copy-bit-field
(error? (bitwise-copy-bit-field))
(error? (bitwise-copy-bit-field 0))
(error? (bitwise-copy-bit-field 0 0))
(error? (bitwise-copy-bit-field 0 0 0))
(error? (bitwise-copy-bit-field 0 0 0 0 0))
(error? (bitwise-copy-bit-field 'a 0 0 0))
(error? (bitwise-copy-bit-field 0 0.0 0 0))
(error? (bitwise-copy-bit-field 0 0 2.0 0))
(error? (bitwise-copy-bit-field 0 0 0 3/4))
(error? (bitwise-copy-bit-field 0 -1 0 0))
(error? (bitwise-copy-bit-field 0 (- (most-negative-fixnum) 1) 0 0))
(error? (bitwise-copy-bit-field 0 0 -5 0))
(error? (bitwise-copy-bit-field 0 0 (- (most-negative-fixnum) 1) 0))
(error? (bitwise-copy-bit-field 0 -10 -5 0))
(error? (bitwise-copy-bit-field 0 7 5 0))
(error? (bitwise-copy-bit-field 0 (+ (most-positive-fixnum) 1) (most-positive-fixnum) 0))
(error? (bitwise-copy-bit-field 0 (+ (most-positive-fixnum) 2) (+ (most-positive-fixnum) 1) 0))
(eqv? (bitwise-copy-bit-field 0 0 0 0) 0)
(eqv? (bitwise-copy-bit-field -1 0 0 0) -1)
(eqv? (bitwise-copy-bit-field #b101101011101111 2 7 #b10101010101010) #b101101010101011)
(eqv? (bitwise-copy-bit-field
#xabcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789
12 132
#xdcabe15629dcabe15629dcabe15629dcabe15629)
#xabcdef0123456789abcdef0123456789abcdef012345678dcabe15629dcabe15629dcabe15629789)
(let ()
(define (r6rs-bitwise-copy-bit-field ei1 ei2 ei3 ei4)
(let* ([to ei1]
[start ei2]
[end ei3]
[from ei4]
[mask1 (bitwise-arithmetic-shift-left -1 start)]
[mask2 (bitwise-not (bitwise-arithmetic-shift-left -1 end))]
[mask (bitwise-and mask1 mask2)])
(bitwise-if mask (bitwise-arithmetic-shift-left from start) to)))
(do ([n 500 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (+ (most-positive-fixnum) 1))] [y (+ (most-positive-fixnum) 1)])
(let ([i (random (fixnum-width))] [j (random (fixnum-width))])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (and
(= (bitwise-copy-bit-field x i j y)
(r6rs-bitwise-copy-bit-field x i j y))
(= (bitwise-copy-bit-field (- x) i j y)
(r6rs-bitwise-copy-bit-field (- x) i j y))
(= (bitwise-copy-bit-field x i j (- y))
(r6rs-bitwise-copy-bit-field x i j (- y)))
(= (bitwise-copy-bit-field (- x) i j (- y))
(r6rs-bitwise-copy-bit-field (- x) i j (- y))))
(errorf #f "failed for ~s ~s ~s ~s" x i j y))))))
(do ([n 500 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (expt 10 100))] [y (random (expt 10 1000))])
(let ([len (integer-length x)])
(let ([i (random len)] [j (random len)])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (and
(= (bitwise-copy-bit-field x i j y)
(r6rs-bitwise-copy-bit-field x i j y))
(= (bitwise-copy-bit-field (- x) i j y)
(r6rs-bitwise-copy-bit-field (- x) i j y))
(= (bitwise-copy-bit-field x i j (- y))
(r6rs-bitwise-copy-bit-field x i j (- y)))
(= (bitwise-copy-bit-field (- x) i j (- y))
(r6rs-bitwise-copy-bit-field (- x) i j (- y))))
(errorf #f "failed for ~s ~s ~s ~s" x i j y))))))))
)
(mat bitwise-rotate-bit-field
(error? (bitwise-rotate-bit-field))
(error? (bitwise-rotate-bit-field 0))
(error? (bitwise-rotate-bit-field 0 0))
(error? (bitwise-rotate-bit-field 0 0 0))
(error? (bitwise-rotate-bit-field 0 0 0 0 0))
(error? (bitwise-rotate-bit-field 'a 0 0 0))
(error? (bitwise-rotate-bit-field 0 0.0 0 0))
(error? (bitwise-rotate-bit-field 0 0 2.0 0))
(error? (bitwise-rotate-bit-field 0 0 0 3/4))
(error? (bitwise-rotate-bit-field 0 -1 0 0))
(error? (bitwise-rotate-bit-field 0 (- (most-negative-fixnum) 1) 0 0))
(error? (bitwise-rotate-bit-field 0 0 -5 0))
(error? (bitwise-rotate-bit-field 0 0 (- (most-negative-fixnum) 1) 0))
(error? (bitwise-rotate-bit-field 0 0 0 -1))
(error? (bitwise-rotate-bit-field 0 -10 -5 0))
(error? (bitwise-rotate-bit-field 0 7 5 0))
(error? (bitwise-rotate-bit-field 0 (+ (most-positive-fixnum) 1) (most-positive-fixnum) 0))
(error? (bitwise-rotate-bit-field 0 (+ (most-positive-fixnum) 2) (+ (most-positive-fixnum) 1) 0))
(eqv? (bitwise-rotate-bit-field 0 0 0 0) 0)
(eqv? (bitwise-rotate-bit-field -1 0 0 0) -1)
(eqv?
(bitwise-rotate-bit-field #b101101011101111 2 7 3)
#b101101011111011)
(eqv?
(bitwise-rotate-bit-field #b101101011101111 2 7 153)
#b101101011111011)
(eqv?
(bitwise-rotate-bit-field #b101101011101111 2 7 (+ (expt 5 100) 3))
#b101101011111011)
(eqv?
(bitwise-rotate-bit-field
#xabcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789
12 132 20)
#xabcdef0123456789abcdef0123456789abcdef012345678ef0123456789abcdef01234569abcd789)
(let ()
(define (r6rs-bitwise-rotate-bit-field ei1 ei2 ei3 ei4)
(let* ([n ei1]
[start ei2]
[end ei3]
[count ei4]
[width (- end start)])
(if (positive? width)
(let* ([count (mod count width)]
[field0 (bitwise-bit-field n start end)]
[field1 (bitwise-arithmetic-shift-left field0 count)]
[field2 (bitwise-arithmetic-shift-right field0 (- width count))]
[field (bitwise-ior field1 field2)])
(bitwise-copy-bit-field n start end field))
n)))
(do ([n 500 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (+ (most-positive-fixnum) 1))])
(let ([i (random (fixnum-width))] [j (random (fixnum-width))] [k (random (most-positive-fixnum))])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (and
(= (bitwise-rotate-bit-field x i j k)
(r6rs-bitwise-rotate-bit-field x i j k))
(= (bitwise-rotate-bit-field (- x) i j k)
(r6rs-bitwise-rotate-bit-field (- x) i j k)))
(errorf #f "failed for ~s ~s ~s ~s" x i j k))))))
(do ([n 500 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (expt 10 100))])
(let ([len (integer-length x)])
(let ([i (random len)] [j (random len)] [k (random (* (most-positive-fixnum) 2))])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (and
(= (bitwise-rotate-bit-field x i j k)
(r6rs-bitwise-rotate-bit-field x i j k))
(= (bitwise-rotate-bit-field (- x) i j k)
(r6rs-bitwise-rotate-bit-field (- x) i j k)))
(errorf #f "failed for ~s ~s ~s ~s" x i j k))))))))
)
(mat bitwise-bit-field
(error? (bitwise-reverse-bit-field))
(error? (bitwise-reverse-bit-field 35))
(error? (bitwise-reverse-bit-field 35 5))
(error? (bitwise-reverse-bit-field 35 5 8 15))
(error? (bitwise-reverse-bit-field 35.0 5 8))
(error? (bitwise-reverse-bit-field 35 5.0 8))
(error? (bitwise-reverse-bit-field 35 5 8.0))
(error? (bitwise-reverse-bit-field 'a 5 8))
(error? (bitwise-reverse-bit-field 35 '(a b) 8))
(error? (bitwise-reverse-bit-field 35 5 "hello"))
(error? (bitwise-reverse-bit-field 35 -5 8))
(error? (bitwise-reverse-bit-field 35 5 -8))
(error? (bitwise-reverse-bit-field 35 5 3))
(error? (bitwise-reverse-bit-field 35 (+ (* (greatest-fixnum) 2) 10) (* (greatest-fixnum) 2)))
(eqv? (bitwise-reverse-bit-field 35 100 150) 35)
(eqv? (bitwise-reverse-bit-field -35 100 150) -35)
(eqv? (bitwise-reverse-bit-field 0 0 10) 0)
(eqv? (bitwise-reverse-bit-field -1 0 10) -1)
(eqv?
(bitwise-reverse-bit-field #b101101011101111 2 7)
#b101101011101111)
(eqv?
(bitwise-reverse-bit-field #b101101011101111 3 9)
#b101101101110111)
(eqv?
(bitwise-reverse-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1))
(greatest-fixnum))
(eqv?
(bitwise-reverse-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1))
(greatest-fixnum))
(eqv?
(bitwise-reverse-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1))
(least-fixnum))
(eqv?
(bitwise-reverse-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1))
(least-fixnum))
(eqv?
(bitwise-reverse-bit-field -1 0 (fx- (fixnum-width) 1))
-1)
(eqv?
(bitwise-reverse-bit-field -1 0 (fx- (fixnum-width) 1))
-1)
(let ()
(define (refimpl n start end)
(define (swap n i j)
(bitwise-copy-bit
(bitwise-copy-bit n i (bitwise-bit-field n j (+ j 1)))
j (bitwise-bit-field n i (+ i 1))))
(let ([end (- end 1)])
(if (>= start end)
n
(refimpl (swap n start end) (+ start 1) end))))
(do ([n 500 (- n 1)])
((= n 0) #t)
(let* ([x (random (expt (greatest-fixnum) 10))]
[maxend (+ (bitwise-length x) 10)])
(let ([i (random maxend)] [j (random maxend)])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (and
(= (bitwise-reverse-bit-field x i j)
(refimpl x i j))
(= (bitwise-reverse-bit-field (- x) i j)
(refimpl (- x) i j)))
(errorf #f "failed for ~s ~s ~s" x i j)))))))
)
(mat exact-integer-sqrt
(error? (exact-integer-sqrt))
(error? (exact-integer-sqrt 3 4))
(error? (exact-integer-sqrt 1.0))
(error? (exact-integer-sqrt 'a))
(error? (exact-integer-sqrt -1))
(error? (exact-integer-sqrt 10.0+0.0i))
(begin
(define ($eispair x)
(call-with-values (lambda () (exact-integer-sqrt x)) cons))
#t)
(equal? ($eispair 1) '(1 . 0))
(equal? ($eispair 9) '(3 . 0))
(equal? ($eispair 10) '(3 . 1))
(equal? ($eispair 1000) '(31 . 39))
(do ([n 1000 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (expt 10 1000))])
(unless (let ([p ($eispair x)])
(let ([s (car p)] [r (cdr p)])
(and (<= (* s s) x)
(> (* (+ s 1) (+ s 1)) x)
(= (+ (* s s) r) x))))
(errorf #f "failed for ~s" x))))
)
(define x -11111111111111111111111111111111111111111111111)
(define n -10)
(mat integer-length
(error? (integer-length))
(error? (integer-length 1 1 1))
(error? (integer-length .1))
(= (integer-length 0) 0)
(= (integer-length 1) 1)
(= (integer-length 3) 2)
(= (integer-length 4) 3)
(= (integer-length 7) 3)
(= (integer-length -1) 0)
(= (integer-length -4) 2)
(= (integer-length -7) 3)
(= (integer-length -8) 3)
(= (integer-length (expt 2 1000)) 1001)
(= (integer-length (+ (expt 2 1000) 1)) 1001)
(= (integer-length (- (expt 2 1000) 1)) 1000)
(= (integer-length (- (expt 2 1000))) 1000)
(= (integer-length (- -1 (expt 2 1000))) 1001)
(= (integer-length (- 1 (expt 2 1000))) 1000)
)
(mat bitwise-length
(error? (bitwise-length))
(error? (bitwise-length 1 1 1))
(error? (bitwise-length .1))
(= (bitwise-length 0) 0)
(= (bitwise-length 1) 1)
(= (bitwise-length 3) 2)
(= (bitwise-length 4) 3)
(= (bitwise-length 7) 3)
(= (bitwise-length -1) 0)
(= (bitwise-length -4) 2)
(= (bitwise-length -7) 3)
(= (bitwise-length -8) 3)
(= (bitwise-length (expt 2 1000)) 1001)
(= (bitwise-length (+ (expt 2 1000) 1)) 1001)
(= (bitwise-length (- (expt 2 1000) 1)) 1000)
(= (bitwise-length (- (expt 2 1000))) 1000)
(= (bitwise-length (- -1 (expt 2 1000))) 1001)
(= (bitwise-length (- 1 (expt 2 1000))) 1000)
(let ()
(define r6rs-length
(lambda (x)
(do ([result 0 (+ result 1)]
[bits (if (negative? x) (bitwise-not x) x)
(bitwise-arithmetic-shift-right bits 1)])
((zero? bits) result))))
(let f ([n 10000])
(or (= n 0)
(let ([x (random (expt 2 1000))])
(and (= (bitwise-length x) (r6rs-length x))
(= (bitwise-length (- x)) (r6rs-length (- x)))
(f (- n 1)))))))
)
(mat bitwise-bit-count
(error? (bitwise-bit-count))
(error? (bitwise-bit-count 75 32))
(error? (bitwise-bit-count 3.0))
(error? (bitwise-bit-count 'a))
(eqv? (bitwise-bit-count 0) 0)
(eqv? (bitwise-bit-count #xabcd) 10)
(eqv? (bitwise-bit-count #xabcdf0123456789abcdef0123456789) 61)
(eqv? (bitwise-bit-count -1) -1)
(eqv? (bitwise-bit-count -10) -3)
(equal?
(map bitwise-bit-count '(0 1 2 3 4 5 6 7 8 9 10))
'(0 1 1 2 1 2 2 3 1 2 2))
(equal?
(map bitwise-bit-count '(-1 -2 -3 -4 -5 -6 -7 -8 -9 -10))
'(-1 -2 -2 -3 -2 -3 -3 -4 -2 -3))
(let ([n (expt (+ (greatest-fixnum) 1) 4)])
(let f ([i 2] [j 1])
(or (= i n)
(and (eqv? (bitwise-bit-count i) 1)
(eqv? (bitwise-bit-count (+ i 1)) 2)
(eqv? (bitwise-bit-count (- i 1)) j)
(f (bitwise-arithmetic-shift i 1) (+ j 1))))))
(let ([n (expt (+ (greatest-fixnum) 1) 4)])
(define slow-bit-count
(lambda (x)
(if (< x 0)
(bitwise-not (slow-bit-count (bitwise-not x)))
(let f ([x x] [c 0])
(if (= x 0)
c
(f (bitwise-arithmetic-shift-right x 1)
(if (bitwise-bit-set? x 0) (+ c 1) c)))))))
(let f ([i 10000])
(let ([r (random n)])
(or (fx= i 0)
(and (= (bitwise-bit-count r) (slow-bit-count r))
(= (bitwise-bit-count (- r)) (slow-bit-count (- r)))
(f (fx- i 1)))))))
)
(mat bitwise-first-bit-set
(error? (bitwise-first-bit-set))
(error? (bitwise-first-bit-set 75 32))
(error? (bitwise-first-bit-set 3.0))
(error? (bitwise-first-bit-set 'a))
(eqv? (bitwise-first-bit-set 0) -1)
(eqv? (bitwise-first-bit-set 1) 0)
(eqv? (bitwise-first-bit-set -1) 0)
(eqv? (bitwise-first-bit-set -4) 2)
(eqv? (bitwise-first-bit-set #xabcdf0123400000000000000000) 70)
(eqv? (bitwise-first-bit-set #x-abcdf0123400000000000000000) 70)
(equal?
(map bitwise-first-bit-set '(0 1 2 3 4 5 6 7 8 9 10))
'(-1 0 1 0 2 0 1 0 3 0 1))
(equal?
(map bitwise-first-bit-set '(-1 -2 -3 -4 -5 -6 -7 -8 -9 -10))
'(0 1 0 2 0 1 0 3 0 1))
(let ([n (expt (+ (greatest-fixnum) 1) 4)])
(let f ([i 2] [j 1])
(or (= i n)
(and (eqv? (bitwise-first-bit-set i) j)
(eqv? (bitwise-first-bit-set (+ i 1)) 0)
(eqv? (bitwise-first-bit-set (- i 1)) 0)
(f (bitwise-arithmetic-shift i 1) (fx+ j 1))))))
(let ([n (+ (greatest-fixnum) 1)])
(define slow-first-bit-set
(lambda (x)
(if (= x 0)
0
(let f ([x x])
(if (odd? x) 0 (+ (f (bitwise-arithmetic-shift-right x 1)) 1))))))
(let f ([i 10000])
(let ([r (bitwise-arithmetic-shift-left (random n) (random 100))])
(unless (fx= i 0)
(unless (and (= (bitwise-first-bit-set r) (slow-first-bit-set r))
(= (bitwise-first-bit-set (- r)) (slow-first-bit-set (- r))))
(errorf #f "failed for ~s" r))
(f (fx- i 1)))))
#t)
)
(define quotient-remainder
(parameterize ([subset-mode 'system])
(eval '$quotient-remainder)))
(mat $quotient-remainder
(error? (quotient-remainder))
(error? (quotient-remainder 1))
(error? (quotient-remainder 1 1 1))
(error? (quotient-remainder 1 0))
(equal? (quotient-remainder 103 5) '(20 . 3))
(equal? (quotient-remainder 103 -5) '(-20 . 3))
(equal? (quotient-remainder -103 5) '(-20 . -3))
(equal? (quotient-remainder -103 -5) '( 20 . -3))
(let ([x 11111111111111111] [y 11111111111111])
(equal? (quotient-remainder x y) (cons (quotient x y) (remainder x y))))
(let ([x 11111111111111111] [y -11111111111111])
(equal? (quotient-remainder x y) (cons (quotient x y) (remainder x y))))
(let ([x -11111111111111111] [y 11111111111111])
(equal? (quotient-remainder x y) (cons (quotient x y) (remainder x y))))
(let ([x -11111111111111111] [y -11111111111111])
(equal? (quotient-remainder x y) (cons (quotient x y) (remainder x y))))
;; following returns incorrect result in all versions prior to 5.9b
(equal? (quotient-remainder (most-negative-fixnum)
(- (most-negative-fixnum)))
'(-1 . 0))
)
(mat lognot
(error? (lognot (void)))
(error? (lognot "hello"))
(error? (lognot 3/4))
(error? (lognot 7.7))
(error? (lognot 1+3i))
(error? (lognot 1.0-7.5i))
(error? (lognot 3.0))
(eqv? (lognot 0) -1)
(eqv? (lognot -1) 0)
(eqv? (lognot 2) -3)
(eqv? (lognot #xfffffffffffffffffffffffffffff)
#x-100000000000000000000000000000)
(eqv? (lognot #x-100000000000000000000000000000)
#xfffffffffffffffffffffffffffff)
)
(mat bitwise-not
(error? (bitwise-not (void)))
(error? (bitwise-not "hello"))
(error? (bitwise-not 3/4))
(error? (bitwise-not 7.7))
(error? (bitwise-not 1+3i))
(error? (bitwise-not 1.0-7.5i))
(error? (bitwise-not 3.0))
(eqv? (bitwise-not 0) -1)
(eqv? (bitwise-not -1) 0)
(eqv? (bitwise-not 2) -3)
(eqv? (bitwise-not #xfffffffffffffffffffffffffffff)
#x-100000000000000000000000000000)
(eqv? (bitwise-not #x-100000000000000000000000000000)
#xfffffffffffffffffffffffffffff)
)
(mat logand
(error? (logand (void) 0))
(error? (logand 0 (void)))
(error? (logand 'a 17))
(error? (logand 17 'a))
(error? (logand 25 "oops"))
(error? (logand "oops" 25))
(error? (logand 25 3.4))
(error? (logand 3.4 25))
(error? (logand 0 3/4))
(error? (logand 3/4 0))
(error? (logand 0 1+1i))
(error? (logand 1+1i 0))
(error? (logand 1 3.4-2.3i))
(error? (logand 3.4-2.3i 1))
(error? (logand 3.0 4.0))
(eqv? (logand 0 0) 0)
(eqv? (logand -1 0) 0)
(eqv? (logand #xfffffffffffffffffffffffff 0) 0)
(eqv? (logand 0 -1) 0)
(eqv? (logand 0 #xfffffffffffffffffffffffff) 0)
(eqv? (logand 20 -1) 20)
(eqv? (logand #xfffffffffffffffffffffffff -1) #xfffffffffffffffffffffffff)
(eqv? (logand #x1111111111111111111111111 -1) #x1111111111111111111111111)
(eqv? (logand (- (expt 2 300) 167) -1) (- (expt 2 300) 167))
(eqv? (logand (- 167 (expt 2 300)) -1) (- 167 (expt 2 300)))
(eqv? (logand (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(eqv? (logand (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(eqv? (logand #x1111111111111111111111111 #x2222222222222222222222222) 0)
(eqv? (logand #x1212121212121212121212121 #x2222222222222222222222222)
#x202020202020202020202020)
(eqv? (logand #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-3232323232323232323232322)
(eqv? (logand #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#xECC8A9876543210010146088A8CCF)
(eqv? (logand #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x20025020749C106C200189100)
(eqv? (logand #x2B225D27F49C1FED301B89103
#x1F366567)
#x1300103)
(eqv? (logand #x2B225D27F49C1FED301B89103
#x-717D004)
#x2B225D27F49C1FED300A80100)
(eqv? (logand #x-F2D8DD782236F835A1A50858
#x1F366567)
#x1E126520)
(eqv? (logand #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-F2D8DD782236F835A7B7D858)
(eqv? (logand #x1F366567
#x2B225D27F49C1FED301B89103)
#x1300103)
(eqv? (logand #x-717D004
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED300A80100)
(eqv? (logand #x1F366567
#x-F2D8DD782236F835A1A50858)
#x1E126520)
(eqv? (logand #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A7B7D858)
(eqv? (logand) -1)
(eqv? (logand #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (logand #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x2000200020002000200020)
(eqv? (logand #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(eqv? (logand #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
(test-cp0-expansion eqv? '(logand 0 0) 0)
(test-cp0-expansion eqv? '(logand -1 0) 0)
(test-cp0-expansion eqv? '(logand #xfffffffffffffffffffffffff 0) 0)
(test-cp0-expansion eqv? '(logand 0 -1) 0)
(test-cp0-expansion eqv? '(logand 0 #xfffffffffffffffffffffffff) 0)
(test-cp0-expansion eqv? '(logand 20 -1) 20)
(test-cp0-expansion eqv? '(logand #xfffffffffffffffffffffffff -1) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logand #x1111111111111111111111111 -1) #x1111111111111111111111111)
(test-cp0-expansion eqv? '(logand (- (expt 2 300) 167) -1) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(logand (- 167 (expt 2 300)) -1) (- 167 (expt 2 300)))
(test-cp0-expansion eqv? '(logand (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(logand (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(test-cp0-expansion eqv? '(logand #x1111111111111111111111111 #x2222222222222222222222222) 0)
(test-cp0-expansion eqv? '(logand #x1212121212121212121212121 #x2222222222222222222222222)
#x202020202020202020202020)
(test-cp0-expansion eqv?
'(logand #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-3232323232323232323232322)
(test-cp0-expansion eqv?
'(logand #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#xECC8A9876543210010146088A8CCF)
(test-cp0-expansion eqv?
'(logand #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x20025020749C106C200189100)
(test-cp0-expansion eqv?
'(logand #x2B225D27F49C1FED301B89103
#x1F366567)
#x1300103)
(test-cp0-expansion eqv?
'(logand #x2B225D27F49C1FED301B89103
#x-717D004)
#x2B225D27F49C1FED300A80100)
(test-cp0-expansion eqv?
'(logand #x-F2D8DD782236F835A1A50858
#x1F366567)
#x1E126520)
(test-cp0-expansion eqv?
'(logand #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-F2D8DD782236F835A7B7D858)
(test-cp0-expansion eqv?
'(logand #x1F366567
#x2B225D27F49C1FED301B89103)
#x1300103)
(test-cp0-expansion eqv?
'(logand #x-717D004
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED300A80100)
(test-cp0-expansion eqv?
'(logand #x1F366567
#x-F2D8DD782236F835A1A50858)
#x1E126520)
(test-cp0-expansion eqv?
'(logand #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A7B7D858)
(test-cp0-expansion eqv?
'(logand) -1)
(test-cp0-expansion eqv?
'(logand #x1212121212121212121212121)
#x1212121212121212121212121)
(test-cp0-expansion eqv?
'(logand #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x2000200020002000200020)
(test-cp0-expansion eqv?
'(logand #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(test-cp0-expansion eqv?
'(logand #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
)
(mat bitwise-and
(error? (bitwise-and (void) 0))
(error? (bitwise-and 0 (void)))
(error? (bitwise-and 'a 17))
(error? (bitwise-and 17 'a))
(error? (bitwise-and 25 "oops"))
(error? (bitwise-and "oops" 25))
(error? (bitwise-and 25 3.4))
(error? (bitwise-and 3.4 25))
(error? (bitwise-and 0 3/4))
(error? (bitwise-and 3/4 0))
(error? (bitwise-and 0 1+1i))
(error? (bitwise-and 1+1i 0))
(error? (bitwise-and 1 3.4-2.3i))
(error? (bitwise-and 3.4-2.3i 1))
(error? (bitwise-and 3.0 4.0))
(eqv? (bitwise-and 0 0) 0)
(eqv? (bitwise-and -1 0) 0)
(eqv? (bitwise-and #xfffffffffffffffffffffffff 0) 0)
(eqv? (bitwise-and 0 -1) 0)
(eqv? (bitwise-and 0 #xfffffffffffffffffffffffff) 0)
(eqv? (bitwise-and 20 -1) 20)
(eqv? (bitwise-and #xfffffffffffffffffffffffff -1) #xfffffffffffffffffffffffff)
(eqv? (bitwise-and #x1111111111111111111111111 -1) #x1111111111111111111111111)
(eqv? (bitwise-and (- (expt 2 300) 167) -1) (- (expt 2 300) 167))
(eqv? (bitwise-and (- 167 (expt 2 300)) -1) (- 167 (expt 2 300)))
(eqv? (bitwise-and (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(eqv? (bitwise-and (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(eqv? (bitwise-and #x1111111111111111111111111 #x2222222222222222222222222) 0)
(eqv? (bitwise-and #x1212121212121212121212121 #x2222222222222222222222222)
#x202020202020202020202020)
(eqv? (bitwise-and #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-3232323232323232323232322)
(eqv? (bitwise-and #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#xECC8A9876543210010146088A8CCF)
(eqv? (bitwise-and #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x20025020749C106C200189100)
(eqv? (bitwise-and #x2B225D27F49C1FED301B89103
#x1F366567)
#x1300103)
(eqv? (bitwise-and #x2B225D27F49C1FED301B89103
#x-717D004)
#x2B225D27F49C1FED300A80100)
(eqv? (bitwise-and #x-F2D8DD782236F835A1A50858
#x1F366567)
#x1E126520)
(eqv? (bitwise-and #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-F2D8DD782236F835A7B7D858)
(eqv? (bitwise-and #x1F366567
#x2B225D27F49C1FED301B89103)
#x1300103)
(eqv? (bitwise-and #x-717D004
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED300A80100)
(eqv? (bitwise-and #x1F366567
#x-F2D8DD782236F835A1A50858)
#x1E126520)
(eqv? (bitwise-and #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A7B7D858)
(eqv? (bitwise-and) -1)
(eqv? (bitwise-and #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (bitwise-and #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x2000200020002000200020)
(eqv? (bitwise-and #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(eqv? (bitwise-and #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
(test-cp0-expansion eqv? '(bitwise-and 0 0) 0)
(test-cp0-expansion eqv? '(bitwise-and -1 0) 0)
(test-cp0-expansion eqv? '(bitwise-and #xfffffffffffffffffffffffff 0) 0)
(test-cp0-expansion eqv? '(bitwise-and 0 -1) 0)
(test-cp0-expansion eqv? '(bitwise-and 0 #xfffffffffffffffffffffffff) 0)
(test-cp0-expansion eqv? '(bitwise-and 20 -1) 20)
(test-cp0-expansion eqv? '(bitwise-and #xfffffffffffffffffffffffff -1) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(bitwise-and #x1111111111111111111111111 -1) #x1111111111111111111111111)
(test-cp0-expansion eqv? '(bitwise-and (- (expt 2 300) 167) -1) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(bitwise-and (- 167 (expt 2 300)) -1) (- 167 (expt 2 300)))
(test-cp0-expansion eqv? '(bitwise-and (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(bitwise-and (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(test-cp0-expansion eqv? '(bitwise-and #x1111111111111111111111111 #x2222222222222222222222222) 0)
(test-cp0-expansion eqv? '(bitwise-and #x1212121212121212121212121 #x2222222222222222222222222)
#x202020202020202020202020)
(test-cp0-expansion eqv?
'(bitwise-and #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-3232323232323232323232322)
(test-cp0-expansion eqv?
'(bitwise-and #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#xECC8A9876543210010146088A8CCF)
(test-cp0-expansion eqv?
'(bitwise-and #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x20025020749C106C200189100)
(test-cp0-expansion eqv?
'(bitwise-and #x2B225D27F49C1FED301B89103
#x1F366567)
#x1300103)
(test-cp0-expansion eqv?
'(bitwise-and #x2B225D27F49C1FED301B89103
#x-717D004)
#x2B225D27F49C1FED300A80100)
(test-cp0-expansion eqv?
'(bitwise-and #x-F2D8DD782236F835A1A50858
#x1F366567)
#x1E126520)
(test-cp0-expansion eqv?
'(bitwise-and #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-F2D8DD782236F835A7B7D858)
(test-cp0-expansion eqv?
'(bitwise-and #x1F366567
#x2B225D27F49C1FED301B89103)
#x1300103)
(test-cp0-expansion eqv?
'(bitwise-and #x-717D004
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED300A80100)
(test-cp0-expansion eqv?
'(bitwise-and #x1F366567
#x-F2D8DD782236F835A1A50858)
#x1E126520)
(test-cp0-expansion eqv?
'(bitwise-and #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A7B7D858)
(test-cp0-expansion eqv?
'(bitwise-and) -1)
(test-cp0-expansion eqv?
'(bitwise-and #x1212121212121212121212121)
#x1212121212121212121212121)
(test-cp0-expansion eqv?
'(bitwise-and #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x2000200020002000200020)
(test-cp0-expansion eqv?
'(bitwise-and #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(test-cp0-expansion eqv?
'(bitwise-and #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
)
(mat logior ; same as logor
(error? (logior (void) 0))
(error? (logior 0 (void)))
(error? (logior 'a 17))
(error? (logior 17 'a))
(error? (logior 25 "oops"))
(error? (logior "oops" 25))
(error? (logior 25 3.4))
(error? (logior 3.4 25))
(error? (logior 0 3/4))
(error? (logior 3/4 0))
(error? (logior 0 1+1i))
(error? (logior 1+1i 0))
(error? (logior 1 3.4-2.3i))
(error? (logior 3.4-2.3i 1))
(error? (logior 3.0 4.0))
(eqv? (logior 0 0) 0)
(eqv? (logior -1 0) -1)
(eqv? (logior #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(eqv? (logior 0 -1) -1)
(eqv? (logior 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(eqv? (logior 20 -1) -1)
(eqv? (logior #xfffffffffffffffffffffffff -1) -1)
(eqv? (logior #x1111111111111111111111111 -1) -1)
(eqv? (logior (- (expt 2 300) 167) -1) -1)
(eqv? (logior (- 167 (expt 2 300)) -1) -1)
(eqv? (logior (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(eqv? (logior (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(eqv? (logior #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(eqv? (logior #x1212121212121212121212121 #x2222222222222222222222222)
#x3232323232323232323232323)
(eqv? (logior #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-202020202020202020202021)
(eqv? (logior #x-3333333333333333333333333 #x-2222222222222222222222222)
#x-2222222222222222222222221)
(eqv? (logior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(eqv? (logior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(eqv? (logior #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-2056789ABCDEEDC988806440201)
(eqv? (logior #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-40D80D0022360024A0050855)
(eqv? (logior #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31FBEF567)
(eqv? (logior #x2B225D27F49C1FED301B89103
#x-717D004)
#x-6074001)
(eqv? (logior #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835A0810811)
(eqv? (logior #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-1050004)
(eqv? (logior #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31FBEF567)
(eqv? (logior #x-717D004
#x2B225D27F49C1FED301B89103)
#x-6074001)
(eqv? (logior #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A0810811)
(eqv? (logior #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-1050004)
(eqv? (logior) 0)
(eqv? (logior #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (logior #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3333333333333333333333333)
(eqv? (logior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(eqv? (logior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
(test-cp0-expansion eqv? '(logior 0 0) 0)
(test-cp0-expansion eqv? '(logior -1 0) -1)
(test-cp0-expansion eqv? '(logior #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logior 0 -1) -1)
(test-cp0-expansion eqv? '(logior 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logior 20 -1) -1)
(test-cp0-expansion eqv? '(logior #xfffffffffffffffffffffffff -1) -1)
(test-cp0-expansion eqv? '(logior #x1111111111111111111111111 -1) -1)
(test-cp0-expansion eqv? '(logior (- (expt 2 300) 167) -1) -1)
(test-cp0-expansion eqv? '(logior (- 167 (expt 2 300)) -1) -1)
(test-cp0-expansion eqv? '(logior (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(logior (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(test-cp0-expansion eqv?
'(logior #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(logior #x1212121212121212121212121 #x2222222222222222222222222)
#x3232323232323232323232323)
(test-cp0-expansion eqv?
'(logior #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-202020202020202020202021)
(test-cp0-expansion eqv?
'(logior #x-3333333333333333333333333 #x-2222222222222222222222222)
#x-2222222222222222222222221)
(test-cp0-expansion eqv?
'(logior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(test-cp0-expansion eqv?
'(logior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(test-cp0-expansion eqv?
'(logior #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-2056789ABCDEEDC988806440201)
(test-cp0-expansion eqv?
'(logior #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-40D80D0022360024A0050855)
(test-cp0-expansion eqv?
'(logior #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31FBEF567)
(test-cp0-expansion eqv?
'(logior #x2B225D27F49C1FED301B89103
#x-717D004)
#x-6074001)
(test-cp0-expansion eqv?
'(logior #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835A0810811)
(test-cp0-expansion eqv?
'(logior #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-1050004)
(test-cp0-expansion eqv?
'(logior #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31FBEF567)
(test-cp0-expansion eqv?
'(logior #x-717D004
#x2B225D27F49C1FED301B89103)
#x-6074001)
(test-cp0-expansion eqv?
'(logior #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A0810811)
(test-cp0-expansion eqv?
'(logior #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-1050004)
(test-cp0-expansion eqv? '(logior) 0)
(test-cp0-expansion eqv? '(logior #x1212121212121212121212121)
#x1212121212121212121212121)
(test-cp0-expansion eqv?
'(logior #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(logior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(test-cp0-expansion eqv?
'(logior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
)
(mat logor
(error? (logor (void) 0))
(error? (logor 0 (void)))
(error? (logor 'a 17))
(error? (logor 17 'a))
(error? (logor 25 "oops"))
(error? (logor "oops" 25))
(error? (logor 25 3.4))
(error? (logor 3.4 25))
(error? (logor 0 3/4))
(error? (logor 3/4 0))
(error? (logor 0 1+1i))
(error? (logor 1+1i 0))
(error? (logor 1 3.4-2.3i))
(error? (logor 3.4-2.3i 1))
(error? (logor 3.0 4.0))
(eqv? (logor 0 0) 0)
(eqv? (logor -1 0) -1)
(eqv? (logor #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(eqv? (logor 0 -1) -1)
(eqv? (logor 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(eqv? (logor 20 -1) -1)
(eqv? (logor #xfffffffffffffffffffffffff -1) -1)
(eqv? (logor #x1111111111111111111111111 -1) -1)
(eqv? (logor (- (expt 2 300) 167) -1) -1)
(eqv? (logor (- 167 (expt 2 300)) -1) -1)
(eqv? (logor (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(eqv? (logor (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(eqv? (logor #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(eqv? (logor #x1212121212121212121212121 #x2222222222222222222222222)
#x3232323232323232323232323)
(eqv? (logor #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-202020202020202020202021)
(eqv? (logor #x-3333333333333333333333333 #x-2222222222222222222222222)
#x-2222222222222222222222221)
(eqv? (logor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(eqv? (logor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(eqv? (logor #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-2056789ABCDEEDC988806440201)
(eqv? (logor #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-40D80D0022360024A0050855)
(eqv? (logor #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31FBEF567)
(eqv? (logor #x2B225D27F49C1FED301B89103
#x-717D004)
#x-6074001)
(eqv? (logor #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835A0810811)
(eqv? (logor #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-1050004)
(eqv? (logor #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31FBEF567)
(eqv? (logor #x-717D004
#x2B225D27F49C1FED301B89103)
#x-6074001)
(eqv? (logor #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A0810811)
(eqv? (logor #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-1050004)
(eqv? (logor) 0)
(eqv? (logor #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (logor #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3333333333333333333333333)
(eqv? (logor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(eqv? (logor #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
(test-cp0-expansion eqv? '(logor 0 0) 0)
(test-cp0-expansion eqv? '(logor -1 0) -1)
(test-cp0-expansion eqv? '(logor #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logor 0 -1) -1)
(test-cp0-expansion eqv? '(logor 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logor 20 -1) -1)
(test-cp0-expansion eqv? '(logor #xfffffffffffffffffffffffff -1) -1)
(test-cp0-expansion eqv? '(logor #x1111111111111111111111111 -1) -1)
(test-cp0-expansion eqv? '(logor (- (expt 2 300) 167) -1) -1)
(test-cp0-expansion eqv? '(logor (- 167 (expt 2 300)) -1) -1)
(test-cp0-expansion eqv? '(logor (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(logor (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(test-cp0-expansion eqv?
'(logor #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(logor #x1212121212121212121212121 #x2222222222222222222222222)
#x3232323232323232323232323)
(test-cp0-expansion eqv?
'(logor #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-202020202020202020202021)
(test-cp0-expansion eqv?
'(logor #x-3333333333333333333333333 #x-2222222222222222222222222)
#x-2222222222222222222222221)
(test-cp0-expansion eqv?
'(logor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(test-cp0-expansion eqv?
'(logor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(test-cp0-expansion eqv?
'(logor #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-2056789ABCDEEDC988806440201)
(test-cp0-expansion eqv?
'(logor #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-40D80D0022360024A0050855)
(test-cp0-expansion eqv?
'(logor #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31FBEF567)
(test-cp0-expansion eqv?
'(logor #x2B225D27F49C1FED301B89103
#x-717D004)
#x-6074001)
(test-cp0-expansion eqv?
'(logor #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835A0810811)
(test-cp0-expansion eqv?
'(logor #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-1050004)
(test-cp0-expansion eqv?
'(logor #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31FBEF567)
(test-cp0-expansion eqv?
'(logor #x-717D004
#x2B225D27F49C1FED301B89103)
#x-6074001)
(test-cp0-expansion eqv?
'(logor #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A0810811)
(test-cp0-expansion eqv?
'(logor #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-1050004)
(test-cp0-expansion eqv? '(logor) 0)
(test-cp0-expansion eqv? '(logor #x1212121212121212121212121)
#x1212121212121212121212121)
(test-cp0-expansion eqv?
'(logor #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(logor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(test-cp0-expansion eqv?
'(logor #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
)
(mat bitwise-ior ; same as logor
(error? (bitwise-ior (void) 0))
(error? (bitwise-ior 0 (void)))
(error? (bitwise-ior 'a 17))
(error? (bitwise-ior 17 'a))
(error? (bitwise-ior 25 "oops"))
(error? (bitwise-ior "oops" 25))
(error? (bitwise-ior 25 3.4))
(error? (bitwise-ior 3.4 25))
(error? (bitwise-ior 0 3/4))
(error? (bitwise-ior 3/4 0))
(error? (bitwise-ior 0 1+1i))
(error? (bitwise-ior 1+1i 0))
(error? (bitwise-ior 1 3.4-2.3i))
(error? (bitwise-ior 3.4-2.3i 1))
(error? (bitwise-ior 3.0 4.0))
(eqv? (bitwise-ior 0 0) 0)
(eqv? (bitwise-ior -1 0) -1)
(eqv? (bitwise-ior #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(eqv? (bitwise-ior 0 -1) -1)
(eqv? (bitwise-ior 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(eqv? (bitwise-ior 20 -1) -1)
(eqv? (bitwise-ior #xfffffffffffffffffffffffff -1) -1)
(eqv? (bitwise-ior #x1111111111111111111111111 -1) -1)
(eqv? (bitwise-ior (- (expt 2 300) 167) -1) -1)
(eqv? (bitwise-ior (- 167 (expt 2 300)) -1) -1)
(eqv? (bitwise-ior (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(eqv? (bitwise-ior (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(eqv? (bitwise-ior #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(eqv? (bitwise-ior #x1212121212121212121212121 #x2222222222222222222222222)
#x3232323232323232323232323)
(eqv? (bitwise-ior #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-202020202020202020202021)
(eqv? (bitwise-ior #x-3333333333333333333333333 #x-2222222222222222222222222)
#x-2222222222222222222222221)
(eqv? (bitwise-ior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(eqv? (bitwise-ior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(eqv? (bitwise-ior #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-2056789ABCDEEDC988806440201)
(eqv? (bitwise-ior #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-40D80D0022360024A0050855)
(eqv? (bitwise-ior #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31FBEF567)
(eqv? (bitwise-ior #x2B225D27F49C1FED301B89103
#x-717D004)
#x-6074001)
(eqv? (bitwise-ior #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835A0810811)
(eqv? (bitwise-ior #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-1050004)
(eqv? (bitwise-ior #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31FBEF567)
(eqv? (bitwise-ior #x-717D004
#x2B225D27F49C1FED301B89103)
#x-6074001)
(eqv? (bitwise-ior #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A0810811)
(eqv? (bitwise-ior #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-1050004)
(eqv? (bitwise-ior) 0)
(eqv? (bitwise-ior #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (bitwise-ior #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3333333333333333333333333)
(eqv? (bitwise-ior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(eqv? (bitwise-ior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
(test-cp0-expansion eqv? '(bitwise-ior 0 0) 0)
(test-cp0-expansion eqv? '(bitwise-ior -1 0) -1)
(test-cp0-expansion eqv? '(bitwise-ior #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(bitwise-ior 0 -1) -1)
(test-cp0-expansion eqv? '(bitwise-ior 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(bitwise-ior 20 -1) -1)
(test-cp0-expansion eqv? '(bitwise-ior #xfffffffffffffffffffffffff -1) -1)
(test-cp0-expansion eqv? '(bitwise-ior #x1111111111111111111111111 -1) -1)
(test-cp0-expansion eqv? '(bitwise-ior (- (expt 2 300) 167) -1) -1)
(test-cp0-expansion eqv? '(bitwise-ior (- 167 (expt 2 300)) -1) -1)
(test-cp0-expansion eqv? '(bitwise-ior (- (expt 2 300) 167) (- (expt 2 300) 167)) (- (expt 2 300) 167))
(test-cp0-expansion eqv? '(bitwise-ior (- 167 (expt 2 300)) (- 167 (expt 2 300))) (- 167 (expt 2 300)))
(test-cp0-expansion eqv?
'(bitwise-ior #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(bitwise-ior #x1212121212121212121212121 #x2222222222222222222222222)
#x3232323232323232323232323)
(test-cp0-expansion eqv?
'(bitwise-ior #x-1212121212121212121212121
#x-2222222222222222222222222)
#x-202020202020202020202021)
(test-cp0-expansion eqv?
'(bitwise-ior #x-3333333333333333333333333 #x-2222222222222222222222222)
#x-2222222222222222222222221)
(test-cp0-expansion eqv?
'(bitwise-ior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(test-cp0-expansion eqv?
'(bitwise-ior #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#x-12140000000000122442181214121)
(test-cp0-expansion eqv?
'(bitwise-ior #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-2056789ABCDEEDC988806440201)
(test-cp0-expansion eqv?
'(bitwise-ior #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-40D80D0022360024A0050855)
(test-cp0-expansion eqv?
'(bitwise-ior #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31FBEF567)
(test-cp0-expansion eqv?
'(bitwise-ior #x2B225D27F49C1FED301B89103
#x-717D004)
#x-6074001)
(test-cp0-expansion eqv?
'(bitwise-ior #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835A0810811)
(test-cp0-expansion eqv?
'(bitwise-ior #x-F2D8DD782236F835A1A50858
#x-717D004)
#x-1050004)
(test-cp0-expansion eqv?
'(bitwise-ior #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31FBEF567)
(test-cp0-expansion eqv?
'(bitwise-ior #x-717D004
#x2B225D27F49C1FED301B89103)
#x-6074001)
(test-cp0-expansion eqv?
'(bitwise-ior #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835A0810811)
(test-cp0-expansion eqv?
'(bitwise-ior #x-717D004
#x-F2D8DD782236F835A1A50858)
#x-1050004)
(test-cp0-expansion eqv? '(bitwise-ior) 0)
(test-cp0-expansion eqv? '(bitwise-ior #x1212121212121212121212121)
#x1212121212121212121212121)
(test-cp0-expansion eqv?
'(bitwise-ior #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(bitwise-ior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(test-cp0-expansion eqv?
'(bitwise-ior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
)
(mat logxor
(error? (logxor (void) 0))
(error? (logxor 0 (void)))
(error? (logxor 'a 17))
(error? (logxor 17 'a))
(error? (logxor 25 "oops"))
(error? (logxor "oops" 25))
(error? (logxor 25 3.4))
(error? (logxor 3.4 25))
(error? (logxor 0 3/4))
(error? (logxor 3/4 0))
(error? (logxor 0 1+1i))
(error? (logxor 1+1i 0))
(error? (logxor 1 3.4-2.3i))
(error? (logxor 3.4-2.3i 1))
(error? (logxor 3.0 4.0))
(eqv? (logxor 0 0) 0)
(eqv? (logxor -1 0) -1)
(eqv? (logxor #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(eqv? (logxor 0 -1) -1)
(eqv? (logxor 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(eqv? (logxor 20 -1) -21)
(eqv? (logxor #xfffffffffffffffffffffffff -1)
#x-10000000000000000000000000)
(eqv? (logxor #x1111111111111111111111111 -1)
#x-1111111111111111111111112)
(eqv? (logxor (- (expt 2 100) 167) -1) #x-FFFFFFFFFFFFFFFFFFFFFFF5A)
(eqv? (logxor (- 167 (expt 2 100)) -1) #xFFFFFFFFFFFFFFFFFFFFFFF58)
(eqv? (logxor (- (expt 2 300) 167) (- (expt 2 300) 167)) 0)
(eqv? (logxor (- 167 (expt 2 300)) (- 167 (expt 2 300))) 0)
(eqv? (logxor #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(eqv? (logxor #x1212121212121212121212121 #x2222222222222222222222222)
#x3030303030303030303030303)
(eqv? (logxor #x-1212121212121212121212121
#x-2222222222222222222222222)
#x3030303030303030303030301)
(eqv? (logxor #x-3333333333333333333333333 #x-2222222222222222222222222)
#x1111111111111111111111113)
(eqv? (logxor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(eqv? (logxor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(eqv? (logxor #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-ECE8FFFFFFFFFFEDD99CE0ECE8ED0)
(eqv? (logxor #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-240FD0F076BF706E6A01D9955)
(eqv? (logxor #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31E8EF464)
(eqv? (logxor #x2B225D27F49C1FED301B89103
#x-717D004)
#x-2B225D27F49C1FED306AF4101)
(eqv? (logxor #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835BE936D31)
(eqv? (logxor #x-F2D8DD782236F835A1A50858
#x-717D004)
#xF2D8DD782236F835A6B2D854)
(eqv? (logxor #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31E8EF464)
(eqv? (logxor #x-717D004
#x2B225D27F49C1FED301B89103)
#x-2B225D27F49C1FED306AF4101)
(eqv? (logxor #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835BE936D31)
(eqv? (logxor #x-717D004
#x-F2D8DD782236F835A1A50858)
#xF2D8DD782236F835A6B2D854)
(eqv? (logxor) 0)
(eqv? (logxor #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (logxor #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3133313331333133313331333)
(eqv? (logxor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(eqv? (logxor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
(test-cp0-expansion eqv? '(logxor 0 0) 0)
(test-cp0-expansion eqv? '(logxor -1 0) -1)
(test-cp0-expansion eqv? '(logxor #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logxor 0 -1) -1)
(test-cp0-expansion eqv? '(logxor 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(logxor 20 -1) -21)
(test-cp0-expansion eqv?
'(logxor #xfffffffffffffffffffffffff -1)
#x-10000000000000000000000000)
(test-cp0-expansion eqv?
'(logxor #x1111111111111111111111111 -1)
#x-1111111111111111111111112)
(test-cp0-expansion eqv? '(logxor (- (expt 2 100) 167) -1) #x-FFFFFFFFFFFFFFFFFFFFFFF5A)
(test-cp0-expansion eqv? '(logxor (- 167 (expt 2 100)) -1) #xFFFFFFFFFFFFFFFFFFFFFFF58)
(test-cp0-expansion eqv? '(logxor (- (expt 2 300) 167) (- (expt 2 300) 167)) 0)
(test-cp0-expansion eqv? '(logxor (- 167 (expt 2 300)) (- 167 (expt 2 300))) 0)
(test-cp0-expansion eqv?
'(logxor #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(logxor #x1212121212121212121212121 #x2222222222222222222222222)
#x3030303030303030303030303)
(test-cp0-expansion eqv?
'(logxor #x-1212121212121212121212121
#x-2222222222222222222222222)
#x3030303030303030303030301)
(test-cp0-expansion eqv?
'(logxor #x-3333333333333333333333333 #x-2222222222222222222222222)
#x1111111111111111111111113)
(test-cp0-expansion eqv?
'(logxor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(test-cp0-expansion eqv?
'(logxor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(test-cp0-expansion eqv?
'(logxor #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-ECE8FFFFFFFFFFEDD99CE0ECE8ED0)
(test-cp0-expansion eqv?
'(logxor #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-240FD0F076BF706E6A01D9955)
(test-cp0-expansion eqv?
'(logxor #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31E8EF464)
(test-cp0-expansion eqv?
'(logxor #x2B225D27F49C1FED301B89103
#x-717D004)
#x-2B225D27F49C1FED306AF4101)
(test-cp0-expansion eqv?
'(logxor #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835BE936D31)
(test-cp0-expansion eqv?
'(logxor #x-F2D8DD782236F835A1A50858
#x-717D004)
#xF2D8DD782236F835A6B2D854)
(test-cp0-expansion eqv?
'(logxor #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31E8EF464)
(test-cp0-expansion eqv?
'(logxor #x-717D004
#x2B225D27F49C1FED301B89103)
#x-2B225D27F49C1FED306AF4101)
(test-cp0-expansion eqv?
'(logxor #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835BE936D31)
(test-cp0-expansion eqv?
'(logxor #x-717D004
#x-F2D8DD782236F835A1A50858)
#xF2D8DD782236F835A6B2D854)
(test-cp0-expansion eqv? '(logxor) 0)
(test-cp0-expansion eqv? '(logxor #x1212121212121212121212121) #x1212121212121212121212121)
(test-cp0-expansion eqv?
'(logxor #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3133313331333133313331333)
(test-cp0-expansion eqv?
'(logxor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(test-cp0-expansion eqv?
'(logxor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
)
(mat bitwise-xor
(error? (bitwise-xor (void) 0))
(error? (bitwise-xor 0 (void)))
(error? (bitwise-xor 'a 17))
(error? (bitwise-xor 17 'a))
(error? (bitwise-xor 25 "oops"))
(error? (bitwise-xor "oops" 25))
(error? (bitwise-xor 25 3.4))
(error? (bitwise-xor 3.4 25))
(error? (bitwise-xor 0 3/4))
(error? (bitwise-xor 3/4 0))
(error? (bitwise-xor 0 1+1i))
(error? (bitwise-xor 1+1i 0))
(error? (bitwise-xor 1 3.4-2.3i))
(error? (bitwise-xor 3.4-2.3i 1))
(error? (bitwise-xor 3.0 4.0))
(eqv? (bitwise-xor 0 0) 0)
(eqv? (bitwise-xor -1 0) -1)
(eqv? (bitwise-xor #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(eqv? (bitwise-xor 0 -1) -1)
(eqv? (bitwise-xor 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(eqv? (bitwise-xor 20 -1) -21)
(eqv? (bitwise-xor #xfffffffffffffffffffffffff -1)
#x-10000000000000000000000000)
(eqv? (bitwise-xor #x1111111111111111111111111 -1)
#x-1111111111111111111111112)
(eqv? (bitwise-xor (- (expt 2 100) 167) -1) #x-FFFFFFFFFFFFFFFFFFFFFFF5A)
(eqv? (bitwise-xor (- 167 (expt 2 100)) -1) #xFFFFFFFFFFFFFFFFFFFFFFF58)
(eqv? (bitwise-xor (- (expt 2 300) 167) (- (expt 2 300) 167)) 0)
(eqv? (bitwise-xor (- 167 (expt 2 300)) (- 167 (expt 2 300))) 0)
(eqv? (bitwise-xor #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(eqv? (bitwise-xor #x1212121212121212121212121 #x2222222222222222222222222)
#x3030303030303030303030303)
(eqv? (bitwise-xor #x-1212121212121212121212121
#x-2222222222222222222222222)
#x3030303030303030303030301)
(eqv? (bitwise-xor #x-3333333333333333333333333 #x-2222222222222222222222222)
#x1111111111111111111111113)
(eqv? (bitwise-xor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(eqv? (bitwise-xor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(eqv? (bitwise-xor #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-ECE8FFFFFFFFFFEDD99CE0ECE8ED0)
(eqv? (bitwise-xor #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-240FD0F076BF706E6A01D9955)
(eqv? (bitwise-xor #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31E8EF464)
(eqv? (bitwise-xor #x2B225D27F49C1FED301B89103
#x-717D004)
#x-2B225D27F49C1FED306AF4101)
(eqv? (bitwise-xor #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835BE936D31)
(eqv? (bitwise-xor #x-F2D8DD782236F835A1A50858
#x-717D004)
#xF2D8DD782236F835A6B2D854)
(eqv? (bitwise-xor #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31E8EF464)
(eqv? (bitwise-xor #x-717D004
#x2B225D27F49C1FED301B89103)
#x-2B225D27F49C1FED306AF4101)
(eqv? (bitwise-xor #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835BE936D31)
(eqv? (bitwise-xor #x-717D004
#x-F2D8DD782236F835A1A50858)
#xF2D8DD782236F835A6B2D854)
(eqv? (bitwise-xor) 0)
(eqv? (bitwise-xor #x1212121212121212121212121)
#x1212121212121212121212121)
(eqv? (bitwise-xor #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3133313331333133313331333)
(eqv? (bitwise-xor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(eqv? (bitwise-xor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
(test-cp0-expansion eqv? '(bitwise-xor 0 0) 0)
(test-cp0-expansion eqv? '(bitwise-xor -1 0) -1)
(test-cp0-expansion eqv? '(bitwise-xor #xfffffffffffffffffffffffff 0) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(bitwise-xor 0 -1) -1)
(test-cp0-expansion eqv? '(bitwise-xor 0 #xfffffffffffffffffffffffff) #xfffffffffffffffffffffffff)
(test-cp0-expansion eqv? '(bitwise-xor 20 -1) -21)
(test-cp0-expansion eqv?
'(bitwise-xor #xfffffffffffffffffffffffff -1)
#x-10000000000000000000000000)
(test-cp0-expansion eqv?
'(bitwise-xor #x1111111111111111111111111 -1)
#x-1111111111111111111111112)
(test-cp0-expansion eqv? '(bitwise-xor (- (expt 2 100) 167) -1) #x-FFFFFFFFFFFFFFFFFFFFFFF5A)
(test-cp0-expansion eqv? '(bitwise-xor (- 167 (expt 2 100)) -1) #xFFFFFFFFFFFFFFFFFFFFFFF58)
(test-cp0-expansion eqv? '(bitwise-xor (- (expt 2 300) 167) (- (expt 2 300) 167)) 0)
(test-cp0-expansion eqv? '(bitwise-xor (- 167 (expt 2 300)) (- 167 (expt 2 300))) 0)
(test-cp0-expansion eqv?
'(bitwise-xor #x1111111111111111111111111 #x2222222222222222222222222)
#x3333333333333333333333333)
(test-cp0-expansion eqv?
'(bitwise-xor #x1212121212121212121212121 #x2222222222222222222222222)
#x3030303030303030303030303)
(test-cp0-expansion eqv?
'(bitwise-xor #x-1212121212121212121212121
#x-2222222222222222222222222)
#x3030303030303030303030301)
(test-cp0-expansion eqv?
'(bitwise-xor #x-3333333333333333333333333 #x-2222222222222222222222222)
#x1111111111111111111111113)
(test-cp0-expansion eqv?
'(bitwise-xor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(test-cp0-expansion eqv?
'(bitwise-xor #x-123456789abcdeffedca987654321
#x-fedca987654321123456789abcdef)
#xECE8FFFFFFFFFFEDD99CE0ECE8ECE)
(test-cp0-expansion eqv?
'(bitwise-xor #x-123456789abcdeffedca987654321
#xfedca987654321123456789abcdef)
#x-ECE8FFFFFFFFFFEDD99CE0ECE8ED0)
(test-cp0-expansion eqv?
'(bitwise-xor #x2B225D27F49C1FED301B89103
#x-F2D8DD782236F835A1A50858)
#x-240FD0F076BF706E6A01D9955)
(test-cp0-expansion eqv?
'(bitwise-xor #x2B225D27F49C1FED301B89103
#x1F366567)
#x2B225D27F49C1FED31E8EF464)
(test-cp0-expansion eqv?
'(bitwise-xor #x2B225D27F49C1FED301B89103
#x-717D004)
#x-2B225D27F49C1FED306AF4101)
(test-cp0-expansion eqv?
'(bitwise-xor #x-F2D8DD782236F835A1A50858
#x1F366567)
#x-F2D8DD782236F835BE936D31)
(test-cp0-expansion eqv?
'(bitwise-xor #x-F2D8DD782236F835A1A50858
#x-717D004)
#xF2D8DD782236F835A6B2D854)
(test-cp0-expansion eqv?
'(bitwise-xor #x1F366567
#x2B225D27F49C1FED301B89103)
#x2B225D27F49C1FED31E8EF464)
(test-cp0-expansion eqv?
'(bitwise-xor #x-717D004
#x2B225D27F49C1FED301B89103)
#x-2B225D27F49C1FED306AF4101)
(test-cp0-expansion eqv?
'(bitwise-xor #x1F366567
#x-F2D8DD782236F835A1A50858)
#x-F2D8DD782236F835BE936D31)
(test-cp0-expansion eqv?
'(bitwise-xor #x-717D004
#x-F2D8DD782236F835A1A50858)
#xF2D8DD782236F835A6B2D854)
(test-cp0-expansion eqv? '(bitwise-xor) 0)
(test-cp0-expansion eqv? '(bitwise-xor #x1212121212121212121212121) #x1212121212121212121212121)
(test-cp0-expansion eqv?
'(bitwise-xor #x1212121212121212121212121
#x2222222222222222222222222
#x0103010301030103010301030)
#x3133313331333133313331333)
(test-cp0-expansion eqv?
'(bitwise-xor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(test-cp0-expansion eqv?
'(bitwise-xor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
)
(mat logtest
(error? (logtest))
(error? (logtest 1))
(error? (logtest 1 2 3))
(error? (logtest 3.4 5))
(error? (logtest 5 "3"))
(eqv? (logtest (+ (most-positive-fixnum) 1) 0) #f)
(eqv? (logtest (+ (most-positive-fixnum) 6)
(+ (most-positive-fixnum) 8))
#t)
(eqv? (logtest (- (most-negative-fixnum) 1) 0) #f)
(eqv? (logtest 1 (- (most-negative-fixnum) 1)) #t)
(eqv? (logtest 750 -1) #t)
(eqv? (logtest -1 -6) #t)
(eqv? (logtest 0 -1) #f)
(eqv? (logtest -1 0) #f)
(eqv? (logtest #b1000101001 #b0111010110) #f)
(eqv? (logtest #b1000101001 #b0111110110) #t)
(eqv? (logtest #b1010101001 #b0111010110) #t)
(eqv? (logtest #x100010100110001010011000101001
#x011101011001110101100111010110) #f)
(eqv? (logtest #x101010100110001010011000101001
#x011101011001110101100111010110) #t)
(eqv? (logtest #x100010100110001010011000101001
#x011101011101110101100111010110) #t)
(eqv? (logtest (most-positive-fixnum) 3) #t)
(eqv? (logtest (most-negative-fixnum) 3) #f)
(eqv? (logtest (most-negative-fixnum) (most-negative-fixnum)) #t)
(eqv? (logtest (most-negative-fixnum) (most-positive-fixnum)) #f)
(eqv? (let ([n (ash (most-positive-fixnum) 1)])
(do ([i 1000 (fx- i 1)]
[a #t (and a (logtest (- (random n)) (- (random n))))])
((fx= i 0) a)))
#t)
(eqv? (let ([n1 (ash (most-positive-fixnum) 400)]
[n2 (ash (most-positive-fixnum) 100)])
(do ([i 1000 (fx- i 1)]
[a #t (and a
(logtest (- (random n1)) (- (random n1)))
(logtest (- (random n1)) (- (random n2)))
(logtest (- (random n2)) (- (random n1))))])
((fx= i 0) a)))
#t)
(eqv? (logtest (ash 1 256) (ash 1 255)) #f)
(eqv? (logtest (ash 1 256) (ash 3 255)) #t)
(eqv? (logtest (ash 1 256) (- (ash 3 100))) #t)
(eqv? (logtest (- 1 (ash 1 256)) (ash 3 100)) #f)
(eqv? (logtest (- 1 (ash 1 256)) (+ (ash 3 100) 1)) #t)
(eqv? (logtest (- 1 (ash 1 256)) (ash 1 255)) #f)
(eqv? (logtest (- 1 (ash 1 256)) (ash 1 256)) #t)
(eqv? (logtest (- 1 (ash 1 256)) (ash 1 257)) #t)
(eqv? (logtest (- 1 (ash 1 255)) (ash 1 254)) #f)
(eqv? (logtest (- 1 (ash 1 255)) (ash 1 255)) #t)
(eqv? (logtest (- 1 (ash 1 255)) (ash 1 256)) #t)
(eqv? (logtest (- 1 (ash 1 254)) (ash 1 253)) #f)
(eqv? (logtest (- 1 (ash 1 254)) (ash 1 254)) #t)
(eqv? (logtest (- 1 (ash 1 254)) (ash 1 255)) #t)
; make sure we've properly labeled logtest an arith-pred in primvars.ss
(begin
(define ($logtest-foo x y)
(if (logtest x y)
'yes
'no))
(equal?
(list ($logtest-foo 3 4) ($logtest-foo 3 3))
'(no yes)))
)
(mat bitwise-if
(error? (bitwise-if))
(error? (bitwise-if 0))
(error? (bitwise-if 0 0))
(error? (bitwise-if 0 0 0 0))
(error? (bitwise-if 'a 0 0))
(error? (bitwise-if 0 3.4 0))
(error? (bitwise-if 0 0 '(a)))
(eqv? (bitwise-if 0 0 0) 0)
(eqv? (bitwise-if 0 -1 0) 0)
(eqv? (bitwise-if 0 0 -1) -1)
(eqv? (bitwise-if #b10101010 0 -1) (bitwise-not #b10101010))
(eqv? (bitwise-if #b10101010 -1 0) #b10101010)
(eqv? (bitwise-if #b10101010110011001101011010110101101011010110101010101011100111111000010101000111001110001101010011
#b11111110000000111111100000001111111000000011111110000000111111100000001111111000000011111110000000
#b11001100110011110011001100111100110011001111001100110011110011001100111100110011001111001100110011)
#b11101110000000111111000100001101111000001011101110010000110111100100101101110000000011001100100000)
(let ([n (expt (+ (greatest-fixnum) 1) 2)])
(define r6rs-bitwise-if
(lambda (ei1 ei2 ei3)
(bitwise-ior (bitwise-and ei1 ei2)
(bitwise-and (bitwise-not ei1) ei3))))
(let f ([i 10000])
(unless (fx= i 0)
(let ([x (random n)] [y (random n)] [z (random n)]
[kx (random (+ (most-positive-fixnum) 1))]
[ky (random (+ (most-positive-fixnum) 1))]
[kz (random (+ (most-positive-fixnum) 1))])
(unless (and (= (bitwise-if x y z) (r6rs-bitwise-if x y z))
(= (bitwise-if (bitwise-not x) y z)
(r6rs-bitwise-if (bitwise-not x) y z))
(= (bitwise-if (bitwise-not x) y (bitwise-not z))
(r6rs-bitwise-if (bitwise-not x) y (bitwise-not z)))
(= (bitwise-if x (bitwise-not y) z) (r6rs-bitwise-if x (bitwise-not y) z))
(= (bitwise-if (bitwise-not x) (bitwise-not y) (bitwise-not z))
(r6rs-bitwise-if (bitwise-not x) (bitwise-not y) (bitwise-not z)))
(= (bitwise-if x ky z) (r6rs-bitwise-if x ky z))
(= (bitwise-if x ky kz) (r6rs-bitwise-if x ky kz))
(= (bitwise-if kx y z) (r6rs-bitwise-if kx y z))
(= (bitwise-if kx (bitwise-not y) z) (r6rs-bitwise-if kx (bitwise-not y) z))
(= (bitwise-if (bitwise-not kx) (bitwise-not y) z) (r6rs-bitwise-if (bitwise-not kx) (bitwise-not y) z)))
(errorf #f "failed for ~s, ~s, ~s, ~s, ~s, ~s" x y z kx ky kz)))
(f (fx- i 1))))
#t)
)
(mat logbit?
(error? (logbit?))
(error? (logbit? 1))
(error? (logbit? 1 2 3))
(error? (logbit? 3.4 5))
(error? (logbit? 5 "3"))
(error? (logbit? -1 -1))
(let ()
(define (f x b)
(let f ([i 0])
(or (> i 100000)
(and (eq? (logbit? i x) b)
(f (fx+ i 7))))))
(and (f 0 #f) (f -1 #t)))
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (logbit? i -1))])
((fx> i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (logbit? i (most-positive-fixnum)))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (logbit? (integer-length (most-positive-fixnum)) (most-positive-fixnum)) #f)
(eqv? (do ([i 0 (fx+ i 1)] [a #f (or a (logbit? i (+ (most-positive-fixnum) 1)))])
((fx= i (integer-length (most-positive-fixnum))) a))
#f)
(eqv? (logbit? (integer-length (most-positive-fixnum))
(+ (most-positive-fixnum) 1))
#t)
(eqv? (do ([i (fx+ (integer-length (most-positive-fixnum)) 1) (fx+ i 1)]
[a #f (or a (logbit? i (+ (most-positive-fixnum) 1)))])
((fx= i (* (integer-length (most-positive-fixnum)) 10)) a))
#f)
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (logbit? i (- (most-negative-fixnum) 1)))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (logbit? (integer-length (most-positive-fixnum))
(- (most-negative-fixnum) 1))
#f)
(eqv? (do ([i (fx+ (integer-length (most-positive-fixnum)) 1) (fx+ i 1)]
[a #t (and a (logbit? i (- (most-negative-fixnum) 1)))])
((fx= i (* (integer-length (most-positive-fixnum)) 10)) a))
#t)
(eqv? (logbit? 0 #b0111010110) #f)
(eqv? (logbit? 4 #b0111010110) #t)
(eqv? (logbit? 8 #b0111010110) #t)
(eqv? (logbit? 9 #b0111010110) #f)
(eqv? (logbit? 0 #x42310521068980111010110) #f)
(eqv? (logbit? 4 #x42310521068980111010110) #t)
(eqv? (logbit? 85 #x42310521068980111010110) #t)
(eqv? (logbit? 86 #x42310521068980111010110) #f)
(eqv? (logbit? 90 #x42310521068980111010110) #t)
(eqv? (logbit? 91 #x42310521068980111010110) #f)
(eqv? (logbit? 1000 #x42310521068980111010110) #f)
(eqv? (logbit? 0 #x-55555555555555555555555555) #t)
(eqv? (logbit? 1 #x-55555555555555555555555555) #t)
(eqv? (logbit? 2 #x-55555555555555555555555555) #f)
(eqv? (logbit? 100 #x-55555555555555555555555555) #f)
(eqv? (logbit? 101 #x-55555555555555555555555555) #t)
(eqv? (logbit? 102 #x-55555555555555555555555555) #f)
(eqv? (logbit? 103 #x-55555555555555555555555555) #t)
(eqv? (logbit? 1000 #x-55555555555555555555555555) #t)
(eqv? (logbit? 31 (ash 1 32)) #f)
(eqv? (logbit? 32 (ash 1 32)) #t)
(eqv? (logbit? 33 (ash 1 32)) #f)
(eqv? (logbit? 30 (ash 1 31)) #f)
(eqv? (logbit? 31 (ash 1 31)) #t)
(eqv? (logbit? 32 (ash 1 31)) #f)
(eqv? (logbit? 63 (ash 1 64)) #f)
(eqv? (logbit? 64 (ash 1 64)) #t)
(eqv? (logbit? 65 (ash 1 64)) #f)
(eqv? (logbit? 62 (ash 1 63)) #f)
(eqv? (logbit? 63 (ash 1 63)) #t)
(eqv? (logbit? 64 (ash 1 63)) #f)
(eqv? (logbit? 255 (ash 1 256)) #f)
(eqv? (logbit? 256 (ash 1 256)) #t)
(eqv? (logbit? 257 (ash 1 256)) #f)
(eqv? (logbit? 254 (ash 1 255)) #f)
(eqv? (logbit? 255 (ash 1 255)) #t)
(eqv? (logbit? 256 (ash 1 255)) #f)
(equal?
(let ([x (- 1 (ash 1 256))])
(list
(logbit? 0 x)
(do ([i 1 (fx+ i 1)] [a #f (or a (logbit? i x))])
((fx= i 256) a))
(do ([i 256 (fx+ i 1)] [a #t (and a (logbit? i x))])
((fx= i 1000) a))))
'(#t #f #t))
(equal?
(let ([x (- (ash 1 256))])
(list
(do ([i 0 (fx+ i 1)] [a #f (or a (logbit? i x))])
((fx= i 256) a))
(do ([i 256 (fx+ i 1)] [a #t (and a (logbit? i x))])
((fx= i 1000) a))))
'(#f #t))
(eqv? (logbit? (integer-length (most-positive-fixnum)) #b0111010110) #f)
(eqv? (logbit? 0 -6) #f)
(eqv? (logbit? 1 -6) #t)
(eqv? (logbit? 2 -6) #f)
(eqv? (do ([i 3 (fx+ i 1)] [a #t (and a (logbit? i -6))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
; check to see if we can look as far to the left as we please ...
(eqv? (logbit? (+ (integer-length (most-positive-fixnum)) 1) -1) #t)
(eqv? (logbit? (expt (integer-length (most-positive-fixnum)) 2) (most-positive-fixnum)) #f)
(eqv? (logbit? (expt (integer-length (most-positive-fixnum)) 2) -1) #t)
; make sure we've properly labeled logbit? an arith-pred in primvars.ss
(begin
(define ($logbit?-foo x y)
(if (logbit? x y)
'yes
'no))
(equal?
(list ($logbit?-foo 2 4) ($logbit?-foo 3 3))
'(yes no)))
)
(mat bitwise-bit-set? ; same as logbit?
(error? (bitwise-bit-set?))
(error? (bitwise-bit-set? 3))
(error? (bitwise-bit-set? 3 4 5))
(error? (bitwise-bit-set? 3.0 4))
(error? (bitwise-bit-set? "hi" 4))
(error? (bitwise-bit-set? 3 4/3))
(error? (bitwise-bit-set? 3 'a))
(error? (bitwise-bit-set? 3 -3))
(let ()
(define (f x b)
(let f ([i 0])
(or (> i 100000)
(and (eq? (bitwise-bit-set? x i) b)
(f (fx+ i 7))))))
(and (f 0 #f) (f -1 #t)))
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (bitwise-bit-set? -1 i))])
((fx> i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (bitwise-bit-set? (most-positive-fixnum) 1))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (bitwise-bit-set? (most-positive-fixnum) (integer-length (most-positive-fixnum))) #f)
(eqv? (do ([i 0 (fx+ i 1)] [a #f (or a (bitwise-bit-set? (+ (most-positive-fixnum) 1) i))])
((fx= i (integer-length (most-positive-fixnum))) a))
#f)
(eqv? (bitwise-bit-set? (+ (most-positive-fixnum) 1)
(integer-length (most-positive-fixnum)))
#t)
(eqv? (do ([i (fx+ (integer-length (most-positive-fixnum)) 1) (fx+ i 1)]
[a #f (or a (bitwise-bit-set? (+ (most-positive-fixnum) 1) i))])
((fx= i (* (integer-length (most-positive-fixnum)) 10)) a))
#f)
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (bitwise-bit-set? (- (most-negative-fixnum) 1) i))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (bitwise-bit-set? (- (most-negative-fixnum) 1)
(integer-length (most-positive-fixnum)))
#f)
(eqv? (do ([i (fx+ (integer-length (most-positive-fixnum)) 1) (fx+ i 1)]
[a #t (and a (bitwise-bit-set? (- (most-negative-fixnum) 1)i ))])
((fx= i (* (integer-length (most-positive-fixnum)) 10)) a))
#t)
(eqv? (bitwise-bit-set? #b0111010110 0) #f)
(eqv? (bitwise-bit-set? #b0111010110 4) #t)
(eqv? (bitwise-bit-set? #b0111010110 8) #t)
(eqv? (bitwise-bit-set? #b0111010110 9) #f)
(eqv? (bitwise-bit-set? #x42310521068980111010110 0) #f)
(eqv? (bitwise-bit-set? #x42310521068980111010110 4) #t)
(eqv? (bitwise-bit-set? #x42310521068980111010110 85) #t)
(eqv? (bitwise-bit-set? #x42310521068980111010110 86) #f)
(eqv? (bitwise-bit-set? #x42310521068980111010110 90) #t)
(eqv? (bitwise-bit-set? #x42310521068980111010110 91) #f)
(eqv? (bitwise-bit-set? #x42310521068980111010110 1000) #f)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 0) #t)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 1) #t)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 2) #f)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 100) #f)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 101) #t)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 102) #f)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 103) #t)
(eqv? (bitwise-bit-set? #x-55555555555555555555555555 1000) #t)
(eqv? (bitwise-bit-set? (ash 1 32) 31) #f)
(eqv? (bitwise-bit-set? (ash 1 32) 32) #t)
(eqv? (bitwise-bit-set? (ash 1 32) 33) #f)
(eqv? (bitwise-bit-set? (ash 1 31) 30) #f)
(eqv? (bitwise-bit-set? (ash 1 31) 31) #t)
(eqv? (bitwise-bit-set? (ash 1 31) 32) #f)
(eqv? (bitwise-bit-set? (ash 1 64) 63) #f)
(eqv? (bitwise-bit-set? (ash 1 64) 64) #t)
(eqv? (bitwise-bit-set? (ash 1 64) 65) #f)
(eqv? (bitwise-bit-set? (ash 1 63) 62) #f)
(eqv? (bitwise-bit-set? (ash 1 63) 63) #t)
(eqv? (bitwise-bit-set? (ash 1 63) 64) #f)
(eqv? (bitwise-bit-set? (ash 1 256) 255) #f)
(eqv? (bitwise-bit-set? (ash 1 256) 256) #t)
(eqv? (bitwise-bit-set? (ash 1 256) 257) #f)
(eqv? (bitwise-bit-set? (ash 1 255) 254) #f)
(eqv? (bitwise-bit-set? (ash 1 255) 255) #t)
(eqv? (bitwise-bit-set? (ash 1 255) 256) #f)
(equal?
(let ([x (- 1 (ash 1 256))])
(list
(bitwise-bit-set? x 0)
(do ([i 1 (fx+ i 1)] [a #f (or a (bitwise-bit-set? x i))])
((fx= i 256) a))
(do ([i 256 (fx+ i 1)] [a #t (and a (bitwise-bit-set? x i))])
((fx= i 1000) a))))
'(#t #f #t))
(equal?
(let ([x (- (ash 1 256))])
(list
(do ([i 0 (fx+ i 1)] [a #f (or a (bitwise-bit-set? x i))])
((fx= i 256) a))
(do ([i 256 (fx+ i 1)] [a #t (and a (bitwise-bit-set? x i))])
((fx= i 1000) a))))
'(#f #t))
(eqv? (bitwise-bit-set? #b0111010110 (integer-length (most-positive-fixnum))) #f)
(eqv? (bitwise-bit-set? -6 0) #f)
(eqv? (bitwise-bit-set? -6 1) #t)
(eqv? (bitwise-bit-set? -6 2) #f)
(eqv? (do ([i 3 (fx+ i 1)] [a #t (and a (bitwise-bit-set? -6 i))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
; check to see if we can look as far to the left as we please ...
(eqv? (bitwise-bit-set? -1 (+ (integer-length (most-positive-fixnum)) 1)) #t)
(eqv? (bitwise-bit-set? (most-positive-fixnum) (expt (integer-length (most-positive-fixnum)) 2)) #f)
(eqv? (bitwise-bit-set? -1 (expt (integer-length (most-positive-fixnum)) 2)) #t)
; make sure we've properly labeled bitwise-bit-set? an arith-pred in primvars.ss
(begin
(define ($bitwise-bit-set?-foo x y)
(if (bitwise-bit-set? y x)
'yes
'no))
(equal?
(list ($bitwise-bit-set?-foo 2 4) ($bitwise-bit-set?-foo 3 3))
'(yes no)))
)
(mat logbit0
(error? (logbit0))
(error? (logbit0 1))
(error? (logbit0 1 2 3))
(error? (logbit0 3.4 5))
(error? (logbit0 5 "3"))
(error? (logbit0 -1 -1))
(eqv? (logbit0 0 (+ (most-positive-fixnum) 2)) (+ (most-positive-fixnum) 1))
(eqv? (logbit0 0 (- (most-negative-fixnum) 1)) (- (most-negative-fixnum) 2))
(eqv? (logbit0 (integer-length (most-positive-fixnum)) -1)
(- -1 (expt 2 (integer-length (most-positive-fixnum)))))
(eqv? (logbit0 2 0) 0)
(eqv? (logbit0 2 -1) -5)
(eqv? (logbit0 3 #b10101010) #b10100010)
(eqv? (logbit0 4 #b10101010) #b10101010)
(andmap values
(let ([p? (lambda (i) (fx= (logbit0 i -1) (fx- -1 (expt 2 i))))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
'()
(cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i) (fx= (logbit0 i n)
(fxlogand (lognot (fxsll 1 i)) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random (+ (- (most-positive-fixnum)
(most-negative-fixnum))
1))
(most-negative-fixnum))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
(eqv? (logbit0 31 (- (ash 1 32) 1)) (- (ash 1 31) 1))
(eqv? (logbit0 32 (- (ash 1 32) 1)) (- (ash 1 32) 1))
(eqv? (logbit0 33 (- (ash 1 32) 1)) (- (ash 1 32) 1))
(eqv? (logbit0 31 (ash 1 32)) (ash 1 32))
(eqv? (logbit0 32 (ash 1 32)) 0)
(eqv? (logbit0 31 (- (ash 1 33) 1)) (- (ash 1 33) (ash 1 31) 1))
(eqv? (logbit0 32 (- (ash 1 33) 1)) (- (ash 1 32) 1))
(eqv? (logbit0 33 (- (ash 1 33) 1)) (- (ash 1 33) 1))
(eqv? (logbit0 63 (- (ash 1 64) 1)) (- (ash 1 63) 1))
(eqv? (logbit0 64 (- (ash 1 64) 1)) (- (ash 1 64) 1))
(eqv? (logbit0 65 (- (ash 1 64) 1)) (- (ash 1 64) 1))
(eqv? (logbit0 63 (ash 1 64)) (ash 1 64))
(eqv? (logbit0 64 (ash 1 64)) 0)
(eqv? (logbit0 63 (- (ash 1 65) 1)) (- (ash 1 65) (ash 1 63) 1))
(eqv? (logbit0 64 (- (ash 1 65) 1)) (- (ash 1 64) 1))
(eqv? (logbit0 65 (- (ash 1 65) 1)) (- (ash 1 65) 1))
(eqv? (logbit0 255 (- (ash 1 256) 1)) (- (ash 1 255) 1))
(eqv? (logbit0 256 (- (ash 1 256) 1)) (- (ash 1 256) 1))
(eqv? (logbit0 257 (- (ash 1 256) 1)) (- (ash 1 256) 1))
(eqv? (logbit0 255 (ash 1 256)) (ash 1 256))
(eqv? (logbit0 256 (ash 1 256)) 0)
(eqv? (logbit0 255 (- (ash 1 257) 1)) (- (ash 1 257) (ash 1 255) 1))
(eqv? (logbit0 256 (- (ash 1 257) 1)) (- (ash 1 256) 1))
(eqv? (logbit0 257 (- (ash 1 257) 1)) (- (ash 1 257) 1))
; two's comp rep'n of #x-32B225D27F49C1FED301B89103 is
; ...FCD4DDA2D80B63E012CFE476EFD
(eqv? (logbit0 0 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89104)
(eqv? (logbit0 1 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit0 2 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89107)
(eqv? (logbit0 31 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED381B89103)
(eqv? (logbit0 32 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit0 63 #x-32B225D27F49C1FED301B89103)
#x-32B225D27FC9C1FED301B89103)
(eqv? (logbit0 64 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit0 99 #x-32B225D27F49C1FED301B89103)
#x-3AB225D27F49C1FED301B89103)
(eqv? (logbit0 100 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit0 101 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit0 102 #x-32B225D27F49C1FED301B89103)
#x-72B225D27F49C1FED301B89103)
(eqv? (logbit0 103 #x-32B225D27F49C1FED301B89103)
#x-B2B225D27F49C1FED301B89103)
(eqv? (logbit0 104 #x-32B225D27F49C1FED301B89103)
#x-132B225D27F49C1FED301B89103)
(eqv? (logbit0 1000 #x-32B225D27F49C1FED301B89103)
#x-10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000032B225D27F49C1FED301B89103)
(eqv? (logbit0 0 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFE)
(eqv? (logbit0 1 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFF)
(eqv? (logbit0 2 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 31 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 32 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012DFE476EFD)
(eqv? (logbit0 63 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 64 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D81B63E012CFE476EFD)
(eqv? (logbit0 99 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 100 #x-CD4DDA2D80B63E012CFE476EFD)
#x-DD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 101 #x-CD4DDA2D80B63E012CFE476EFD)
#x-ED4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 102 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 103 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 104 #x-CD4DDA2D80B63E012CFE476EFD)
#x-1CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit0 1000 #x-CD4DDA2D80B63E012CFE476EFD)
#x-100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000CD4DDA2D80B63E012CFE476EFD)
(andmap values
(let ([p? (lambda (i) (= (logbit0 i -1) (- -1 (expt 2 i))))])
(let f ([i 0])
(if (fx= i 1000)
'()
(cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i) (= (logbit0 i n) (logand (lognot (ash 1 i)) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random (+ (- (ash (most-positive-fixnum) 5)
(ash (most-negative-fixnum) 5))
1))
(ash (most-negative-fixnum) 5))])
(let f ([i 0])
(if (fx= i (* (integer-length (ash (most-negative-fixnum) 5)) 2))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
)
(mat logbit1
(error? (logbit1))
(error? (logbit1 1))
(error? (logbit1 1 2 3))
(error? (logbit1 3.4 5))
(error? (logbit1 5 "3"))
(error? (logbit1 -1 -1))
(eqv? (logbit1 0 (+ (most-positive-fixnum) 1)) (+ (most-positive-fixnum) 2))
(eqv? (logbit1 0 (- (most-negative-fixnum) 2)) (- (most-negative-fixnum) 1))
(eqv? (logbit1 (integer-length (most-positive-fixnum)) 0)
(ash 1 (integer-length (most-positive-fixnum))))
(eqv? (logbit1 (integer-length (most-positive-fixnum)) 0)
(+ (most-positive-fixnum) 1))
(eqv? (logbit1 2 0) 4)
(eqv? (logbit1 2 -1) -1)
(eqv? (logbit1 (expt 2 20) -75) -75)
(eqv? (logbit1 1000 -75) -75)
(eqv? (logbit1 3 #b10101010) #b10101010)
(eqv? (logbit1 4 #b10101010) #b10111010)
(andmap values
(let ([p? (lambda (i) (fx= (logbit1 i 0) (ash 1 i)))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
'()
(cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i) (fx= (logbit1 i n) (fxlogor (fxsll 1 i) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random (+ (- (most-positive-fixnum)
(most-negative-fixnum))
1))
(most-negative-fixnum))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
(eqv? (logbit1 31 (ash 1 32)) (ash 3 31))
(eqv? (logbit1 32 (ash 1 32)) (ash 1 32))
(eqv? (logbit1 33 (ash 1 32)) (ash 3 32))
(eqv? (logbit1 30 (ash 1 31)) (ash 3 30))
(eqv? (logbit1 31 (ash 1 31)) (ash 1 31))
(eqv? (logbit1 32 (ash 1 31)) (ash 3 31))
(eqv? (logbit1 63 (ash 1 64)) (ash 3 63))
(eqv? (logbit1 64 (ash 1 64)) (ash 1 64))
(eqv? (logbit1 65 (ash 1 64)) (ash 3 64))
(eqv? (logbit1 62 (ash 1 63)) (ash 3 62))
(eqv? (logbit1 63 (ash 1 63)) (ash 1 63))
(eqv? (logbit1 64 (ash 1 63)) (ash 3 63))
(eqv? (logbit1 255 (ash 1 256)) (ash 3 255))
(eqv? (logbit1 256 (ash 1 256)) (ash 1 256))
(eqv? (logbit1 257 (ash 1 256)) (ash 3 256))
(eqv? (logbit1 254 (ash 1 255)) (ash 3 254))
(eqv? (logbit1 255 (ash 1 255)) (ash 1 255))
(eqv? (logbit1 256 (ash 1 255)) (ash 3 255))
; two's comp rep'n of #x-32B225D27F49C1FED301B89103 is
; ...FCD4DDA2D80B63E012CFE476EFD
(eqv? (logbit1 0 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 1 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89101)
(eqv? (logbit1 2 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 31 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 32 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED201B89103)
(eqv? (logbit1 63 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 64 #x-32B225D27F49C1FED301B89103)
#x-32B225D27E49C1FED301B89103)
(eqv? (logbit1 99 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 100 #x-32B225D27F49C1FED301B89103)
#x-22B225D27F49C1FED301B89103)
(eqv? (logbit1 101 #x-32B225D27F49C1FED301B89103)
#x-12B225D27F49C1FED301B89103)
(eqv? (logbit1 102 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 103 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 104 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 1000 #x-32B225D27F49C1FED301B89103)
#x-32B225D27F49C1FED301B89103)
(eqv? (logbit1 0 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 1 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 2 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EF9)
(eqv? (logbit1 31 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012C7E476EFD)
(eqv? (logbit1 32 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 63 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80363E012CFE476EFD)
(eqv? (logbit1 64 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 99 #x-CD4DDA2D80B63E012CFE476EFD)
#x-C54DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 100 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 101 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 102 #x-CD4DDA2D80B63E012CFE476EFD)
#x-8D4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 103 #x-CD4DDA2D80B63E012CFE476EFD)
#x-4D4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 104 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(eqv? (logbit1 1000 #x-CD4DDA2D80B63E012CFE476EFD)
#x-CD4DDA2D80B63E012CFE476EFD)
(andmap values
(let ([p? (lambda (i) (= (logbit1 i 0) (ash 1 i)))])
(let f ([i 0])
(if (fx= i 1000)
'()
(cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i) (= (logbit1 i n) (logor (ash 1 i) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random (+ (- (ash (most-positive-fixnum) 5)
(ash (most-negative-fixnum) 5))
1))
(ash (most-negative-fixnum) 5))])
(let f ([i 0])
(if (fx= i (* (integer-length (ash (most-negative-fixnum) 5)) 2))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
)
(mat bitwise-copy-bit ; adapted from logbit0 and logbit1 above
(error? (bitwise-copy-bit))
(error? (bitwise-copy-bit 1))
(error? (bitwise-copy-bit 1 2))
(error? (bitwise-copy-bit 1 2 0 4))
(error? (bitwise-copy-bit 3.4 5 0))
(error? (bitwise-copy-bit 1 'a 0))
(error? (bitwise-copy-bit 1 -2 0))
(error? (bitwise-copy-bit 1 2 2))
(error? (bitwise-copy-bit 1 2 -1))
(error? (bitwise-copy-bit 1 2 'a))
(eqv?
(bitwise-copy-bit (+ (most-positive-fixnum) 2) 0 0)
(+ (most-positive-fixnum) 1))
(eqv?
(bitwise-copy-bit (- (most-negative-fixnum) 1) 0 0)
(- (most-negative-fixnum) 2))
(eqv?
(bitwise-copy-bit
-1
(integer-length (most-positive-fixnum))
0)
(- -1 (expt 2 (integer-length (most-positive-fixnum)))))
(eqv? (bitwise-copy-bit 0 2 0) 0)
(eqv? (bitwise-copy-bit -1 2 0) -5)
(eqv? (bitwise-copy-bit 170 3 0) 162)
(eqv? (bitwise-copy-bit 170 4 0) 170)
(andmap
values
(let ([p? (lambda (i)
(fx= (bitwise-copy-bit -1 i 0) (fx- -1 (expt 2 i))))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
'()
(cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i)
(fx= (bitwise-copy-bit n i 0)
(fxlogand (lognot (fxsll 1 i)) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random
(+ (- (most-positive-fixnum)
(most-negative-fixnum))
1))
(most-negative-fixnum))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
(eqv?
(bitwise-copy-bit (- (ash 1 32) 1) 31 0)
(- (ash 1 31) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 32) 1) 32 0)
(- (ash 1 32) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 32) 1) 33 0)
(- (ash 1 32) 1))
(eqv? (bitwise-copy-bit (ash 1 32) 31 0) (ash 1 32))
(eqv? (bitwise-copy-bit (ash 1 32) 32 0) 0)
(eqv?
(bitwise-copy-bit (- (ash 1 33) 1) 31 0)
(- (ash 1 33) (ash 1 31) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 33) 1) 32 0)
(- (ash 1 32) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 33) 1) 33 0)
(- (ash 1 33) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 64) 1) 63 0)
(- (ash 1 63) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 64) 1) 64 0)
(- (ash 1 64) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 64) 1) 65 0)
(- (ash 1 64) 1))
(eqv? (bitwise-copy-bit (ash 1 64) 63 0) (ash 1 64))
(eqv? (bitwise-copy-bit (ash 1 64) 64 0) 0)
(eqv?
(bitwise-copy-bit (- (ash 1 65) 1) 63 0)
(- (ash 1 65) (ash 1 63) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 65) 1) 64 0)
(- (ash 1 64) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 65) 1) 65 0)
(- (ash 1 65) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 256) 1) 255 0)
(- (ash 1 255) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 256) 1) 256 0)
(- (ash 1 256) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 256) 1) 257 0)
(- (ash 1 256) 1))
(eqv? (bitwise-copy-bit (ash 1 256) 255 0) (ash 1 256))
(eqv? (bitwise-copy-bit (ash 1 256) 256 0) 0)
(eqv?
(bitwise-copy-bit (- (ash 1 257) 1) 255 0)
(- (ash 1 257) (ash 1 255) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 257) 1) 256 0)
(- (ash 1 256) 1))
(eqv?
(bitwise-copy-bit (- (ash 1 257) 1) 257 0)
(- (ash 1 257) 1))
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 0 0)
#x-32b225d27f49c1fed301b89104)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 1 0)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 2 0)
#x-32b225d27f49c1fed301b89107)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 31 0)
#x-32b225d27f49c1fed381b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 32 0)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 63 0)
#x-32b225d27fc9c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 64 0)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 99 0)
#x-3ab225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 100 0)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 101 0)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 102 0)
#x-72b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 103 0)
#x-b2b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 104 0)
#x-132b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 1000 0)
#x-10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000032b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 0 0)
#x-cd4dda2d80b63e012cfe476efe)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 1 0)
#x-cd4dda2d80b63e012cfe476eff)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 2 0)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 31 0)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 32 0)
#x-cd4dda2d80b63e012dfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 63 0)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 64 0)
#x-cd4dda2d81b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 99 0)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 100 0)
#x-dd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 101 0)
#x-ed4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 102 0)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 103 0)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 104 0)
#x-1cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 1000 0)
#x-100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000cd4dda2d80b63e012cfe476efd)
(andmap
values
(let ([p? (lambda (i)
(= (bitwise-copy-bit -1 i 0) (- -1 (expt 2 i))))])
(let f ([i 0])
(if (fx= i 1000) '() (cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i)
(= (bitwise-copy-bit n i 0)
(logand (lognot (ash 1 i)) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random
(+ (- (ash (most-positive-fixnum) 5)
(ash (most-negative-fixnum) 5))
1))
(ash (most-negative-fixnum) 5))])
(let f ([i 0])
(if (fx= i
(* (integer-length (ash (most-negative-fixnum) 5))
2))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
(eqv?
(bitwise-copy-bit (+ (most-positive-fixnum) 1) 0 1)
(+ (most-positive-fixnum) 2))
(eqv?
(bitwise-copy-bit (- (most-negative-fixnum) 2) 0 1)
(- (most-negative-fixnum) 1))
(eqv?
(bitwise-copy-bit
0
(integer-length (most-positive-fixnum))
1)
(ash 1 (integer-length (most-positive-fixnum))))
(eqv?
(bitwise-copy-bit
0
(integer-length (most-positive-fixnum))
1)
(+ (most-positive-fixnum) 1))
(eqv? (bitwise-copy-bit 0 2 1) 4)
(eqv? (bitwise-copy-bit -1 2 1) -1)
(eqv? (bitwise-copy-bit -75 (expt 2 20) 1) -75)
(eqv? (bitwise-copy-bit -75 1000 1) -75)
(eqv? (bitwise-copy-bit 170 3 1) 170)
(eqv? (bitwise-copy-bit 170 4 1) 186)
(andmap
values
(let ([p? (lambda (i)
(fx= (bitwise-copy-bit 0 i 1) (ash 1 i)))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
'()
(cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i)
(fx= (bitwise-copy-bit n i 1) (fxlogor (fxsll 1 i) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random
(+ (- (most-positive-fixnum)
(most-negative-fixnum))
1))
(most-negative-fixnum))])
(let f ([i 0])
(if (fx= i (integer-length (most-positive-fixnum)))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
(eqv? (bitwise-copy-bit (ash 1 32) 31 1) (ash 3 31))
(eqv? (bitwise-copy-bit (ash 1 32) 32 1) (ash 1 32))
(eqv? (bitwise-copy-bit (ash 1 32) 33 1) (ash 3 32))
(eqv? (bitwise-copy-bit (ash 1 31) 30 1) (ash 3 30))
(eqv? (bitwise-copy-bit (ash 1 31) 31 1) (ash 1 31))
(eqv? (bitwise-copy-bit (ash 1 31) 32 1) (ash 3 31))
(eqv? (bitwise-copy-bit (ash 1 64) 63 1) (ash 3 63))
(eqv? (bitwise-copy-bit (ash 1 64) 64 1) (ash 1 64))
(eqv? (bitwise-copy-bit (ash 1 64) 65 1) (ash 3 64))
(eqv? (bitwise-copy-bit (ash 1 63) 62 1) (ash 3 62))
(eqv? (bitwise-copy-bit (ash 1 63) 63 1) (ash 1 63))
(eqv? (bitwise-copy-bit (ash 1 63) 64 1) (ash 3 63))
(eqv? (bitwise-copy-bit (ash 1 256) 255 1) (ash 3 255))
(eqv? (bitwise-copy-bit (ash 1 256) 256 1) (ash 1 256))
(eqv? (bitwise-copy-bit (ash 1 256) 257 1) (ash 3 256))
(eqv? (bitwise-copy-bit (ash 1 255) 254 1) (ash 3 254))
(eqv? (bitwise-copy-bit (ash 1 255) 255 1) (ash 1 255))
(eqv? (bitwise-copy-bit (ash 1 255) 256 1) (ash 3 255))
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 0 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 1 1)
#x-32b225d27f49c1fed301b89101)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 2 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 31 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 32 1)
#x-32b225d27f49c1fed201b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 63 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 64 1)
#x-32b225d27e49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 99 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 100 1)
#x-22b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 101 1)
#x-12b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 102 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 103 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 104 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-32b225d27f49c1fed301b89103 1000 1)
#x-32b225d27f49c1fed301b89103)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 0 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 1 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 2 1)
#x-cd4dda2d80b63e012cfe476ef9)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 31 1)
#x-cd4dda2d80b63e012c7e476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 32 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 63 1)
#x-cd4dda2d80363e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 64 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 99 1)
#x-c54dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 100 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 101 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 102 1)
#x-8d4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 103 1)
#x-4d4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 104 1)
#x-cd4dda2d80b63e012cfe476efd)
(eqv?
(bitwise-copy-bit #x-cd4dda2d80b63e012cfe476efd 1000 1)
#x-cd4dda2d80b63e012cfe476efd)
(andmap
values
(let ([p? (lambda (i)
(= (bitwise-copy-bit 0 i 1) (ash 1 i)))])
(let f ([i 0])
(if (fx= i 1000) '() (cons (p? i) (f (fx+ i 1)))))))
(let ([p? (lambda (n i)
(= (bitwise-copy-bit n i 1) (logor (ash 1 i) n)))])
(let g ([j 1000])
(or (fx= j 0)
(let ([n (+ (random
(+ (- (ash (most-positive-fixnum) 5)
(ash (most-negative-fixnum) 5))
1))
(ash (most-negative-fixnum) 5))])
(let f ([i 0])
(if (fx= i
(* (integer-length (ash (most-negative-fixnum) 5))
2))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
)
(mat real->flonum
(error? (real->flonum))
(error? (real->flonum 3 4))
(error? (real->flonum 'a))
(error? (real->flonum 3+4i))
(= (real->flonum (most-positive-fixnum))
(* (most-positive-fixnum) 1.0))
(= (real->flonum (+ (most-positive-fixnum) 1))
(+ (most-positive-fixnum) 1.0))
(= (real->flonum #e1e10000) +inf.0)
(= (real->flonum #e-1e10000) -inf.0)
(= (real->flonum 0) 0.0)
(= (real->flonum 1) 1.0)
(= (real->flonum -1) -1.0)
(= (real->flonum 4.5) 4.5)
(= (real->flonum 3/4) .75)
(= (real->flonum -3/4) -.75)
(= (real->flonum -3/4) -.75)
)
(mat div-and-mod
; div-and-mod
(error? (div-and-mod 3 0))
(error? (div-and-mod (+ (most-positive-fixnum) 1) 0))
(error? (div-and-mod 3/5 0))
(error? (div-and-mod 'a 17))
(error? (div-and-mod 17 '(a)))
; div
(error? (div 3 0))
(error? (div (+ (most-positive-fixnum) 1) 0))
(error? (div 3/5 0))
(error? (div 'a 17))
(error? (div 17 '(a)))
; mod
(error? (mod 3 0))
(error? (mod (+ (most-positive-fixnum) 1) 0))
(error? (mod 3/5 0))
(error? (mod 'a 17))
(error? (mod 17 '(a)))
; div-and-mod
(begin
(define $d&m div-and-mod)
(define ($dmpair x y)
(if (and (eq? y 0) (exact? x))
#f
(call-with-values (lambda () ($d&m x y)) cons)))
(define ($dmpairs x y)
(list ($dmpair x y) ($dmpair (- x) y) ($dmpair x (- y)) ($dmpair (- x) (- y))
($dmpair y x) ($dmpair (- y) x) ($dmpair y (- x)) ($dmpair (- y) (- x))))
(define ($dmequal? x y)
(cond
[(pair? x)
(and (pair? y)
($dmequal? (car x) (car y))
($dmequal? (cdr x) (cdr y)))]
[(number? x)
(and (number? y)
(if (inexact? x)
(and (inexact? y) (== x y))
(and (exact? y) (= x y))))]
[else (eq? x y)]))
#t)
($dmequal?
($dmpairs 0 1)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 24 8)
'((3 . 0) (-3 . 0) (-3 . 0) (3 . 0) (0 . 8) (-1 . 16) (0 . 8) (1 . 16)))
($dmequal?
($dmpairs 0 (expt (most-positive-fixnum) 3))
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0 1.0)
'((0.0 . 0.0) (0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0) (-inf.0 . +nan.0)))
($dmequal?
($dmpairs 0 3/4)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0.0 1)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 (* (most-positive-fixnum) 7))
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3.5)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3/4)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal? ; fixnum, fixnum
($dmpairs 3 1000)
'((0 . 3) (-1 . 997) (0 . 3) (1 . 997) (333 . 1) (-334 . 2) (-333 . 1) (334 . 2)))
($dmequal? ; fixnum, fixnum overflow case
($dmpair (most-negative-fixnum) -1)
(cons (- (most-negative-fixnum)) 0))
($dmequal? ; fixnum, bignum
($dmpairs 3 (expt (most-positive-fixnum) 3))
(case (fixnum-width)
[(30) '((0 . 3) (-1 . 154742504045981407517868028)
(0 . 3) (1 . 154742504045981407517868028)
(51580834681993802505956010 . 1) (-51580834681993802505956011 . 2)
(-51580834681993802505956010 . 1) (51580834681993802505956011 . 2))]
[(61) '((0 . 3)
(-1 . 1532495540865888854370663039795561568366082455163109372)
(0 . 3)
(1 . 1532495540865888854370663039795561568366082455163109372)
(510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(510831846955296284790221013265187189455360818387703125 . 0))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; fixnum, flonum
($dmpairs 3 15.5)
'((0.0 . 3.0) (-1.0 . 12.5) (-0.0 . 3.0) (1.0 . 12.5)
(5.0 . 0.5) (-6.0 . 2.5) (-5.0 . 0.5) (6.0 . 2.5)))
($dmequal? ; fixnum, ratnum
($dmpairs 3 32/7)
'((0 . 3) (-1 . 11/7) (0 . 3) (1 . 11/7)
(1 . 11/7) (-2 . 10/7) (-1 . 11/7) (2 . 10/7)))
($dmequal? ; bignum, flonum
($dmpairs (+ (most-positive-fixnum) 16) 0.25)
(case (fixnum-width)
[(30) '((2147483708.0 . 0.0) (-2147483708.0 . 0.0)
(-2147483708.0 . 0.0) (2147483708.0 . 0.0)
(0.0 . 0.25) (-1.0 . 536870926.75)
(-0.0 . 0.25) (1.0 . 536870926.75))]
[(61) '((4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(4.611686018427388e18 . 0.0) (0.0 . 0.25)
(-1.0 . 1.152921504606847e18) (-0.0 . 0.25)
(1.0 . 1.152921504606847e18))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; bignum, ratnum
($dmpairs (+ (most-positive-fixnum) 16) 3/11)
(case (fixnum-width)
[(30) '((1968526732 . 1/11) (-1968526733 . 2/11)
(-1968526732 . 1/11) (1968526733 . 2/11)
(0 . 3/11) (-1 . 5905580194/11) (0 . 3/11)
(1 . 5905580194/11))]
[(61) '((4227378850225105633 . 2/11)
(-4227378850225105634 . 1/11)
(-4227378850225105633 . 2/11)
(4227378850225105634 . 1/11) (0 . 3/11)
(-1 . 12682136550675316898/11) (0 . 3/11)
(1 . 12682136550675316898/11))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; flonum, flonum
($dmpairs 3.5 11.25)
'((0.0 . 3.5) (-1.0 . 7.75) (-0.0 . 3.5) (1.0 . 7.75)
(3.0 . 0.75) (-4.0 . 2.75) (-3.0 . 0.75) (4.0 . 2.75)))
($dmequal? ; flonum, ratnum
($dmpairs 3.5 23/2)
'((0.0 . 3.5) (-1.0 . 8.0) (-0.0 . 3.5) (1.0 . 8.0)
(3.0 . 1.0) (-4.0 . 2.5) (-3.0 . 1.0) (4.0 . 2.5)))
($dmequal? ; ratnum, ratnum
($dmpairs 3/5 23/7)
'((0 . 3/5) (-1 . 94/35) (0 . 3/5) (1 . 94/35)
(5 . 2/7) (-6 . 11/35) (-5 . 2/7) (6 . 11/35)))
; div with mod
(begin
(set! $d&m (lambda (x y) (values (div x y) (mod x y))))
#t)
($dmequal?
($dmpairs 0 1)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 24 8)
'((3 . 0) (-3 . 0) (-3 . 0) (3 . 0) (0 . 8) (-1 . 16) (0 . 8) (1 . 16)))
($dmequal?
($dmpairs 0 (expt (most-positive-fixnum) 3))
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0 1.0)
'((0.0 . 0.0) (0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0) (-inf.0 . +nan.0)))
($dmequal?
($dmpairs 0 3/4)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0.0 1)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 (* (most-positive-fixnum) 7))
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3.5)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3/4)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal? ; fixnum, fixnum
($dmpairs 3 1000)
'((0 . 3) (-1 . 997) (0 . 3) (1 . 997) (333 . 1) (-334 . 2) (-333 . 1) (334 . 2)))
($dmequal? ; fixnum, fixnum overflow case
($dmpair (most-negative-fixnum) -1)
(cons (- (most-negative-fixnum)) 0))
($dmequal? ; fixnum, bignum
($dmpairs 3 (expt (most-positive-fixnum) 3))
(case (fixnum-width)
[(30) '((0 . 3) (-1 . 154742504045981407517868028)
(0 . 3) (1 . 154742504045981407517868028)
(51580834681993802505956010 . 1)
(-51580834681993802505956011 . 2)
(-51580834681993802505956010 . 1)
(51580834681993802505956011 . 2))]
[(61) '((0 . 3)
(-1 . 1532495540865888854370663039795561568366082455163109372)
(0 . 3)
(1 . 1532495540865888854370663039795561568366082455163109372)
(510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(510831846955296284790221013265187189455360818387703125 . 0))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; fixnum, flonum
($dmpairs 3 15.5)
'((0.0 . 3.0) (-1.0 . 12.5) (-0.0 . 3.0) (1.0 . 12.5)
(5.0 . 0.5) (-6.0 . 2.5) (-5.0 . 0.5) (6.0 . 2.5)))
($dmequal? ; fixnum, ratnum
($dmpairs 3 32/7)
'((0 . 3) (-1 . 11/7) (0 . 3) (1 . 11/7)
(1 . 11/7) (-2 . 10/7) (-1 . 11/7) (2 . 10/7)))
($dmequal? ; bignum, flonum
($dmpairs (+ (most-positive-fixnum) 16) 0.25)
(case (fixnum-width)
[(30) '((2147483708.0 . 0.0) (-2147483708.0 . 0.0)
(-2147483708.0 . 0.0) (2147483708.0 . 0.0)
(0.0 . 0.25) (-1.0 . 536870926.75)
(-0.0 . 0.25) (1.0 . 536870926.75))]
[(61) '((4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(4.611686018427388e18 . 0.0) (0.0 . 0.25)
(-1.0 . 1.152921504606847e18) (-0.0 . 0.25)
(1.0 . 1.152921504606847e18))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; bignum, ratnum
($dmpairs (+ (most-positive-fixnum) 16) 3/11)
(case (fixnum-width)
[(30) '((1968526732 . 1/11) (-1968526733 . 2/11)
(-1968526732 . 1/11) (1968526733 . 2/11)
(0 . 3/11) (-1 . 5905580194/11) (0 . 3/11)
(1 . 5905580194/11))]
[(61) '((4227378850225105633 . 2/11)
(-4227378850225105634 . 1/11)
(-4227378850225105633 . 2/11)
(4227378850225105634 . 1/11) (0 . 3/11)
(-1 . 12682136550675316898/11) (0 . 3/11)
(1 . 12682136550675316898/11))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; flonum, flonum
($dmpairs 3.5 11.25)
'((0.0 . 3.5) (-1.0 . 7.75) (-0.0 . 3.5) (1.0 . 7.75)
(3.0 . 0.75) (-4.0 . 2.75) (-3.0 . 0.75) (4.0 . 2.75)))
($dmequal? ; flonum, ratnum
($dmpairs 3.5 23/2)
'((0.0 . 3.5) (-1.0 . 8.0) (-0.0 . 3.5) (1.0 . 8.0)
(3.0 . 1.0) (-4.0 . 2.5) (-3.0 . 1.0) (4.0 . 2.5)))
($dmequal? ; ratnum, ratnum
($dmpairs 3/5 23/7)
'((0 . 3/5) (-1 . 94/35) (0 . 3/5) (1 . 94/35)
(5 . 2/7) (-6 . 11/35) (-5 . 2/7) (6 . 11/35)))
)
(mat div0-and-mod0
; div0-and-mod0
(error? (div0-and-mod0 3 0))
(error? (div0-and-mod0 (+ (most-positive-fixnum) 1) 0))
(error? (div0-and-mod0 3/5 0))
(error? (div0-and-mod0 'a 17))
(error? (div0-and-mod0 17 '(a)))
; div0
(error? (div0 3 0))
(error? (div0 (+ (most-positive-fixnum) 1) 0))
(error? (div0 3/5 0))
(error? (div0 'a 17))
(error? (div0 17 '(a)))
; mod0
(error? (mod0 3 0))
(error? (mod0 (+ (most-positive-fixnum) 1) 0))
(error? (mod0 3/5 0))
(error? (mod0 'a 17))
(error? (mod0 17 '(a)))
; div0-and-mod0
(begin
(define $d&m div0-and-mod0)
(define ($dmpair x y)
(if (and (eq? y 0) (exact? x))
#f
(call-with-values (lambda () ($d&m x y)) cons)))
(define ($dmpairs x y)
(list ($dmpair x y) ($dmpair (- x) y) ($dmpair x (- y)) ($dmpair (- x) (- y))
($dmpair y x) ($dmpair (- y) x) ($dmpair y (- x)) ($dmpair (- y) (- x))))
#t)
($dmequal?
($dmpairs 0 1)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0 (expt (most-positive-fixnum) 3))
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0 1.0)
'((0.0 . 0.0) (0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0) (-inf.0 . +nan.0)))
($dmequal?
($dmpairs 0 3/4)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0.0 1)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 (* (most-positive-fixnum) 7))
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3.5)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3/4)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal? ; fixnum, fixnum
($dmpairs 3 1000)
'((0 . 3) (0 . -3) (0 . 3) (0 . -3) (333 . 1) (-333 . -1) (-333 . 1) (333 . -1)))
($dmequal? ; fixnum, fixnum overflow case
($dmpair (most-negative-fixnum) -1)
(cons (- (most-negative-fixnum)) 0))
($dmequal? ; fixnum, bignum
($dmpairs 3 (expt (most-positive-fixnum) 3))
(case (fixnum-width)
[(30) '((0 . 3) (0 . -3) (0 . 3) (0 . -3)
(51580834681993802505956010 . 1)
(-51580834681993802505956010 . -1)
(-51580834681993802505956010 . 1)
(51580834681993802505956010 . -1))]
[(61) '((0 . 3) (0 . -3) (0 . 3) (0 . -3)
(510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(510831846955296284790221013265187189455360818387703125 . 0))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; fixnum, flonum
($dmpairs 3 15.5)
'((0.0 . 3.0) (0.0 . -3.0) (-0.0 . 3.0) (0.0 . -3.0)
(5.0 . 0.5) (-5.0 . -0.5) (-5.0 . 0.5) (5.0 . -0.5)))
($dmequal? ; fixnum, ratnum
($dmpairs 3 32/7)
'((1 . -11/7) (-1 . 11/7) (-1 . -11/7) (1 . 11/7)
(2 . -10/7) (-2 . 10/7) (-2 . -10/7) (2 . 10/7)))
($dmequal? ; bignum, flonum
($dmpairs (+ (most-positive-fixnum) 16) 0.25)
(case (fixnum-width)
[(30) '((2147483708.0 . 0.0) (-2147483708.0 . 0.0)
(-2147483708.0 . 0.0) (2147483708.0 . 0.0)
(0.0 . 0.25) (0.0 . -0.25) (-0.0 . 0.25)
(0.0 . -0.25))]
[(61) '((4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(4.611686018427388e18 . 0.0) (0.0 . 0.25)
(0.0 . 0.0) (-0.0 . 0.25) (0.0 . 0.0))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; bignum, ratnum
($dmpairs (+ (most-positive-fixnum) 16) 3/11)
(case (fixnum-width)
[(30) '((1968526732 . 1/11) (-1968526732 . -1/11)
(-1968526732 . 1/11) (1968526732 . -1/11)
(0 . 3/11) (0 . -3/11) (0 . 3/11) (0 . -3/11))]
[(61) '((4227378850225105634 . -1/11)
(-4227378850225105634 . 1/11)
(-4227378850225105634 . -1/11)
(4227378850225105634 . 1/11) (0 . 3/11)
(0 . -3/11) (0 . 3/11) (0 . -3/11))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; flonum, flonum
($dmpairs 3.5 11.25)
'((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
(3.0 . 0.75) (-3.0 . -0.75) (-3.0 . 0.75) (3.0 . -0.75)))
($dmequal? ; flonum, ratnum
($dmpairs 3.5 23/2)
'((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
(3.0 . 1.0) (-3.0 . -1.0) (-3.0 . 1.0) (3.0 . -1.0)))
($dmequal? ; ratnum, ratnum
($dmpairs 3/5 23/7)
'((0 . 3/5) (0 . -3/5) (0 . 3/5) (0 . -3/5)
(5 . 2/7) (-5 . -2/7) (-5 . 2/7) (5 . -2/7)))
; div0 with mod0
(begin
(set! $d&m (lambda (x y) (values (div0 x y) (mod0 x y))))
#t)
($dmequal?
($dmpairs 0 1)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0 (expt (most-positive-fixnum) 3))
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0 1.0)
'((0.0 . 0.0) (0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0) (-inf.0 . +nan.0)))
($dmequal?
($dmpairs 0 3/4)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
($dmequal?
($dmpairs 0.0 1)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 (* (most-positive-fixnum) 7))
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3.5)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal?
($dmpairs 0.0 3/4)
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
($dmequal? ; fixnum, fixnum
($dmpairs 3 1000)
'((0 . 3) (0 . -3) (0 . 3) (0 . -3) (333 . 1) (-333 . -1) (-333 . 1) (333 . -1)))
($dmequal? ; fixnum, fixnum overflow case
($dmpair (most-negative-fixnum) -1)
(cons (- (most-negative-fixnum)) 0))
($dmequal? ; fixnum, bignum
($dmpairs 3 (expt (most-positive-fixnum) 3))
(case (fixnum-width)
[(30) '((0 . 3) (0 . -3) (0 . 3) (0 . -3)
(51580834681993802505956010 . 1)
(-51580834681993802505956010 . -1)
(-51580834681993802505956010 . 1)
(51580834681993802505956010 . -1))]
[(61) '((0 . 3) (0 . -3) (0 . 3) (0 . -3)
(510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(-510831846955296284790221013265187189455360818387703125 . 0)
(510831846955296284790221013265187189455360818387703125 . 0))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; fixnum, flonum
($dmpairs 3 15.5)
'((0.0 . 3.0) (0.0 . -3.0) (-0.0 . 3.0) (0.0 . -3.0)
(5.0 . 0.5) (-5.0 . -0.5) (-5.0 . 0.5) (5.0 . -0.5)))
($dmequal? ; fixnum, ratnum
($dmpairs 3 32/7)
'((1 . -11/7) (-1 . 11/7) (-1 . -11/7) (1 . 11/7)
(2 . -10/7) (-2 . 10/7) (-2 . -10/7) (2 . 10/7)))
($dmequal? ; bignum, flonum
($dmpairs (+ (most-positive-fixnum) 16) 0.25)
(case (fixnum-width)
[(30) '((2147483708.0 . 0.0) (-2147483708.0 . 0.0)
(-2147483708.0 . 0.0) (2147483708.0 . 0.0)
(0.0 . 0.25) (0.0 . -0.25) (-0.0 . 0.25)
(0.0 . -0.25))]
[(61) '((4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(-4.611686018427388e18 . 0.0)
(4.611686018427388e18 . 0.0) (0.0 . 0.25)
(0.0 . 0.0) (-0.0 . 0.25) (0.0 . 0.0))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; bignum, ratnum
($dmpairs (+ (most-positive-fixnum) 16) 3/11)
(case (fixnum-width)
[(30) '((1968526732 . 1/11) (-1968526732 . -1/11)
(-1968526732 . 1/11) (1968526732 . -1/11)
(0 . 3/11) (0 . -3/11) (0 . 3/11) (0 . -3/11))]
[(61) '((4227378850225105634 . -1/11)
(-4227378850225105634 . 1/11)
(-4227378850225105634 . -1/11)
(4227378850225105634 . 1/11) (0 . 3/11)
(0 . -3/11) (0 . 3/11) (0 . -3/11))]
[else (errorf #f "mat does not handle fixnum width")]))
($dmequal? ; flonum, flonum
($dmpairs 3.5 11.25)
'((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
(3.0 . 0.75) (-3.0 . -0.75) (-3.0 . 0.75) (3.0 . -0.75)))
($dmequal? ; flonum, ratnum
($dmpairs 3.5 23/2)
'((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
(3.0 . 1.0) (-3.0 . -1.0) (-3.0 . 1.0) (3.0 . -1.0)))
($dmequal? ; ratnum, ratnum
($dmpairs 3/5 23/7)
'((0 . 3/5) (0 . -3/5) (0 . 3/5) (0 . -3/5)
(5 . 2/7) (-5 . -2/7) (-5 . 2/7) (5 . -2/7)))
)
(mat special-cases ; test special cases added Feb 2020
(begin
(define $n 40910371311673474504209841881478505181983799806634563)
(define $-n (- $n))
(define $q 40910371311673474504209841881478505181983799806634563/7312893582423593745243587)
(define $-q (- $q))
(define $x 1.499423325079378e100)
(define $-x (- $x))
(define $ez 3+4i)
(define $-ez (- $ez))
(define $iz 3.0-4.0i)
(define $-iz (- $iz))
#t)
(error? ; not a number
(div-and-mod 'bogus 1))
(error? ; not a number
(div-and-mod 'bogus -1))
(error? ; domain error
(div-and-mod $n 4+3i))
(error? ; domain error
(div-and-mod 4+3i $n))
(error? ; domain error
(div-and-mod 0 0))
(error? ; domain error
(div-and-mod $n 0))
(error? ; domain error
(div-and-mod $q 0))
(error? ; not a number
(div 'bogus 1))
(error? ; not a number
(div 'bogus -1))
(error? ; domain error
(div $n 4+3i))
(error? ; domain error
(div 4+3i $n))
(error? ; domain error
(div 0 0))
(error? ; domain error
(div $n 0))
(error? ; domain error
(div $q 0))
(error? ; not a number
(mod 'bogus 1))
(error? ; not a number
(mod 'bogus -1))
(error? ; domain error
(mod $n 4+3i))
(error? ; domain error
(mod 4+3i $n))
(error? ; domain error
(mod 0 0))
(error? ; domain error
(mod $n 0))
(error? ; domain error
(mod $q 0))
(error? ; not a number
(div0-and-mod0 'bogus 1))
(error? ; not a number
(div0-and-mod0 'bogus -1))
(error? ; domain error
(div0-and-mod0 $n 4+3i))
(error? ; domain error
(div0-and-mod0 4+3i $n))
(error? ; domain error
(div0-and-mod0 0 0))
(error? ; domain error
(div0-and-mod0 $n 0))
(error? ; domain error
(div0-and-mod0 $q 0))
(error? ; not a number
(div0 'bogus 1))
(error? ; not a number
(div0 'bogus -1))
(error? ; domain error
(div0 $n 4+3i))
(error? ; domain error
(div0 4+3i $n))
(error? ; domain error
(div0 0 0))
(error? ; domain error
(div0 $n 0))
(error? ; domain error
(div0 $q 0))
(error? ; not a number
(mod0 'bogus 1))
(error? ; not a number
(mod0 'bogus -1))
(error? ; domain error
(mod0 $n 4+3i))
(error? ; domain error
(mod0 4+3i $n))
(error? ; domain error
(mod0 0 0))
(error? ; domain error
(mod0 $n 0))
(error? ; domain error
(mod0 $q 0))
(error? ; not a number
(quotient 'bogus 1))
(error? ; not a number
(quotient 'bogus -1))
(error? ; domain error
(quotient $n 4+3i))
(error? ; domain error
(quotient 4.5 $n))
(error? ; domain error
(quotient 0 0))
(error? ; domain error
(quotient $n 0))
(error? ; domain error
(quotient 4.0 0))
(error? ; not a number
(remainder 'bogus 1))
(error? ; not a number
(remainder 'bogus -1))
(error? ; domain error
(remainder $n 4+3i))
(error? ; domain error
(remainder 4.5 $n))
(error? ; domain error
(remainder 0 0))
(error? ; domain error
(remainder $n 0))
(error? ; domain error
(remainder 4.0 0))
(error? ; not a number
(modulo 'bogus 1))
(error? ; not a number
(modulo 'bogus -1))
(error? ; domain error
(modulo $n 4+3i))
(error? ; domain error
(modulo 4.5 $n))
(error? ; domain error
(modulo 0 0))
(error? ; domain error
(modulo $n 0))
(error? ; domain error
(modulo 4.0 0))
(error? ; not a number
(/ 'bogus 1))
(error? ; not a number
(/ 'bogus -1))
(error? ; domain error
(/ 0 0))
(error? ; domain error
(/ $n 0))
(error? ; domain error
(/ $q 0))
(error? ; domain error
(/ $ez 0))
(error? ; not a number
(* 'bogus 0))
(error? ; not a number
(* 'bogus 1))
(error? ; not a number
(* 'bogus -1))
(error? ; not a number
(* 0 'bogus))
(error? ; not a number
(* 1 'bogus))
(error? ; not a number
(* -1 'bogus))
(error? ; not a number
(+ 'bogus 0))
(error? ; not a number
(+ 0 'bogus))
(error? ; not a number
(- 'bogus 0))
(error? ; not a number
(- 0 'bogus))
(equal? (call-with-values (lambda () (div-and-mod $n 1)) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (div-and-mod $n -1)) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (div-and-mod $-n 1)) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (div-and-mod $-n -1)) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (values (div $n 1) (mod $n 1))) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (values (div $n -1) (mod $n -1))) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (values (div $-n 1) (mod $n 1))) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (values (div $-n -1) (mod $n -1))) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (div0-and-mod0 $n 1)) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (div0-and-mod0 $n -1)) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (div0-and-mod0 $-n 1)) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (div0-and-mod0 $-n -1)) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (values (div0 $n 1) (mod0 $n 1))) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (values (div0 $n -1) (mod0 $n -1))) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (values (div0 $-n 1) (mod0 $n 1))) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (values (div0 $-n -1) (mod0 $n -1))) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (values (quotient $n 1) (remainder $n 1))) cons) `(,$n . 0))
(equal? (call-with-values (lambda () (values (quotient $n -1) (remainder $n -1))) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (values (quotient $-n 1) (remainder $n 1))) cons) `(,$-n . 0))
(equal? (call-with-values (lambda () (values (quotient $-n -1) (remainder $n -1))) cons) `(,$n . 0))
(equal? (modulo $n 1) 0)
(equal? (modulo $n -1) 0)
(equal? (modulo $-n 1) 0)
(equal? (modulo $-n -1) 0)
(equal? (/ $n 1) $n)
(equal? (/ $n -1) $-n)
(equal? (/ $-n 1) $-n)
(equal? (/ $-n -1) $n)
(equal? (/ 0 $n) 0)
(equal? (/ 0 $-n) 0)
(equal? (/ $q 1) $q)
(equal? (/ $q -1) $-q)
(equal? (/ $-q 1) $-q)
(equal? (/ $-q -1) $q)
(equal? (/ $x 1) $x)
(equal? (/ $x -1) $-x)
(equal? (/ $-x 1) $-x)
(equal? (/ $-x -1) $x)
(equal? (/ $ez 1) $ez)
(equal? (/ $ez -1) $-ez)
(equal? (/ $-ez 1) $-ez)
(equal? (/ $-ez -1) $ez)
(equal? (/ $iz 1) $iz)
(equal? (/ $iz -1) $-iz)
(equal? (/ $-iz 1) $-iz)
(equal? (/ $-iz -1) $iz)
(equal? (* $n 1) $n)
(equal? (* $n -1) $-n)
(equal? (* $-n 1) $-n)
(equal? (* $-n -1) $n)
(equal? (* $n 0) 0)
(equal? (* $-n 0) 0)
(equal? (* $q 1) $q)
(equal? (* $q -1) $-q)
(equal? (* $-q 1) $-q)
(equal? (* $-q -1) $q)
(equal? (* $q 0) 0)
(equal? (* $-q 0) 0)
(equal? (* $x 1) $x)
(equal? (* $x -1) $-x)
(equal? (* $-x 1) $-x)
(equal? (* $-x -1) $x)
(equal? (* $x 0) 0)
(equal? (* $-x 0) 0)
(equal? (* $ez 1) $ez)
(equal? (* $ez -1) $-ez)
(equal? (* $-ez 1) $-ez)
(equal? (* $-ez -1) $ez)
(equal? (* $ez 0) 0)
(equal? (* $-ez 0) 0)
(equal? (* $iz 1) $iz)
(equal? (* $iz -1) $-iz)
(equal? (* $-iz 1) $-iz)
(equal? (* $-iz -1) $iz)
(equal? (* $iz 0) 0)
(equal? (* $-iz 0) 0)
(equal? (* 1 $n) $n)
(equal? (* -1 $n) $-n)
(equal? (* 1 $-n) $-n)
(equal? (* -1 $-n) $n)
(equal? (* 0 $n) 0)
(equal? (* 0 $-n) 0)
(equal? (* 1 $q) $q)
(equal? (* -1 $q) $-q)
(equal? (* 1 $-q) $-q)
(equal? (* -1 $-q) $q)
(equal? (* 0 $q) 0)
(equal? (* 0 $-q) 0)
(equal? (* 1 $x) $x)
(equal? (* -1 $x) $-x)
(equal? (* 1 $-x) $-x)
(equal? (* -1 $-x) $x)
(equal? (* 0 $x) 0)
(equal? (* 0 $-x) 0)
(equal? (* 1 $ez) $ez)
(equal? (* -1 $ez) $-ez)
(equal? (* 1 $-ez) $-ez)
(equal? (* -1 $-ez) $ez)
(equal? (* 0 $ez) 0)
(equal? (* 0 $-ez) 0)
(equal? (* 1 $iz) $iz)
(equal? (* -1 $iz) $-iz)
(equal? (* 1 $-iz) $-iz)
(equal? (* -1 $-iz) $iz)
(equal? (* 0 $iz) 0)
(equal? (* 0 $-iz) 0)
(equal? (+ $n 0) $n)
(equal? (+ $-n 0) $-n)
(equal? (+ 0 $n) $n)
(equal? (+ 0 $-n) $-n)
(equal? (+ $q 0) $q)
(equal? (+ $-q 0) $-q)
(equal? (+ 0 $q) $q)
(equal? (+ 0 $-q) $-q)
(equal? (+ $x 0) $x)
(equal? (+ $-x 0) $-x)
(equal? (+ 0 $x) $x)
(equal? (+ 0 $-x) $-x)
(equal? (+ $ez 0) $ez)
(equal? (+ $-ez 0) $-ez)
(equal? (+ 0 $ez) $ez)
(equal? (+ 0 $-ez) $-ez)
(equal? (+ $iz 0) $iz)
(equal? (+ $-iz 0) $-iz)
(equal? (+ 0 $iz) $iz)
(equal? (+ 0 $-iz) $-iz)
(equal? (- $n 0) $n)
(equal? (- $-n 0) $-n)
(equal? (- 0 $n) $-n)
(equal? (- 0 $-n) $n)
(equal? (- $q 0) $q)
(equal? (- $-q 0) $-q)
(equal? (- 0 $q) $-q)
(equal? (- 0 $-q) $q)
(equal? (- $x 0) $x)
(equal? (- $-x 0) $-x)
(equal? (- 0 $x) $-x)
(equal? (- 0 $-x) $x)
(equal? (- $ez 0) $ez)
(equal? (- $-ez 0) $-ez)
(equal? (- 0 $ez) $-ez)
(equal? (- 0 $-ez) $ez)
(equal? (- $iz 0) $iz)
(equal? (- $-iz 0) $-iz)
(equal? (- 0 $iz) $-iz)
(equal? (- 0 $-iz) $iz)
(equal? (- 0 (most-negative-fixnum)) (+ (most-positive-fixnum) 1))
)
(mat benchmarks
(let ()
; revert to the original values for benchmarking
(define runs 1 #;10)
(define iter 1 #;100000)
(define min-ns 0 #;#e25e7)
(define time->ns
(lambda (t)
(+ (* (time-second t) 1000000000) (time-nanosecond t))))
(define mean
(lambda (ls)
(assert (not (null? ls)))
(/ (apply + ls) (length ls))))
(define stddev
(lambda (m ls)
(define (square x) (* x x))
(sqrt (mean (map (lambda (x) (square (- x m))) ls)))))
(define ($run-one expr th expected)
(define (do-big-iter)
(collect 0 0)
(let ([t0 (current-time 'time-monotonic)])
(do ([iter iter (#3%fx- iter 1)] [ans #f (th)])
((#3%fx= iter 0)
(let ([t (time-difference t0 (current-time 'time-monotonic))])
(unless (equal? ans expected) (errorf #f "oops ~s != ~s for ~s" ans expected expr))
t)))))
(parameterize ([collect-request-handler void])
(collect (collect-maximum-generation))
; warm up and calibrate number of ITERATIONS to at least meet min-ns
(let ([ITER (let loop ([ITER 1] [t (make-time 'time-duration 0 0)])
(let ([t (time-difference t (do-big-iter))])
(if (>= (time->ns t) min-ns)
ITER
(loop (fx+ ITER 1) t))))])
(do ([run runs (#3%fx- run 1)]
[t* '() (cons
(let loop ([ITER ITER] [t (make-time 'time-duration 0 0)])
(do ([ITER ITER (#3%fx- ITER 1)]
[t (make-time 'time-duration 0 0) (time-difference t (do-big-iter))])
((#3%fx= ITER 0) t)))
t*)])
((#3%fx= run 0)
(let ([ns* (map time->ns (reverse t*))])
(let ([m (mean ns*)])
(printf "~s\n" (vector expr (/ m ITER) (if (= m 0) 0 (/ (stddev m ns*) m)) ITER))
(flush-output-port))))))))
(let ()
(define (run sra)
(define-syntax run-one
(lambda (x)
(define prettify
(lambda (x)
(let-values ([(neg? x) (if (< x 0) (values #t (- x)) (values #f x))])
(let ([s (format "~{~a~^+~}"
(let loop ([x x] [k 0] [ls '()])
(let ([b (bitwise-first-bit-set x)])
(if (= b -1)
ls
(let ([k (+ k b)])
(loop (bitwise-arithmetic-shift-right x (fx+ b 1)) (fx+ k 1)
(cons (if (= k 0) "1" (format "2^~a" k)) ls)))))))])
(if neg? (format "-(~a)" s) s)))))
(syntax-case x ()
[(_ sra x k expected)
(with-syntax ([n (eval (datum x))])
(with-syntax ([expr (format "(sra ~a ~s)" (prettify (datum n)) (datum k))])
#'($run-one expr (lambda () (sra n k)) expected)))])))
(printf "((iter . ~s) (min-ns . ~s))\n" iter min-ns)
(printf "(\n")
(run-one sra 1 1 0)
(run-one sra (ash 1 1024) 1024 1)
(run-one sra (ash 1 1024) 512 (ash 1 512))
(run-one sra (- (ash 1 1024)) 1024 -1)
(run-one sra (- (ash 1 1024)) 512 (- (ash 1 512)))
(run-one sra (+ (ash 1 1024) 1) 1024 1)
(run-one sra (+ (ash 1 1024) 1) 512 (ash 1 512))
(run-one sra (- (+ (ash 1 1024) 1)) 1024 -2)
(run-one sra (- (+ (ash 1 1024) 1)) 512 (- -1 (ash 1 512)))
(run-one sra (- (ash 1 1024)) 1024 -1)
(run-one sra (- (ash 1 1024)) 512 (- (ash 1 512)))
(run-one sra (ash 1 1024) 1025 0)
(run-one sra (- (ash 1 1024)) 1025 -1)
(run-one sra (ash 3 1023) 1024 1)
(run-one sra (- (ash 3 1023)) 1024 -2)
(run-one sra (ash 3 1023) 1025 0)
(run-one sra (- (ash 3 1023)) 1025 -1)
(run-one sra (ash 1 1000000) 1000000 1)
(run-one sra (- (ash 1 1000000)) 1000000 -1)
(run-one sra (ash 1 1000000) 1000001 0)
(run-one sra (- (ash 1 1000000)) 1000001 -1)
(run-one sra (ash 3 1000000) 1000001 1)
(run-one sra (- (ash 3 1000000)) 1000001 -2)
(run-one sra (ash 3 1000000) 1000002 0)
(run-one sra (- (ash 3 1000000)) 1000002 -1)
; worst-case---only shifted-off one bit is in the middle
(run-one sra (- (+ (ash 1 1024) (ash 1 512))) 1024 -2)
; shift by one bit
(run-one sra (ash 3 1000000) 1 (ash 3 999999))
(run-one sra (- (ash 3 1000000)) 1 (- (ash 3 999999)))
(printf ")\n"))
(run bitwise-arithmetic-shift-right)
(run (lambda (x k) (bitwise-arithmetic-shift x (- k))))
(run (lambda (x k) (ash x (- k)))))
(let ()
(define (run)
(define $x 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789)
(define $y (* (most-positive-fixnum) 2))
(define-syntax run-one
(syntax-rules ()
[(_ expr expected)
($run-one 'expr (lambda () expr) expected)]
[(_ expr expected ...)
($run-one 'expr (lambda () (call-with-values (lambda () expr) list)) (list expected ...))]))
(define $2x (* 2 $x))
(define $x+2 (+ $x 2))
(define $-x (- $x))
(define $x^4 (* $x $x $x $x))
(define $-x^4 (- $x^4))
(define $2y (* $y 2))
(define $y+2 (+ $y 2))
(printf "((iter . ~s) (min-ns . ~s) ($x . ~s) ($y . ~s))\n" iter min-ns $x $y)
(printf "(\n")
(run-one 0 0)
(run-one (* $x 0) 0)
(run-one (* $x^4 0) 0)
(run-one (* $x 1) $x)
(run-one (* $x^4 1) $x^4)
(run-one (* $x -1) $-x)
(run-one (* $x^4 -1) $-x^4)
(run-one (* 1 $x) $x)
(run-one (* 1 $x^4) $x^4)
(run-one (* -1 $x) $-x)
(run-one (* -1 $x^4) $-x^4)
(run-one (/ $x 1) $x)
(run-one (/ $x^4 1) $x^4)
(run-one (/ $x -1) $-x)
(run-one (/ $x^4 -1) $-x^4)
(run-one (+ $x 0) $x)
(run-one (+ $x^4 0) $x^4)
(run-one (- $x 0) $x)
(run-one (- $x^4 0) $x^4)
(run-one (+ 0 $x) $x)
(run-one (+ 0 $x^4) $x^4)
(run-one (- 0 $x) $-x)
(run-one (- 0 $x^4) $-x^4)
(run-one (quotient $x 1) $x)
(run-one (quotient $x^4 1) $x^4)
(run-one (quotient $x -1) $-x)
(run-one (remainder $x 1) 0)
(run-one (remainder $x^4 1) 0)
(run-one (remainder $x -1) 0)
(run-one (div-and-mod $x 1) $x 0)
(run-one (div-and-mod $x^4 1) $x^4 0)
(run-one (div-and-mod $x -1) $-x 0)
(run-one (div0-and-mod0 $x 1) $x 0)
(run-one (div0-and-mod0 $x^4 1) $x^4 0)
(run-one (div0-and-mod0 $x -1) $-x 0)
(run-one (div $x 1) $x)
(run-one (div $x^4 1) $x^4)
(run-one (div $x -1) $-x)
(run-one (div0 $x 1) $x)
(run-one (div0 $x^4 1) $x^4)
(run-one (div0 $x -1) $-x)
(run-one (mod $x 1) 0)
(run-one (mod $x^4 1) 0)
(run-one (mod $x -1) 0)
(run-one (mod0 $x 1) 0)
(run-one (mod0 $x^4 1) 0)
(run-one (mod0 $x -1) 0)
; these should not improve and we hope not slow down measurably
(run-one (* $y 2) $2y)
(run-one (/ $2y 2) $y)
(run-one (+ $y 2) $y+2)
(run-one (- $y -2) $y+2)
(run-one (quotient $y 2) (ash $y -1))
(run-one (remainder $y 2) (logand $y 1))
(run-one (div-and-mod $2y 2) $y 0)
(run-one (div0-and-mod0 $2y 2) $y 0)
(run-one (div $2y 2) $y)
(run-one (div0 $2y 2) $y)
(run-one (mod $2y 2) 0)
(run-one (mod0 $2y 2) 0)
(printf ")\n"))
(run))
; use with --program to compare results
#;(top-level-program
(import (chezscheme))
(unless (= (length (command-line-arguments)) 3)
(fprintf (current-error-port) "usage: ~a: <output-file> <before-input-file> <after-input-file>\n" (car (command-line)))
(exit 1))
(let ([reportfn (car (command-line-arguments))]
[beforefn (cadr (command-line-arguments))]
[afterfn (caddr (command-line-arguments))])
(let-values ([(before-info before) (with-input-from-file beforefn (lambda () (let ([info (read)]) (values info (read)))))]
[(after-info after) (with-input-from-file afterfn (lambda () (let ([info (read)]) (values info (read)))))])
(with-output-to-file reportfn
(lambda ()
(unless (equal? before-info after-info) (errorf #f "before info ~s and after info ~s differ" before-info after-info))
(let ([iter (cond [(assq 'iter before-info) => cdr] [else (errorf #f "expected to find binding for iter in info\n")])])
(printf "<html><head><title>Results ~a</title></head><body><table cellspacing=\"10em\">\n" (machine-type))
(printf "<p>~{~a~^<br>~}</p>" (map (lambda (a) (format "~s = ~s" (car a) (cdr a))) before-info))
(printf "<tr><th align=left>expression</th><th align=right>speedup</th><th align=right>before stddev</th><th align=right>after stddev</th><th align=right>before time (x~s)</th><th align=right>after time (x~s)</th><th align=right>before iterations</th><th align=right>after iterations</th></tr>\n" iter iter)
(for-each
(lambda (before after)
(define EXPR 0)
(define MEAN-NS 1)
(define STDDEV 2)
(define ITER 3)
(for-each
(lambda (i)
(unless (equal? (vector-ref before i) (vector-ref after i))
(errorf #f "comparing apples to oranges: ~s, ~s" before after)))
(list EXPR))
(printf "<tr><td align=left>~a</td><td align=right>~5,2f%</td><td align=right>~7,4f%</td><td align=right>~7,4f%</td><td align=right>~10,8f</td><td align=right>~10,8f</td><td align=right>~s</td><td align=right>~s</td></tr>\n"
(vector-ref before EXPR)
(* (/ (- (vector-ref before MEAN-NS) (vector-ref after MEAN-NS)) (vector-ref before MEAN-NS)) 100)
(vector-ref before STDDEV)
(vector-ref after STDDEV)
(/ (vector-ref before MEAN-NS) (expt 10 9))
(/ (vector-ref after MEAN-NS) (expt 10 9))
(vector-ref before ITER)
(vector-ref after ITER)
))
before
after)
(printf "</table></body></html>\n")))
'replace))))
#t)
)
Reference in a new issue Copy permalink