;;; 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: \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 "Results ~a\n" (machine-type)) (printf "

~{~a~^
~}

" (map (lambda (a) (format "~s = ~s" (car a) (cdr a))) before-info)) (printf "\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 "\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 "
expressionspeedupbefore stddevafter stddevbefore time (x~s)after time (x~s)before iterationsafter iterations
~a~5,2f%~7,4f%~7,4f%~10,8f~10,8f~s~s
\n"))) 'replace)))) #t) )