tmtt
/
chez-openbsd
Archived
1
0
Fork 0
Code Issues Pull Requests Releases 1 Activity
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
main
v9.5.9
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'main'
${ noResults }
chez-openbsd/mats/fx.ms

2907 lines
103 KiB
Scheme
Raw Permalink Blame History

;;; fx.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.
(mat fx=
(not (fx= 3 4))
(not (fx= 4 3))
(fx= 4 4)
(not (fx= -4 4))
(not (fx= 4 -4))
(not (fx= -4 -3))
(not (fx= -3 -4))
(fx= -4)
(fx= -4 -4)
(fx= -4 -4 -4)
(error? (fx= (list 'a)))
(error? (fx= (+ (most-positive-fixnum) 1) 3 2))
(error? (fx= (- (most-negative-fixnum) 1) 3))
(guard (c [#t #t]) (fx= 3 4 (error #f "oops")))
(guard (c [#t #t]) (fx= 3 (error #f "oops") 4))
(guard (c [#t #t]) (fx= (error #f "oops") 3 4))
(guard (c [#t #t]) (not (fx= (error #f "oops"))))
(test-cp0-expansion eqv? '(fx= -3 -7) #f)
(test-cp0-expansion eqv? '(fx= -3 0) #f)
(test-cp0-expansion eqv? '(fx= 0 -3) #f)
(test-cp0-expansion eqv? '(fx= 0 0) #t)
(test-cp0-expansion eqv? '(fx= -3 -3) #t)
(test-cp0-expansion eqv? '(fx= 12 12) #t)
(test-cp0-expansion eqv? '(fx= -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx= -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx= 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx= 0 0 0) #t)
(test-cp0-expansion eqv? '(fx= -3 -3 -3) #t)
(test-cp0-expansion eqv? '(fx= 12 12 12) #t)
)
(mat fx<
(fx< 3 4)
(not (fx< 4 3))
(not (fx< 4 4))
(fx< -4 4)
(not (fx< 4 -4))
(fx< -4 -3)
(not (fx< -3 -4))
(not (fx< -4 -4))
(not (fx< -4 -4))
(not (fx< -4 -4 -4))
(error? (fx< 'a))
(error? (fx< (+ (most-positive-fixnum) 1) 3 2))
(error? (fx< (- (most-negative-fixnum) 1) 3))
(guard (c [#t #t]) (fx< 4 3 (error #f "oops")))
(guard (c [#t #t]) (fx< 4 (error #f "oops") 3))
(guard (c [#t #t]) (fx< (error #f "oops") 4 3))
(guard (c [#t #t]) (not (fx< (error #f "oops"))))
(test-cp0-expansion eqv? '(fx< -3 -7) #f)
(test-cp0-expansion eqv? '(fx< -3 0) #t)
(test-cp0-expansion eqv? '(fx< 0 -3) #f)
(test-cp0-expansion eqv? '(fx< 0 0) #f)
(test-cp0-expansion eqv? '(fx< -3 -3) #f)
(test-cp0-expansion eqv? '(fx< 12 12) #f)
(test-cp0-expansion eqv? '(fx< -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx< -3 -2 0) #t)
(test-cp0-expansion eqv? '(fx< -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx< 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx< 0 0 0) #f)
(test-cp0-expansion eqv? '(fx< -3 -3 -3) #f)
(test-cp0-expansion eqv? '(fx< 12 12 12) #f)
)
(mat fx>
(not (fx> 3 4))
(fx> 4 3)
(not (fx> 4 4))
(not (fx> -4 4))
(fx> 4 -4)
(not (fx> -4 -3))
(fx> -3 -4)
(fx> -4)
(not (fx> -4 -4))
(not (fx> -4 -4 -4))
(error? (fx> "hi"))
(error? (fx> (+ (most-positive-fixnum) 1) 3 2))
(error? (fx> (- (most-negative-fixnum) 1) 3))
(guard (c [#t #t]) (fx> 3 4 (error #f "oops")))
(guard (c [#t #t]) (fx> 3 (error #f "oops") 4))
(guard (c [#t #t]) (fx> (error #f "oops") 3 4))
(guard (c [#t #t]) (not (fx> (error #f "oops"))))
(test-cp0-expansion eqv? '(fx> -3 -7) #t)
(test-cp0-expansion eqv? '(fx> -3 0) #f)
(test-cp0-expansion eqv? '(fx> 0 -3) #t)
(test-cp0-expansion eqv? '(fx> 0 0) #f)
(test-cp0-expansion eqv? '(fx> -3 -3) #f)
(test-cp0-expansion eqv? '(fx> 12 12) #f)
(test-cp0-expansion eqv? '(fx> -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx> -3 -2 0) #f)
(test-cp0-expansion eqv? '(fx> 0 -2 -3) #t)
(test-cp0-expansion eqv? '(fx> -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx> 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx> 0 0 0) #f)
(test-cp0-expansion eqv? '(fx> -3 -3 -3) #f)
(test-cp0-expansion eqv? '(fx> 12 12 12) #f)
)
(mat fx<=
(fx<= 3 4)
(not (fx<= 4 3))
(fx<= 4 4)
(fx<= -4 4)
(not (fx<= 4 -4))
(fx<= -4 -3)
(not (fx<= -3 -4))
(fx<= -4)
(fx<= -4 -4)
(fx<= -4 -4 -4)
(error? (fx<= '(a . b)))
(error? (fx<= (+ (most-positive-fixnum) 1) 3 2))
(error? (fx<= (- (most-negative-fixnum) 1) 3))
(guard (c [#t #t]) (fx<= 4 3 (error #f "oops")))
(guard (c [#t #t]) (fx<= 4 (error #f "oops") 3))
(guard (c [#t #t]) (fx<= (error #f "oops") 4 3))
(guard (c [#t #t]) (not (fx<= (error #f "oops"))))
(test-cp0-expansion eqv? '(fx<= -3 -7) #f)
(test-cp0-expansion eqv? '(fx<= -3 0) #t)
(test-cp0-expansion eqv? '(fx<= 0 -3) #f)
(test-cp0-expansion eqv? '(fx<= 0 0) #t)
(test-cp0-expansion eqv? '(fx<= -3 -3) #t)
(test-cp0-expansion eqv? '(fx<= 12 12) #t)
(test-cp0-expansion eqv? '(fx<= -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx<= -3 -2 0) #t)
(test-cp0-expansion eqv? '(fx<= 0 -2 -3) #f)
(test-cp0-expansion eqv? '(fx<= -3 -3 0) #t)
(test-cp0-expansion eqv? '(fx<= 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx<= 0 0 0) #t)
(test-cp0-expansion eqv? '(fx<= -3 -3 -3) #t)
(test-cp0-expansion eqv? '(fx<= 12 12 12) #t)
)
(mat fx>=
(not (fx>= 3 4))
(fx>= 4 3)
(fx>= 4 4)
(not (fx>= -4 4))
(fx>= 4 -4)
(not (fx>= -4 -3))
(fx>= -3 -4)
(fx>= -4)
(fx>= -4 -4)
(fx>= -4 -4 -4)
(error? (fx>= '(a . b)))
(error? (fx>= (+ (most-positive-fixnum) 1) 3 2))
(error? (fx>= (- (most-negative-fixnum) 1) 3))
(guard (c [#t #t]) (fx>= 3 4 (error #f "oops")))
(guard (c [#t #t]) (fx>= 3 (error #f "oops") 4))
(guard (c [#t #t]) (fx>= (error #f "oops") 3 4))
(guard (c [#t #t]) (not (fx<= (error #f "oops"))))
(test-cp0-expansion eqv? '(fx>= -3 -7) #t)
(test-cp0-expansion eqv? '(fx>= -3 0) #f)
(test-cp0-expansion eqv? '(fx>= 0 -3) #t)
(test-cp0-expansion eqv? '(fx>= 0 0) #t)
(test-cp0-expansion eqv? '(fx>= -3 -3) #t)
(test-cp0-expansion eqv? '(fx>= 12 12) #t)
(test-cp0-expansion eqv? '(fx>= -3 -7 -7) #t)
(test-cp0-expansion eqv? '(fx>= -3 -2 0) #f)
(test-cp0-expansion eqv? '(fx>= 0 -2 -3) #t)
(test-cp0-expansion eqv? '(fx>= -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx>= 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx>= 0 0 0) #t)
(test-cp0-expansion eqv? '(fx>= -3 -3 -3) #t)
(test-cp0-expansion eqv? '(fx>= 12 12 12) #t)
)
(mat fx=?
(not (fx=? 3 4))
(not (fx=? 4 3))
(fx=? 4 4)
(not (fx=? -4 4))
(not (fx=? 4 -4))
(not (fx=? -4 -3))
(not (fx=? -3 -4))
(fx=? -4 -4)
(fx=? -4 -4 -4)
(error? (fx=? (list 'a) 3))
(error? (fx=? (+ (greatest-fixnum) 1) 3 2))
(error? (fx=? (- (least-fixnum) 1) 3))
(error? (fx=? 1))
(fx=? (least-fixnum) (- (expt 2 (- (fixnum-width) 1))))
(fx=? (greatest-fixnum) (- (expt 2 (- (fixnum-width) 1)) 1))
(guard (c [#t #t]) (fx=? 3 4 (error #f "oops")))
(guard (c [#t #t]) (fx=? 3 (error #f "oops") 4))
(guard (c [#t #t]) (fx=? (error #f "oops") 3 4))
(guard (c [#t #t]) (not (fx=? (error #f "oops"))))
(test-cp0-expansion eqv? '(fx=? -3 -7) #f)
(test-cp0-expansion eqv? '(fx=? -3 0) #f)
(test-cp0-expansion eqv? '(fx=? 0 -3) #f)
(test-cp0-expansion eqv? '(fx=? 0 0) #t)
(test-cp0-expansion eqv? '(fx=? -3 -3) #t)
(test-cp0-expansion eqv? '(fx=? 12 12) #t)
(test-cp0-expansion eqv? '(fx=? -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx=? -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx=? 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx=? 0 0 0) #t)
(test-cp0-expansion eqv? '(fx=? -3 -3 -3) #t)
(test-cp0-expansion eqv? '(fx=? 12 12 12) #t)
)
(mat fx<?
(fx<? 3 4)
(not (fx<? 4 3))
(not (fx<? 4 4))
(fx<? -4 4)
(not (fx<? 4 -4))
(fx<? -4 -3)
(not (fx<? -3 -4))
(not (fx<? -4 -4))
(not (fx<? -4 -4))
(not (fx<? -4 -4 -4))
(error? (fx<? 'a 3))
(error? (fx<? (+ (greatest-fixnum) 1) 3 2))
(error? (fx<? (- (least-fixnum) 1) 3))
(error? (fx<? 1))
(guard (c [#t #t]) (fx<? 4 3 (error #f "oops")))
(guard (c [#t #t]) (fx<? 4 (error #f "oops") 3))
(guard (c [#t #t]) (fx<? (error #f "oops") 4 3))
(guard (c [#t #t]) (not (fx<? (error #f "oops"))))
(test-cp0-expansion eqv? '(fx<? -3 -7) #f)
(test-cp0-expansion eqv? '(fx<? -3 0) #t)
(test-cp0-expansion eqv? '(fx<? 0 -3) #f)
(test-cp0-expansion eqv? '(fx<? 0 0) #f)
(test-cp0-expansion eqv? '(fx<? -3 -3) #f)
(test-cp0-expansion eqv? '(fx<? 12 12) #f)
(test-cp0-expansion eqv? '(fx<? -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx<? -3 -2 0) #t)
(test-cp0-expansion eqv? '(fx<? 0 -2 -3) #f)
(test-cp0-expansion eqv? '(fx<? -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx<? 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx<? 0 0 0) #f)
(test-cp0-expansion eqv? '(fx<? -3 -3 -3) #f)
(test-cp0-expansion eqv? '(fx<? 12 12 12) #f)
)
(mat fx>?
(not (fx>? 3 4))
(fx>? 4 3)
(not (fx>? 4 4))
(not (fx>? -4 4))
(fx>? 4 -4)
(not (fx>? -4 -3))
(fx>? -3 -4)
(not (fx>? -4 -4))
(not (fx>? -4 -4 -4))
(error? (fx>? 3 "hi"))
(error? (fx>? (+ (greatest-fixnum) 1) 3 2))
(error? (fx>? (- (least-fixnum) 1) 3))
(error? (fx>? 1))
(guard (c [#t #t]) (fx>? 3 4 (error #f "oops")))
(guard (c [#t #t]) (fx>? 3 (error #f "oops") 4))
(guard (c [#t #t]) (fx>? (error #f "oops") 3 4))
(guard (c [#t #t]) (not (fx>? (error #f "oops"))))
(test-cp0-expansion eqv? '(fx>? -3 -7) #t)
(test-cp0-expansion eqv? '(fx>? -3 0) #f)
(test-cp0-expansion eqv? '(fx>? 0 -3) #t)
(test-cp0-expansion eqv? '(fx>? 0 0) #f)
(test-cp0-expansion eqv? '(fx>? -3 -3) #f)
(test-cp0-expansion eqv? '(fx>? 12 12) #f)
(test-cp0-expansion eqv? '(fx>? -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx>? -3 -2 0) #f)
(test-cp0-expansion eqv? '(fx>? 0 -2 -3) #t)
(test-cp0-expansion eqv? '(fx>? -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx>? 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx>? 0 0 0) #f)
(test-cp0-expansion eqv? '(fx>? -3 -3 -3) #f)
(test-cp0-expansion eqv? '(fx>? 12 12 12) #f)
)
(mat fx<=?
(fx<=? 3 4)
(not (fx<=? 4 3))
(fx<=? 4 4)
(fx<=? -4 4)
(not (fx<=? 4 -4))
(fx<=? -4 -3)
(not (fx<=? -3 -4))
(fx<=? -4 -4)
(fx<=? -4 -4 -4)
(error? (fx<=? 3 '(a . b)))
(error? (fx<=? (+ (greatest-fixnum) 1) 3 2))
(error? (fx<=? (- (least-fixnum) 1) 3))
(error? (fx<=? 1))
(guard (c [#t #t]) (fx<=? 4 3 (error #f "oops")))
(guard (c [#t #t]) (fx<=? 4 (error #f "oops") 3))
(guard (c [#t #t]) (fx<=? (error #f "oops") 4 3))
(guard (c [#t #t]) (not (fx<=? (error #f "oops"))))
(test-cp0-expansion eqv? '(fx<=? -3 -7) #f)
(test-cp0-expansion eqv? '(fx<=? -3 0) #t)
(test-cp0-expansion eqv? '(fx<=? 0 -3) #f)
(test-cp0-expansion eqv? '(fx<=? 0 0) #t)
(test-cp0-expansion eqv? '(fx<=? -3 -3) #t)
(test-cp0-expansion eqv? '(fx<=? 12 12) #t)
(test-cp0-expansion eqv? '(fx<=? -3 -7 -7) #f)
(test-cp0-expansion eqv? '(fx<=? -3 -2 0) #t)
(test-cp0-expansion eqv? '(fx<=? 0 -2 -3) #f)
(test-cp0-expansion eqv? '(fx<=? -3 -3 0) #t)
(test-cp0-expansion eqv? '(fx<=? 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx<=? 0 0 0) #t)
(test-cp0-expansion eqv? '(fx<=? -3 -3 -3) #t)
(test-cp0-expansion eqv? '(fx<=? 12 12 12) #t)
)
(mat fx>=?
(not (fx>=? 3 4))
(fx>=? 4 3)
(fx>=? 4 4)
(not (fx>=? -4 4))
(fx>=? 4 -4)
(not (fx>=? -4 -3))
(fx>=? -3 -4)
(fx>=? -4 -4)
(fx>=? -4 -4 -4)
(error? (fx>=? 3 '(a . b)))
(error? (fx>=? (+ (greatest-fixnum) 1) 3 2))
(error? (fx>=? (- (least-fixnum) 1) 3))
(error? (fx>=? 1))
(guard (c [#t #t]) (fx>=? 3 4 (error #f "oops")))
(guard (c [#t #t]) (fx>=? 3 (error #f "oops") 4))
(guard (c [#t #t]) (fx>=? (error #f "oops") 3 4))
(guard (c [#t #t]) (not (fx>=? (error #f "oops"))))
(test-cp0-expansion eqv? '(fx>=? -3 -7) #t)
(test-cp0-expansion eqv? '(fx>=? -3 0) #f)
(test-cp0-expansion eqv? '(fx>=? 0 -3) #t)
(test-cp0-expansion eqv? '(fx>=? 0 0) #t)
(test-cp0-expansion eqv? '(fx>=? -3 -3) #t)
(test-cp0-expansion eqv? '(fx>=? 12 12) #t)
(test-cp0-expansion eqv? '(fx>=? -3 -7 -7) #t)
(test-cp0-expansion eqv? '(fx>=? -3 -2 0) #f)
(test-cp0-expansion eqv? '(fx>=? 0 -2 -3) #t)
(test-cp0-expansion eqv? '(fx>=? -3 -3 0) #f)
(test-cp0-expansion eqv? '(fx>=? 0 -3 0) #f)
(test-cp0-expansion eqv? '(fx>=? 0 0 0) #t)
(test-cp0-expansion eqv? '(fx>=? -3 -3 -3) #t)
(test-cp0-expansion eqv? '(fx>=? 12 12 12) #t)
)
(mat $fxu<
(#%$fxu< 3 7)
(#%$fxu< 3 -7)
(not (#%$fxu< -3 -7))
(not (#%$fxu< -3 7))
(not (#%$fxu< -3 -3))
(not (#%$fxu< 3 3))
(not (#%$fxu< 0 0))
(not (#%$fxu< -3 0))
(#%$fxu< 0 -3)
(not (#%$fxu< 3 0))
(#%$fxu< 0 3)
(error? (#%$fxu< 'a))
(error? (#%$fxu< (+ (most-positive-fixnum) 1) 3 2))
(error? (#%$fxu< (- (most-negative-fixnum) 1) 3))
(guard (c [#t #t]) (#%$fxu< 4 3 (error #f "oops")))
(guard (c [#t #t]) (#%$fxu< 4 (error #f "oops") 3))
(guard (c [#t #t]) (#%$fxu< (error #f "oops") 4 3))
(guard (c [#t #t]) (not (#%$fxu< (error #f "oops"))))
(test-cp0-expansion eqv? '(#%$fxu< -3 -7) #f)
(test-cp0-expansion eqv? '(#%$fxu< -3 0) #f)
(test-cp0-expansion eqv? '(#%$fxu< 0 -3) #t)
)
(mat fx+
(eqv? (fx+ 3 0) 3)
(eqv? (fx+ 3 1) 4)
(eqv? (fx+ 3 4) 7)
(eqv? (fx+ -3 4) 1)
(eqv? (fx+ 3 -4) -1)
(eqv? (fx+ 3 -3) 0)
(eqv? (fx+ 3 3) 6)
(eqv? (fx+) 0)
(eqv? (fx+ 3) 3)
(eqv? (fx+ 3 4 5) 12)
(error? (fx+ '(a . b)))
(error? (fx+ (most-positive-fixnum) 1))
(error? (fx+ (+ (most-positive-fixnum) 1) 3 2))
(error? (fx+ (- (most-negative-fixnum) 1) 3))
; test for bug introduced temporarily into 4.1q
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx+ x 1))))) (g 2)) 3)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx+ 1 x))))) (g 2)) 3)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx+ x x))))) (g 2)) 4)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx+ (f x) 1))))) (g 2)) 3)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx+ 1 (f x)))))) (g 2)) 3)
; test for bug introduced into 4.1s or before & fixed in 4.1v
(eqv?
(let ([f (lambda (n)
(do ((i 0 (fx+ i 1)))
((fx= i n))
(fx+ i 1)))])
(f 1000))
(void))
(error? ; oops
(fx+ 'a 'b (error #f "oops")))
(error? ; oops
(fx+ 'a (error #f "oops") 'c))
(error? ; oops
(fx+ (error #f "oops") 'b 'c))
(error? ; #f is not a fixnum
(fx+ 3 #f))
(error? ; #f is not a fixnum
(fx+ #f 3))
(test-cp0-expansion eqv? '(fx+ 3 0) 3)
(test-cp0-expansion eqv? '(fx+ 3 1) 4)
(test-cp0-expansion eqv? '(fx+ 3 4) 7)
(test-cp0-expansion eqv? '(fx+ -3 4) 1)
(test-cp0-expansion eqv? '(fx+ 3 -4) -1)
(test-cp0-expansion eqv? '(fx+ 3 -3) 0)
(test-cp0-expansion eqv? '(fx+ 3 3) 6)
(test-cp0-expansion eqv? '(fx+) 0)
(test-cp0-expansion eqv? '(fx+ 3) 3)
(test-cp0-expansion eqv? '(fx+ 3 4 5) 12)
)
(mat r6rs:fx+
(eqv? (r6rs:fx+ 3 0) 3)
(eqv? (r6rs:fx+ 3 1) 4)
(eqv? (r6rs:fx+ 3 4) 7)
(eqv? (r6rs:fx+ -3 4) 1)
(eqv? (r6rs:fx+ 3 -4) -1)
(eqv? (r6rs:fx+ 3 -3) 0)
(eqv? (r6rs:fx+ 3 3) 6)
(error? (r6rs:fx+ '(a . b) 3))
(error? (r6rs:fx+ (greatest-fixnum) 1))
(error? (r6rs:fx+ (+ (greatest-fixnum) 1) 3))
(error? (r6rs:fx+ (- (least-fixnum) 1) 3))
; test for bug introduced temporarily into 4.1q
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx+ x 1))))) (g 2)) 3)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx+ 1 x))))) (g 2)) 3)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx+ x x))))) (g 2)) 4)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx+ (f x) 1))))) (g 2)) 3)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx+ 1 (f x)))))) (g 2)) 3)
; test for bug introduced into 4.1s or before & fixed in 4.1v
(eqv?
(let ([f (lambda (n)
(do ((i 0 (r6rs:fx+ i 1)))
((fx= i n))
(r6rs:fx+ i 1)))])
(f 1000))
(void))
(error? ; #f is not a fixnum
(fx+ 3 #f))
(error? ; #f is not a fixnum
(fx+ #f 3))
(test-cp0-expansion eqv? '(r6rs:fx+ 3 0) 3)
(test-cp0-expansion eqv? '(r6rs:fx+ 3 1) 4)
(test-cp0-expansion eqv? '(r6rs:fx+ 3 4) 7)
(test-cp0-expansion eqv? '(r6rs:fx+ -3 4) 1)
(test-cp0-expansion eqv? '(r6rs:fx+ 3 -4) -1)
(test-cp0-expansion eqv? '(r6rs:fx+ 3 -3) 0)
(test-cp0-expansion eqv? '(r6rs:fx+ 3 3) 6)
)
(mat fx-
(eqv? (fx- 3 0) 3)
(eqv? (fx- 3 1) 2)
(eqv? (fx- 3 4) -1)
(eqv? (fx- -3 4) -7)
(eqv? (fx- 3 -4) 7)
(eqv? (fx- 3 -3) 6)
(eqv? (fx- 3 3) 0)
(eqv? (fx- 3) -3)
(eqv? (fx- 3 4 5) -6)
(error? (fx- '(a . b)))
(error? (fx- (most-negative-fixnum) 1))
(error? (fx- (+ (most-positive-fixnum) 1) 3 2))
(error? (fx- (- (most-negative-fixnum) 1) 3))
; test for bug introduced temporarily into 4.1q
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx- x 1))))) (g 2)) 1)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx- 1 x))))) (g 2)) -1)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx- x x))))) (g 2)) 0)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx- (f x) 1))))) (g 2)) 1)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (fx- 1 (f x)))))) (g 2)) -1)
(error? ; #f is not a fixnum
(fx- 3 #f))
(error? ; #f is not a fixnum
(fx- #f 3))
(test-cp0-expansion eqv? '(fx- 3 0) 3)
(test-cp0-expansion eqv? '(fx- 3 1) 2)
(test-cp0-expansion eqv? '(fx- 3 4) -1)
(test-cp0-expansion eqv? '(fx- -3 4) -7)
(test-cp0-expansion eqv? '(fx- 3 -4) 7)
(test-cp0-expansion eqv? '(fx- 3 -3) 6)
(test-cp0-expansion eqv? '(fx- 3 3) 0)
(test-cp0-expansion eqv? '(fx- 3) -3)
(test-cp0-expansion eqv? '(fx- 3 4 5) -6)
)
(mat r6rs:fx-
(eqv? (r6rs:fx- 3 0) 3)
(eqv? (r6rs:fx- 3 1) 2)
(eqv? (r6rs:fx- 3 4) -1)
(eqv? (r6rs:fx- -3 4) -7)
(eqv? (r6rs:fx- 3 -4) 7)
(eqv? (r6rs:fx- 3 -3) 6)
(eqv? (r6rs:fx- 3 3) 0)
(eqv? (r6rs:fx- 3) -3)
(error? (r6rs:fx- '(a . b)))
(error? (r6rs:fx- (least-fixnum) 1))
(error? (r6rs:fx- (+ (greatest-fixnum) 1) 3))
(error? (r6rs:fx- (- (least-fixnum) 1) 3))
; test for bug introduced temporarily into 4.1q
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx- x 1))))) (g 2)) 1)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx- 1 x))))) (g 2)) -1)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx- x x))))) (g 2)) 0)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx- (f x) 1))))) (g 2)) 1)
(eqv? (let* ((f (lambda (x) x)) (g (lambda (x) (f (r6rs:fx- 1 (f x)))))) (g 2)) -1)
(error? ; #f is not a fixnum
(fx- 3 #f))
(error? ; #f is not a fixnum
(fx- #f 3))
(test-cp0-expansion eqv? '(r6rs:fx- 3 0) 3)
(test-cp0-expansion eqv? '(r6rs:fx- 3 1) 2)
(test-cp0-expansion eqv? '(r6rs:fx- 3 4) -1)
(test-cp0-expansion eqv? '(r6rs:fx- -3 4) -7)
(test-cp0-expansion eqv? '(r6rs:fx- 3 -4) 7)
(test-cp0-expansion eqv? '(r6rs:fx- 3 -3) 6)
(test-cp0-expansion eqv? '(r6rs:fx- 3 3) 0)
(test-cp0-expansion eqv? '(r6rs:fx- 3) -3)
)
(mat fx*
(eqv? (fx* 3 0) 0)
(eqv? (fx* 3 1) 3)
(eqv? (fx* 3 4) 12)
(eqv? (fx* -3 4) -12)
(eqv? (fx* 3 -4) -12)
(eqv? (fx* 3 -3) -9)
(eqv? (fx* 3 3) 9)
(eqv? (fx*) 1)
(eqv? (fx* 3) 3)
(eqv? (fx* 3 4 5) 60)
(error? (fx* '(a . b)))
(error? (fx* (most-positive-fixnum) 2))
(error? (fx* (+ (most-positive-fixnum) 1) 3 2))
(error? (fx* (- (most-negative-fixnum) 1) 3))
(error? ; #f is not a fixnum
(fx* 3 #f))
(error? ; #f is not a fixnum
(fx* #f 3))
(test-cp0-expansion eqv? '(fx* 3 0) 0)
(test-cp0-expansion eqv? '(fx* 3 1) 3)
(test-cp0-expansion eqv? '(fx* 3 4) 12)
(test-cp0-expansion eqv? '(fx* -3 4) -12)
(test-cp0-expansion eqv? '(fx* 3 -4) -12)
(test-cp0-expansion eqv? '(fx* 3 -3) -9)
(test-cp0-expansion eqv? '(fx* 3 3) 9)
(test-cp0-expansion eqv? '(fx*) 1)
(test-cp0-expansion eqv? '(fx* 3) 3)
(test-cp0-expansion eqv? '(fx* 3 4 5) 60)
)
(mat r6rs:fx*
(eqv? (r6rs:fx* 3 0) 0)
(eqv? (r6rs:fx* 3 1) 3)
(eqv? (r6rs:fx* 3 4) 12)
(eqv? (r6rs:fx* -3 4) -12)
(eqv? (r6rs:fx* 3 -4) -12)
(eqv? (r6rs:fx* 3 -3) -9)
(eqv? (r6rs:fx* 3 3) 9)
(error? (r6rs:fx* 3 '(a . b)))
(error? (r6rs:fx* (greatest-fixnum) 2))
(error? (r6rs:fx* (+ (greatest-fixnum) 1) 3))
(error? (r6rs:fx* (- (least-fixnum) 1) 3))
(error? ; #f is not a fixnum
(fx* 3 #f))
(error? ; #f is not a fixnum
(fx* #f 3))
(test-cp0-expansion eqv? '(r6rs:fx* 3 0) 0)
(test-cp0-expansion eqv? '(r6rs:fx* 3 1) 3)
(test-cp0-expansion eqv? '(r6rs:fx* 3 4) 12)
(test-cp0-expansion eqv? '(r6rs:fx* -3 4) -12)
(test-cp0-expansion eqv? '(r6rs:fx* 3 -4) -12)
(test-cp0-expansion eqv? '(r6rs:fx* 3 -3) -9)
(test-cp0-expansion eqv? '(r6rs:fx* 3 3) 9)
)
(mat fxquotient
(eqv? (fxquotient 3 1) 3)
(eqv? (fxquotient 3 4) 0)
(eqv? (fxquotient -4 3) -1)
(eqv? (fxquotient 4 -3) -1)
(eqv? (fxquotient 3 -3) -1)
(eqv? (fxquotient 3 3) 1)
(eqv? (fxquotient 13 3) 4)
(eqv? (fxquotient -13 3) -4)
(eqv? (fxquotient 13 -3) -4)
(eqv? (fxquotient -13 -3) 4)
(eqv? (fxquotient 3) 0)
(eqv? (fxquotient -3) 0)
(eqv? (fxquotient 1) 1)
(eqv? (fxquotient -1) -1)
(eqv? (fxquotient 19 3 2) 3)
(error? (fxquotient '(a . b)))
(error? (fxquotient 0))
(error? (fxquotient (+ (most-positive-fixnum) 1) 3 2))
(error? (fxquotient (- (most-negative-fixnum) 1) 3))
(error? (fxquotient (most-negative-fixnum) -1))
(equal?
(map (lambda (x) (fxquotient x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 0 0 0 0 0 1 1 1 2 2))
(equal?
(map (lambda (x) (fxquotient x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 0 0 0 0 0 -1 -1 -1 -2 -2))
(test-cp0-expansion eqv? '(fxquotient 3 1) 3)
(test-cp0-expansion eqv? '(fxquotient 3 4) 0)
(test-cp0-expansion eqv? '(fxquotient -4 3) -1)
(test-cp0-expansion eqv? '(fxquotient 4 -3) -1)
(test-cp0-expansion eqv? '(fxquotient 3 -3) -1)
(test-cp0-expansion eqv? '(fxquotient 3 3) 1)
(test-cp0-expansion eqv? '(fxquotient 13 3) 4)
(test-cp0-expansion eqv? '(fxquotient -13 3) -4)
(test-cp0-expansion eqv? '(fxquotient 13 -3) -4)
(test-cp0-expansion eqv? '(fxquotient -13 -3) 4)
(test-cp0-expansion eqv? '(fxquotient 3) 0)
(test-cp0-expansion eqv? '(fxquotient -3) 0)
(test-cp0-expansion eqv? '(fxquotient 1) 1)
(test-cp0-expansion eqv? '(fxquotient -1) -1)
(test-cp0-expansion eqv? '(fxquotient 19 3 2) 3)
)
(mat fx/
(eqv? (fx/ 3 1) 3)
(eqv? (fx/ 3 4) 0)
(eqv? (fx/ -4 3) -1)
(eqv? (fx/ 4 -3) -1)
(eqv? (fx/ 3 -3) -1)
(eqv? (fx/ 3 3) 1)
(eqv? (fx/ 13 3) 4)
(eqv? (fx/ -13 3) -4)
(eqv? (fx/ 13 -3) -4)
(eqv? (fx/ -13 -3) 4)
(eqv? (fx/ -13 4) -3)
(eqv? (fx/ 3) 0)
(eqv? (fx/ -3) 0)
(eqv? (fx/ 1) 1)
(eqv? (fx/ -1) -1)
(eqv? (fx/ 19 3 2) 3)
(error? (fx/ '(a . b)))
(error? (fx/ 0))
(error? (fx/ (+ (most-positive-fixnum) 1) 3 2))
(error? (fx/ (- (most-negative-fixnum) 1) 3))
(error? (fx/ (most-negative-fixnum) -1))
(equal?
(map (lambda (x) (fx/ x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 0 0 0 0 0 1 1 1 2 2))
(equal?
(map (lambda (x) (fx/ x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 0 0 0 0 0 -1 -1 -1 -2 -2))
(test-cp0-expansion eqv? '(fx/ 3 1) 3)
(test-cp0-expansion eqv? '(fx/ 3 4) 0)
(test-cp0-expansion eqv? '(fx/ -4 3) -1)
(test-cp0-expansion eqv? '(fx/ 4 -3) -1)
(test-cp0-expansion eqv? '(fx/ 3 -3) -1)
(test-cp0-expansion eqv? '(fx/ 3 3) 1)
(test-cp0-expansion eqv? '(fx/ 13 3) 4)
(test-cp0-expansion eqv? '(fx/ -13 3) -4)
(test-cp0-expansion eqv? '(fx/ 13 -3) -4)
(test-cp0-expansion eqv? '(fx/ -13 -3) 4)
(test-cp0-expansion eqv? '(fx/ -13 4) -3)
(test-cp0-expansion eqv? '(fx/ 3) 0)
(test-cp0-expansion eqv? '(fx/ -3) 0)
(test-cp0-expansion eqv? '(fx/ 1) 1)
(test-cp0-expansion eqv? '(fx/ -1) -1)
(test-cp0-expansion eqv? '(fx/ 19 3 2) 3)
)
(mat fxzero?
(fxzero? 0)
(not (fxzero? 1))
(not (fxzero? -1))
(not (fxzero? (most-positive-fixnum)))
(not (fxzero? (most-negative-fixnum)))
(error? (fxzero? 'a))
(error? (fxzero? (+ (most-positive-fixnum) 1)))
(error? (fxzero? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(fxzero? 0) #t)
(test-cp0-expansion eqv? '(not (fxzero? 1)) #t)
(test-cp0-expansion eqv? '(not (fxzero? -1)) #t)
(test-cp0-expansion eqv? '(not (fxzero? (most-positive-fixnum))) #t)
(test-cp0-expansion eqv? '(not (fxzero? (most-negative-fixnum))) #t)
)
(mat fxpositive?
(not (fxpositive? 0))
(fxpositive? 1)
(not (fxpositive? -1))
(fxpositive? (most-positive-fixnum))
(not (fxpositive? (most-negative-fixnum)))
(error? (fxpositive? 'a))
(error? (fxpositive? (+ (most-positive-fixnum) 1)))
(error? (fxpositive? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(not (fxpositive? 0)) #t)
(test-cp0-expansion eqv? '(fxpositive? 1) #t)
(test-cp0-expansion eqv? '(not (fxpositive? -1)) #t)
(test-cp0-expansion eqv? '(fxpositive? (most-positive-fixnum)) #t)
(test-cp0-expansion eqv? '(not (fxpositive? (most-negative-fixnum))) #t)
)
(mat fxnonpositive?
(fxnonpositive? 0)
(not (fxnonpositive? 1))
(fxnonpositive? -1)
(not (fxnonpositive? (most-positive-fixnum)))
(fxnonpositive? (most-negative-fixnum))
(error? (fxnonpositive? 'a))
(error? (fxnonpositive? (+ (most-positive-fixnum) 1)))
(error? (fxnonpositive? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(fxnonpositive? 0) #t)
(test-cp0-expansion eqv? '(not (fxnonpositive? 1)) #t)
(test-cp0-expansion eqv? '(fxnonpositive? -1) #t)
(test-cp0-expansion eqv? '(not (fxnonpositive? (most-positive-fixnum))) #t)
(test-cp0-expansion eqv? '(fxnonpositive? (most-negative-fixnum)) #t)
)
(mat fxnegative?
(not (fxnegative? 0))
(not (fxnegative? 1))
(fxnegative? -1)
(not (fxnegative? (most-positive-fixnum)))
(fxnegative? (most-negative-fixnum))
(error? (fxnegative? 'a))
(error? (fxnegative? (+ (most-positive-fixnum) 1)))
(error? (fxnegative? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(not (fxnegative? 0)) #t)
(test-cp0-expansion eqv? '(not (fxnegative? 1)) #t)
(test-cp0-expansion eqv? '(fxnegative? -1) #t)
(test-cp0-expansion eqv? '(not (fxnegative? (most-positive-fixnum))) #t)
(test-cp0-expansion eqv? '(fxnegative? (most-negative-fixnum)) #t)
)
(mat fxnonnegative?
(fxnonnegative? 0)
(fxnonnegative? 1)
(not (fxnonnegative? -1))
(fxnonnegative? (most-positive-fixnum))
(not (fxnonnegative? (most-negative-fixnum)))
(error? (fxnonnegative? 'a))
(error? (fxnonnegative? (+ (most-positive-fixnum) 1)))
(error? (fxnonnegative? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(fxnonnegative? 0) #t)
(test-cp0-expansion eqv? '(fxnonnegative? 1) #t)
(test-cp0-expansion eqv? '(not (fxnonnegative? -1)) #t)
(test-cp0-expansion eqv? '(fxnonnegative? (most-positive-fixnum)) #t)
(test-cp0-expansion eqv? '(not (fxnonnegative? (most-negative-fixnum))) #t)
)
(mat fxodd?
(not (fxodd? 0))
(fxodd? 1)
(not (fxodd? 2))
(fxodd? -1)
(not (fxodd? -2))
(fxodd? (most-positive-fixnum))
(not (fxodd? (most-negative-fixnum)))
(error? (fxodd? 'a))
(error? (fxodd? (+ (most-positive-fixnum) 1)))
(error? (fxodd? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(not (fxodd? 0)) #t)
(test-cp0-expansion eqv? '(fxodd? 1) #t)
(test-cp0-expansion eqv? '(not (fxodd? 2)) #t)
(test-cp0-expansion eqv? '(fxodd? -1) #t)
(test-cp0-expansion eqv? '(not (fxodd? -2)) #t)
(test-cp0-expansion eqv? '(fxodd? (most-positive-fixnum)) #t)
(test-cp0-expansion eqv? '(not (fxodd? (most-negative-fixnum))) #t)
)
(mat fxeven?
(fxeven? 0)
(not (fxeven? 1))
(fxeven? 2)
(not (fxeven? -1))
(fxeven? -2)
(not (fxeven? (most-positive-fixnum)))
(fxeven? (most-negative-fixnum))
(error? (fxeven? 'a))
(error? (fxeven? (+ (most-positive-fixnum) 1)))
(error? (fxeven? (- (most-negative-fixnum) 1)))
(test-cp0-expansion eqv? '(fxeven? 0) #t)
(test-cp0-expansion eqv? '(not (fxeven? 1)) #t)
(test-cp0-expansion eqv? '(fxeven? 2) #t)
(test-cp0-expansion eqv? '(not (fxeven? -1)) #t)
(test-cp0-expansion eqv? '(fxeven? -2) #t)
(test-cp0-expansion eqv? '(not (fxeven? (most-positive-fixnum))) #t)
(test-cp0-expansion eqv? '(fxeven? (most-negative-fixnum)) #t)
)
(mat fxabs
(eqv? (fxabs 0) 0)
(eqv? (fxabs -1) 1)
(eqv? (fxabs 1) 1)
(eqv? (fxabs (most-positive-fixnum)) (most-positive-fixnum))
(eqv? (fxabs (+ (most-negative-fixnum) 1)) (most-positive-fixnum))
(error? (fxabs (most-negative-fixnum)))
(error? (fxabs (+ (most-positive-fixnum) 1)))
(error? (fxabs (- (most-negative-fixnum) 1)))
(error? (fxabs "hi there"))
(error? (fxabs 1.2))
(error? (fxabs -1.2))
(test-cp0-expansion eqv? '(fxabs 0) 0)
(test-cp0-expansion eqv? '(fxabs 2) 2)
(test-cp0-expansion eqv? '(fxabs -2) 2)
)
(mat fx1-
(eqv? (fx1- 0) -1)
(eqv? (fx1- 1) 0)
(eqv? (fx1- -1) -2)
(test-cp0-expansion eqv? '(fx1- 0) -1)
(test-cp0-expansion eqv? '(fx1- 1) 0)
(test-cp0-expansion eqv? '(fx1- -1) -2)
(error? (fx1- (most-negative-fixnum)))
(error? (fx1- (- (most-negative-fixnum) 1)))
(error? (fx1- (+ (most-positive-fixnum) 1)))
(error? (fx1- 'a))
)
(mat fx1+
(eqv? (fx1+ 0) 1)
(eqv? (fx1+ 1) 2)
(eqv? (fx1+ -1) 0)
(test-cp0-expansion eqv? '(fx1+ 0) 1)
(test-cp0-expansion eqv? '(fx1+ 1) 2)
(test-cp0-expansion eqv? '(fx1+ -1) 0)
(error? (fx1+ (most-positive-fixnum)))
(error? (fx1+ (- (most-negative-fixnum) 1)))
(error? (fx1+ (+ (most-positive-fixnum) 1)))
(error? (fx1+ 'a))
; test for bug introduced into 4.1s or before & fixed in 4.1v
(eqv?
(let ([f (lambda (n)
(do ((i 0 (fx+ i 1)))
((fx= i n))
(fx1+ i)))])
(f 1000))
(void))
)
(mat fxmin
(error? (fxmin))
(eqv? (fxmin -1) -1)
(eqv? (fxmin -1 0) -1)
(eqv? (fxmin 0 -1) -1)
(eqv? (fxmin -1 1) -1)
(eqv? (fxmin 1 -1) -1)
(eqv? (fxmin 1 0 -1) -1)
(eqv? (fxmin 1 (most-negative-fixnum) 0 -1) (most-negative-fixnum))
(eqv? (fxmin 1 (most-positive-fixnum) 0 -1) -1)
(error? (fxmin 'a 0 1))
(error? (fxmin (+ (most-positive-fixnum) 1)))
(error? (fxmin (- (most-negative-fixnum) 1) 0))
(error? (fxmin 'a))
(error? (fxmin 0 1 -2 1 'a))
(test-cp0-expansion eqv? '(fxmin 0 1 2) 0)
(test-cp0-expansion eqv? '(fxmin 2 1 0) 0)
(test-cp0-expansion eqv? '(fxmin 0 2 1) 0)
)
(mat fxmax
(error? (fxmax))
(eqv? (fxmax -1) -1)
(eqv? (fxmax -1 0) 0)
(eqv? (fxmax 0 -1) 0)
(eqv? (fxmax -1 1) 1)
(eqv? (fxmax 1 -1) 1)
(eqv? (fxmax 1 0 -1) 1)
(eqv? (fxmax 1 (most-negative-fixnum) 0 -1) 1)
(eqv? (fxmax 1 (most-positive-fixnum) 0 -1) (most-positive-fixnum))
(error? (fxmax 'a 0 1))
(error? (fxmax (+ (most-positive-fixnum) 1)))
(error? (fxmax (- (most-negative-fixnum) 1) 0))
(error? (fxmax 'a))
(error? (fxmax 0 1 -2 1 'a))
(test-cp0-expansion eqv? '(fxmax 0 1 2) 2)
(test-cp0-expansion eqv? '(fxmax 2 1 0) 2)
(test-cp0-expansion eqv? '(fxmax 0 2 1) 2)
)
(mat fxmodulo
(eqv? (fxmodulo -7 2) 1)
(eqv? (fxmodulo 5 3) 2)
(eqv? (fxmodulo 5 -3) -1)
(eqv? (fxmodulo -5 -3) -2)
(error? (fxmodulo 'a 3))
(error? (fxmodulo (+ (most-positive-fixnum) 1) 3))
(error? (fxmodulo (- (most-negative-fixnum) 1) 3))
(error? (fxmodulo 7 0))
(equal?
(map (lambda (x) (fxmodulo x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 32 33 63 0 1 63 0 1))
(equal?
(map (lambda (x) (fxmodulo x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 59 33 32 31 1 0 63 1 0 63))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxmodulo ,x 64))))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 32 33 63 0 1 63 0 1))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxmodulo ,x 64))))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 59 33 32 31 1 0 63 1 0 63))
)
(mat fxremainder
(eqv? (fxremainder -7 2) -1)
(eqv? (fxremainder 5 3) 2)
(eqv? (fxremainder 5 -3) 2)
(eqv? (fxremainder -5 -3) -2)
(error? (fxremainder 'a 3))
(error? (fxremainder (+ (most-positive-fixnum) 1) 3))
(error? (fxremainder (- (most-negative-fixnum) 1) 3))
(error? (fxremainder 7 0))
(equal?
(map (lambda (x) (fxremainder x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 32 33 63 0 1 63 0 1))
(equal?
(map (lambda (x) (fxremainder x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 -5 -31 -32 -33 -63 0 -1 -63 0 -1))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxremainder ,x 64))))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 32 33 63 0 1 63 0 1))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxremainder ,x 64))))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 -5 -31 -32 -33 -63 0 -1 -63 0 -1))
)
(mat fxlogior ; same as fxlogor
(error? (fxlogior "hello"))
(error? (fxlogior (+ (most-positive-fixnum) 1)))
(error? (fxlogior (- (most-negative-fixnum) 1) 7))
(error? (fxlogior 7 8 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxlogior 0 0) 0)
(eqv? (fxlogior 1 0) 1)
(eqv? (fxlogior 1 1) 1)
(eqv? (fxlogior 0 1) 1)
(eqv? (fxlogior 2 1) 3)
(eqv? (fxlogior 5 2) 7)
(eqv? (fxlogior -1 2) -1)
(eqv? (fxlogior) 0)
(eqv? (fxlogior #x1212121)
#x1212121)
(eqv? (fxlogior #x1212121
#x2222222
#x0301030)
#x3333333)
(eqv? (fxlogior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(eqv? (fxlogior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
(test-cp0-expansion eqv? '(fxlogior 0 0) 0)
(test-cp0-expansion eqv? '(fxlogior 1 0) 1)
(test-cp0-expansion eqv? '(fxlogior 1 1) 1)
(test-cp0-expansion eqv? '(fxlogior 0 1) 1)
(test-cp0-expansion eqv? '(fxlogior 2 1) 3)
(test-cp0-expansion eqv? '(fxlogior 5 2) 7)
(test-cp0-expansion eqv? '(fxlogior -1 2) -1)
(test-cp0-expansion eqv? '(fxlogior) 0)
(test-cp0-expansion eqv?
'(fxlogior #x1212121)
#x1212121)
(test-cp0-expansion eqv?
'(fxlogior #x1212121
#x2222222
#x0301030)
#x3333333)
(test-cp0-expansion eqv?
'(fxlogior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(test-cp0-expansion eqv?
'(fxlogior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
)
(mat fxior ; same as fxlogor
(error? (fxior "hello"))
(error? (fxior (+ (most-positive-fixnum) 1)))
(error? (fxior (- (most-negative-fixnum) 1) 7))
(error? (fxior 7 8 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxior 0 0) 0)
(eqv? (fxior 1 0) 1)
(eqv? (fxior 1 1) 1)
(eqv? (fxior 0 1) 1)
(eqv? (fxior 2 1) 3)
(eqv? (fxior 5 2) 7)
(eqv? (fxior -1 2) -1)
(eqv? (fxior) 0)
(eqv? (fxior #x1212121)
#x1212121)
(eqv? (fxior #x1212121
#x2222222
#x0301030)
#x3333333)
(eqv? (fxior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(eqv? (fxior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
(test-cp0-expansion eqv? '(fxior 0 0) 0)
(test-cp0-expansion eqv? '(fxior 1 0) 1)
(test-cp0-expansion eqv? '(fxior 1 1) 1)
(test-cp0-expansion eqv? '(fxior 0 1) 1)
(test-cp0-expansion eqv? '(fxior 2 1) 3)
(test-cp0-expansion eqv? '(fxior 5 2) 7)
(test-cp0-expansion eqv? '(fxior -1 2) -1)
(test-cp0-expansion eqv? '(fxior) 0)
(test-cp0-expansion eqv?
'(fxior #x1212121)
#x1212121)
(test-cp0-expansion eqv?
'(fxior #x1212121
#x2222222
#x0301030)
#x3333333)
(test-cp0-expansion eqv?
'(fxior #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(test-cp0-expansion eqv?
'(fxior #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
)
(mat fxlogor
(error? (fxlogor "hello"))
(error? (fxlogor (+ (most-positive-fixnum) 1)))
(error? (fxlogor (- (most-negative-fixnum) 1) 7))
(error? (fxlogor 7 8 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxlogor 0 0) 0)
(eqv? (fxlogor 1 0) 1)
(eqv? (fxlogor 1 1) 1)
(eqv? (fxlogor 0 1) 1)
(eqv? (fxlogor 2 1) 3)
(eqv? (fxlogor 5 2) 7)
(eqv? (fxlogor -1 2) -1)
(eqv? (fxlogor) 0)
(eqv? (fxlogor #x1212121)
#x1212121)
(eqv? (fxlogor #x1212121
#x2222222
#x0301030)
#x3333333)
(eqv? (fxlogor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(eqv? (fxlogor #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
(test-cp0-expansion eqv? '(fxlogor 0 0) 0)
(test-cp0-expansion eqv? '(fxlogor 1 0) 1)
(test-cp0-expansion eqv? '(fxlogor 1 1) 1)
(test-cp0-expansion eqv? '(fxlogor 0 1) 1)
(test-cp0-expansion eqv? '(fxlogor 2 1) 3)
(test-cp0-expansion eqv? '(fxlogor 5 2) 7)
(test-cp0-expansion eqv? '(fxlogor -1 2) -1)
(test-cp0-expansion eqv? '(fxlogor) 0)
(test-cp0-expansion eqv?
'(fxlogor #x1212121)
#x1212121)
(test-cp0-expansion eqv?
'(fxlogor #x1212121
#x2222222
#x0301030)
#x3333333)
(test-cp0-expansion eqv?
'(fxlogor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-1)
(test-cp0-expansion eqv?
'(fxlogor #b1010111
#b1001011
0
#b1011110
#b1000111)
#b1011111)
)
(mat fxlogand
(error? (fxlogand "hello"))
(error? (fxlogand (+ (most-positive-fixnum) 1)))
(error? (fxlogand 7 (- (most-negative-fixnum) 1)))
(error? (fxlogand 7 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxlogand 0 0) 0)
(eqv? (fxlogand 1 0) 0)
(eqv? (fxlogand 0 1) 0)
(eqv? (fxlogand 1 1) 1)
(eqv? (fxlogand 2 1) 0)
(eqv? (fxlogand 3 1) 1)
(eqv? (fxlogand 12 6) 4)
(eqv? (fxlogand) -1)
(eqv? (fxlogand #x1212121)
#x1212121)
(eqv? (fxlogand #x1212121
#x2222222
#x0301030)
#x200020)
(eqv? (fxlogand #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(eqv? (fxlogand #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
(test-cp0-expansion eqv? '(fxlogand 0 0) 0)
(test-cp0-expansion eqv? '(fxlogand 1 0) 0)
(test-cp0-expansion eqv? '(fxlogand 0 1) 0)
(test-cp0-expansion eqv? '(fxlogand 1 1) 1)
(test-cp0-expansion eqv? '(fxlogand 2 1) 0)
(test-cp0-expansion eqv? '(fxlogand 3 1) 1)
(test-cp0-expansion eqv? '(fxlogand 12 6) 4)
(test-cp0-expansion eqv? '(fxlogand) -1)
(test-cp0-expansion eqv?
'(fxlogand #x1212121)
#x1212121)
(test-cp0-expansion eqv?
'(fxlogand #x1212121
#x2222222
#x0301030)
#x200020)
(test-cp0-expansion eqv?
'(fxlogand #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(test-cp0-expansion eqv?
'(fxlogand #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
)
(mat fxand
(error? (fxand "hello"))
(error? (fxand (+ (most-positive-fixnum) 1)))
(error? (fxand 7 (- (most-negative-fixnum) 1)))
(error? (fxand 7 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxand 0 0) 0)
(eqv? (fxand 1 0) 0)
(eqv? (fxand 0 1) 0)
(eqv? (fxand 1 1) 1)
(eqv? (fxand 2 1) 0)
(eqv? (fxand 3 1) 1)
(eqv? (fxand 12 6) 4)
(eqv? (fxand) -1)
(eqv? (fxand #x1212121)
#x1212121)
(eqv? (fxand #x1212121
#x2222222
#x0301030)
#x200020)
(eqv? (fxand #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(eqv? (fxand #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
(test-cp0-expansion eqv? '(fxand 0 0) 0)
(test-cp0-expansion eqv? '(fxand 1 0) 0)
(test-cp0-expansion eqv? '(fxand 0 1) 0)
(test-cp0-expansion eqv? '(fxand 1 1) 1)
(test-cp0-expansion eqv? '(fxand 2 1) 0)
(test-cp0-expansion eqv? '(fxand 3 1) 1)
(test-cp0-expansion eqv? '(fxand 12 6) 4)
(test-cp0-expansion eqv? '(fxand) -1)
(test-cp0-expansion eqv?
'(fxand #x1212121)
#x1212121)
(test-cp0-expansion eqv?
'(fxand #x1212121
#x2222222
#x0301030)
#x200020)
(test-cp0-expansion eqv?
'(fxand #b1110111
#b1101011
-1
#b1011110
#b1000111)
#b1000010)
(test-cp0-expansion eqv?
'(fxand #b1110111
#b1101011
0
#b1011110
#b1000111)
0)
)
(mat fxlogxor
(error? (fxlogxor "hello"))
(error? (fxlogxor (+ (most-positive-fixnum) 1)))
(error? (fxlogxor 7 (- (most-negative-fixnum) 1)))
(error? (fxlogxor 7 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxlogxor 0 0) 0)
(eqv? (fxlogxor 1 0) 1)
(eqv? (fxlogxor 1 1) 0)
(eqv? (fxlogxor 0 1) 1)
(eqv? (fxlogxor 2 1) 3)
(eqv? (fxlogxor 5 2) 7)
(eqv? (fxlogxor -1 2) -3)
(eqv? (fxlogxor) 0)
(eqv? (fxlogxor #x1212121)
#x1212121)
(eqv? (fxlogxor #x1212121
#x2222222
#x0301030)
#x3331333)
(eqv? (fxlogxor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(eqv? (fxlogxor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
(test-cp0-expansion eqv? '(fxlogxor 0 0) 0)
(test-cp0-expansion eqv? '(fxlogxor 1 0) 1)
(test-cp0-expansion eqv? '(fxlogxor 1 1) 0)
(test-cp0-expansion eqv? '(fxlogxor 0 1) 1)
(test-cp0-expansion eqv? '(fxlogxor 2 1) 3)
(test-cp0-expansion eqv? '(fxlogxor 5 2) 7)
(test-cp0-expansion eqv? '(fxlogxor -1 2) -3)
(test-cp0-expansion eqv? '(fxlogxor) 0)
(test-cp0-expansion eqv? '(fxlogxor #x1212121) #x1212121)
(test-cp0-expansion eqv?
'(fxlogxor #x1212121
#x2222222
#x0301030)
#x3331333)
(test-cp0-expansion eqv?
'(fxlogxor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(test-cp0-expansion eqv?
'(fxlogxor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
)
(mat fxxor
(error? (fxxor "hello"))
(error? (fxxor (+ (most-positive-fixnum) 1)))
(error? (fxxor 7 (- (most-negative-fixnum) 1)))
(error? (fxxor 7 (- (most-negative-fixnum) 1) 8 9))
(eqv? (fxxor 0 0) 0)
(eqv? (fxxor 1 0) 1)
(eqv? (fxxor 1 1) 0)
(eqv? (fxxor 0 1) 1)
(eqv? (fxxor 2 1) 3)
(eqv? (fxxor 5 2) 7)
(eqv? (fxxor -1 2) -3)
(eqv? (fxxor) 0)
(eqv? (fxxor #x1212121)
#x1212121)
(eqv? (fxxor #x1212121
#x2222222
#x0301030)
#x3331333)
(eqv? (fxxor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(eqv? (fxxor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
(test-cp0-expansion eqv? '(fxxor 0 0) 0)
(test-cp0-expansion eqv? '(fxxor 1 0) 1)
(test-cp0-expansion eqv? '(fxxor 1 1) 0)
(test-cp0-expansion eqv? '(fxxor 0 1) 1)
(test-cp0-expansion eqv? '(fxxor 2 1) 3)
(test-cp0-expansion eqv? '(fxxor 5 2) 7)
(test-cp0-expansion eqv? '(fxxor -1 2) -3)
(test-cp0-expansion eqv? '(fxxor) 0)
(test-cp0-expansion eqv? '(fxxor #x1212121) #x1212121)
(test-cp0-expansion eqv?
'(fxxor #x1212121
#x2222222
#x0301030)
#x3331333)
(test-cp0-expansion eqv?
'(fxxor #b1010111
#b1001011
-1
#b1011110
#b1000111)
-6)
(test-cp0-expansion eqv?
'(fxxor #b1010111
#b1001011
0
#b1011110
#b1000111)
5)
)
(mat fxlognot
(error? (fxlognot "hello"))
(error? (fxlognot (+ (most-positive-fixnum) 1)))
(error? (fxlognot (- (most-negative-fixnum) 1)))
(eqv? (fxlognot 0) -1)
(eqv? (fxlognot -1) 0)
(eqv? (fxlognot 2) -3)
(test-cp0-expansion eqv? '(fxlognot 0) -1)
(test-cp0-expansion eqv? '(fxlognot -1) 0)
(test-cp0-expansion eqv? '(fxlognot 2) -3)
)
(mat fxnot
(error? (fxnot "hello"))
(error? (fxnot (+ (most-positive-fixnum) 1)))
(error? (fxnot (- (most-negative-fixnum) 1)))
(eqv? (fxnot 0) -1)
(eqv? (fxnot -1) 0)
(eqv? (fxnot 2) -3)
(test-cp0-expansion eqv? '(fxnot 0) -1)
(test-cp0-expansion eqv? '(fxnot -1) 0)
(test-cp0-expansion eqv? '(fxnot 2) -3)
)
(mat fxsll
(error? (fxsll 1 -1))
(eqv? (fxsll 1 0) 1)
(eqv? (fxsll 1 1) 2)
(eqv? (fxsll 1 2) 4)
(eqv? (fxsll 1 3) 8)
(eqv? (fxsll 1 4) 16)
(eqv? (fxsll 1 (/ 8 2)) 16)
(eqv? (fxsll (fxsra (most-positive-fixnum) 1) 1) (- (most-positive-fixnum) 1))
(eqv? (fxsll (fxsra (most-negative-fixnum) 1) 1) (most-negative-fixnum))
(error? (fxsll 0 (+ (fixnum-width) 1)))
; check for overflow error when sign changes
(error? (fxsll 1 (- (fixnum-width) 1)))
(error? (fxsll #x1001 (- (fixnum-width) 2)))
(error? (fxsll -1 (fixnum-width)))
(error? (fxsll (most-positive-fixnum) 1))
(error? (fxsll (most-positive-fixnum) 10))
(error? (fxsll #x-1001 (- (fixnum-width) 2)))
(error? (fxsll (most-negative-fixnum) 1))
(eqv? (fxsll 0 (fixnum-width)) 0)
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(define check ; use trace-define to debug
(lambda (i)
(let ([x (expt2 i)])
(and (eqv? (fxsll 1 i) x)
(eqv? (fxsll -1 i) (- x))))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (- (fixnum-width) 1)) a)))
(test-cp0-expansion eqv? '(fxsll 1 0) 1)
(test-cp0-expansion eqv? '(fxsll 1 1) 2)
(test-cp0-expansion eqv? '(fxsll 1 2) 4)
(test-cp0-expansion eqv? '(fxsll 1 3) 8)
(test-cp0-expansion eqv? '(fxsll 1 4) 16)
(test-cp0-expansion eqv? '(fxsll 1 (/ 8 2)) 16)
)
(mat fxarithmetic-shift-left
; bound on shift count is one less than for fxsll
(error? (fxarithmetic-shift-left 0 (fixnum-width)))
(error? (fxarithmetic-shift-left 0 'a))
(error? (fxarithmetic-shift-left 0 1e23))
(error? (fxarithmetic-shift-left 0 (+ (most-positive-fixnum) 1)))
(error? (fxarithmetic-shift-left 1 -1))
(eqv? (fxarithmetic-shift-left 1 0) 1)
(eqv? (fxarithmetic-shift-left 1 1) 2)
(eqv? (fxarithmetic-shift-left 1 2) 4)
(eqv? (fxarithmetic-shift-left 1 3) 8)
(eqv? (fxarithmetic-shift-left 1 4) 16)
(eqv? (fxarithmetic-shift-left 1 (/ 8 2)) 16)
(eqv? (fxarithmetic-shift-left (fxsra (most-positive-fixnum) 1) 1) (- (most-positive-fixnum) 1))
(eqv? (fxarithmetic-shift-left (fxsra (most-negative-fixnum) 1) 1) (most-negative-fixnum))
; check for overflow error when sign changes
(error? (fxarithmetic-shift-left 1 (- (fixnum-width) 1)))
(error? (fxarithmetic-shift-left #x1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift-left -1 (fixnum-width)))
(error? (fxarithmetic-shift-left (most-positive-fixnum) 1))
(error? (fxarithmetic-shift-left (most-positive-fixnum) 10))
(error? (fxarithmetic-shift-left #x-1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift-left (most-negative-fixnum) 1))
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(define check ; use trace-define to debug
(lambda (i)
(let ([x (expt2 i)])
(and (eqv? (fxarithmetic-shift-left 1 i) x)
(eqv? (fxarithmetic-shift-left -1 i) (- x))))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (- (fixnum-width) 1)) a)))
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 0) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 1) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 3) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 4) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 (/ 8 2)) 16)
)
(mat fxsrl
(error? (fxsrl 1 -1))
(error? (fxsrl 1 (+ (integer-length (most-positive-fixnum)) 2)))
(error? (fxsrl 1 'a))
(error? (fxsrl 'a 17))
(error? (fxsrl (+ (most-positive-fixnum) 1) 2))
(eqv? (fxsrl 16 5) 0)
(eqv? (fxsrl 16 4) 1)
(eqv? (fxsrl 16 3) 2)
(eqv? (fxsrl 16 2) 4)
(eqv? (fxsrl 16 1) 8)
(eqv? (fxsrl 16 0) 16)
(eqv? (fxsrl -1 1) (most-positive-fixnum))
(eqv? (fxsrl 16 (/ 8 2)) 1)
(test-cp0-expansion eqv? '(fxsrl 16 5) 0)
(test-cp0-expansion eqv? '(fxsrl 16 4) 1)
(test-cp0-expansion eqv? '(fxsrl 16 3) 2)
(test-cp0-expansion eqv? '(fxsrl 16 2) 4)
(test-cp0-expansion eqv? '(fxsrl 16 1) 8)
(test-cp0-expansion eqv? '(fxsrl 16 0) 16)
(test-cp0-expansion eqv? '(fxsrl -1 1) (most-positive-fixnum))
(test-cp0-expansion eqv? '(fxsrl 16 (/ 8 2)) 1)
)
(mat fxsra
(error? (fxsra 1 -1))
(error? (fxsra 1 (+ (integer-length (most-positive-fixnum)) 2)))
(error? (fxsra 1 'a))
(error? (fxsra 'a 17))
(error? (fxsra (+ (most-positive-fixnum) 1) 2))
(error? (fxsra 0 (+ (fixnum-width) 1)))
(eqv? (fxsra 0 (fixnum-width)) 0)
(eqv? (fxsra 16 5) 0)
(eqv? (fxsra 16 4) 1)
(eqv? (fxsra 16 3) 2)
(eqv? (fxsra 16 2) 4)
(eqv? (fxsra 16 1) 8)
(eqv? (fxsra 16 0) 16)
(eqv? (fxsra -1 1) -1)
(eqv? (fxsra 16 (/ 8 2)) 1)
(test-cp0-expansion eqv? '(fxsra 0 (fixnum-width)) 0)
(test-cp0-expansion eqv? '(fxsra 16 5) 0)
(test-cp0-expansion eqv? '(fxsra 16 4) 1)
(test-cp0-expansion eqv? '(fxsra 16 3) 2)
(test-cp0-expansion eqv? '(fxsra 16 2) 4)
(test-cp0-expansion eqv? '(fxsra 16 1) 8)
(test-cp0-expansion eqv? '(fxsra 16 0) 16)
(test-cp0-expansion eqv? '(fxsra -1 1) -1)
(test-cp0-expansion eqv? '(fxsra 16 (/ 8 2)) 1)
)
(mat fxarithmetic-shift-right
; bound on shift count is one less than for fxsll
(error? (fxarithmetic-shift-right 1 -1))
(error? (fxarithmetic-shift-right 1 (+ (integer-length (most-positive-fixnum)) 2)))
(error? (fxarithmetic-shift-right 1 'a))
(error? (fxarithmetic-shift-right 'a 17))
(error? (fxarithmetic-shift-right (+ (most-positive-fixnum) 1) 2))
(error? (fxarithmetic-shift-right 0 (fixnum-width)))
(eqv? (fxarithmetic-shift-right 16 5) 0)
(eqv? (fxarithmetic-shift-right 16 4) 1)
(eqv? (fxarithmetic-shift-right 16 3) 2)
(eqv? (fxarithmetic-shift-right 16 2) 4)
(eqv? (fxarithmetic-shift-right 16 1) 8)
(eqv? (fxarithmetic-shift-right 16 0) 16)
(eqv? (fxarithmetic-shift-right -1 1) -1)
(eqv? (fxarithmetic-shift-right 16 (/ 8 2)) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 5) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 4) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 3) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 1) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 0) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right -1 1) -1)
(test-cp0-expansion eqv? '(fxarithmetic-shift-right 16 (/ 8 2)) 1)
)
(mat fxarithmetic-shift
(error? (fxarithmetic-shift 1 (fixnum-width)))
(error? (fxarithmetic-shift 1 (- (fixnum-width))))
(error? (fxarithmetic-shift 1 'a))
(error? (fxarithmetic-shift 'a 17))
(error? (fxarithmetic-shift (+ (most-positive-fixnum) 1) 2))
(eqv? (fxarithmetic-shift 0 (- (fixnum-width) 1)) 0)
(eqv? (fxarithmetic-shift 16 -5) 0)
(eqv? (fxarithmetic-shift 16 -4) 1)
(eqv? (fxarithmetic-shift 16 -3) 2)
(eqv? (fxarithmetic-shift 16 -2) 4)
(eqv? (fxarithmetic-shift 16 -1) 8)
(eqv? (fxarithmetic-shift 16 -0) 16)
(eqv? (fxarithmetic-shift -1 -1) -1)
(eqv? (fxarithmetic-shift 16 (/ -8 2)) 1)
(eqv? (fxarithmetic-shift 1 0) 1)
(eqv? (fxarithmetic-shift 1 1) 2)
(eqv? (fxarithmetic-shift 1 2) 4)
(eqv? (fxarithmetic-shift 1 3) 8)
(eqv? (fxarithmetic-shift 1 4) 16)
(eqv? (fxarithmetic-shift 1 (/ 8 2)) 16)
(eqv? (fxarithmetic-shift (fxsra (most-positive-fixnum) 1) 1) (- (most-positive-fixnum) 1))
(eqv? (fxarithmetic-shift (fxsra (most-negative-fixnum) 1) 1) (most-negative-fixnum))
; check for overflow error when sign changes
(error? (fxarithmetic-shift 1 (- (fixnum-width) 1)))
(error? (fxarithmetic-shift #x1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift -1 (fixnum-width)))
(error? (fxarithmetic-shift (most-positive-fixnum) 1))
(error? (fxarithmetic-shift (most-positive-fixnum) 10))
(error? (fxarithmetic-shift #x-1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift (most-negative-fixnum) 1))
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(define check ; use trace-define to debug
(lambda (i)
(let ([x (expt2 i)])
(and (eqv? (fxarithmetic-shift 1 i) x)
(eqv? (fxarithmetic-shift -1 i) (- x))))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (- (fixnum-width) 1)) a)))
(test-cp0-expansion eqv? '(fxarithmetic-shift 0 (- (fixnum-width) 1)) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -5) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -4) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -3) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -1) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -0) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift -1 -1) -1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 (/ -8 2)) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 0) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 1) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 3) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 4) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 (/ 8 2)) 16)
)
(mat fxbit-field
(error? (fxbit-field))
(error? (fxbit-field 35))
(error? (fxbit-field 35 5))
(error? (fxbit-field 35 5 8 15))
(error? (fxbit-field 35.0 5 8))
(error? (fxbit-field 35 5.0 8))
(error? (fxbit-field 35 5 8.0))
(error? (fxbit-field 'a 5 8))
(error? (fxbit-field 35 '(a b) 8))
(error? (fxbit-field 35 5 "hello"))
(error? (fxbit-field 35 -5 8))
(error? (fxbit-field 35 5 -8))
(error? (fxbit-field 35 5 3))
(error? (fxbit-field 35 (* (greatest-fixnum) 2) (+ (* (greatest-fixnum) 2) 10)))
(error? (fxbit-field 35 10 (+ (* (greatest-fixnum) 2) 10)))
(error? (fxbit-field 35 (fixnum-width) (fixnum-width)))
(error? (fxbit-field 35 0 (fixnum-width)))
(eqv? (fxbit-field #b11100100111110101011 5 5) 0)
(eqv? (fxbit-field #b11100100111110101011 5 6) 1)
(eqv? (fxbit-field #b11100100111110101011 0 8) #b10101011)
(eqv? (fxbit-field #b11100100111110101011 5 15) #b1001111101)
(eqv? (fxbit-field #b11100100111110101011 5 23) #b111001001111101)
(eqv? (fxbit-field -1 5 23) #b111111111111111111)
(eqv? (fxbit-field -5 0 5) #b11011)
(eqv? (fxbit-field -5 1 5) #b1101)
(eqv? (fxbit-field -5 2 5) #b110)
(eqv? (fxbit-field -5 2 20) #b111111111111111110)
(do ([n 10000 (fx- n 1)])
((fx= n 0) #t)
(let ([x (random (greatest-fixnum))])
(let ([len (fxlength x)])
(let ([i (random len)] [j (random len)])
(let-values ([(i j) (if (fx< i j) (values i j) (values j i))])
(unless (= (fxior (fxarithmetic-shift-left (fxbit-field x i j) i)
(fxarithmetic-shift-left (fxbit-field x j len) j)
(fxbit-field x 0 i))
x)
(errorf #f "failed for ~s, ~s, ~s" x i j)))))))
(do ([n 10000 (fx- n 1)])
((fx= n 0) #t)
(let ([x (- (random (greatest-fixnum)))])
(let ([len (fxlength x)])
(let ([i (random len)] [j (random len)])
(let-values ([(i j) (if (fx< i j) (values i j) (values j i))])
(unless (= (fxior (fxarithmetic-shift-left -1 len)
(fxarithmetic-shift-left (fxbit-field x i j) i)
(fxarithmetic-shift-left (fxbit-field x j len) j)
(fxbit-field x 0 i))
x)
(errorf #f "failed for ~s, ~s, ~s" x i j)))))))
(eqv? (fxbit-field 3 15 23) 0)
(eqv? (fxbit-field -3 15 23) #b11111111)
(test-cp0-expansion eqv? '(fxbit-field #b11100100111110101011 5 5) 0)
(test-cp0-expansion eqv? '(fxbit-field #b11100100111110101011 5 6) 1)
(test-cp0-expansion eqv? '(fxbit-field #b11100100111110101011 0 8) #b10101011)
(test-cp0-expansion eqv? '(fxbit-field #b11100100111110101011 5 15) #b1001111101)
(test-cp0-expansion eqv? '(fxbit-field #b11100100111110101011 5 23) #b111001001111101)
(test-cp0-expansion eqv? '(fxbit-field -1 5 23) #b111111111111111111)
(test-cp0-expansion eqv? '(fxbit-field -5 0 5) #b11011)
(test-cp0-expansion eqv? '(fxbit-field -5 1 5) #b1101)
(test-cp0-expansion eqv? '(fxbit-field -5 2 5) #b110)
(test-cp0-expansion eqv? '(fxbit-field -5 2 20) #b111111111111111110)
(test-cp0-expansion eqv? '(fxbit-field 3 15 23) 0)
(test-cp0-expansion eqv? '(fxbit-field -3 15 23) #b11111111)
)
(mat fxlength
(error? (fxlength))
(error? (fxlength 1 1 1))
(error? (fxlength .1))
(= (fxlength 0) 0)
(= (fxlength 1) 1)
(= (fxlength 3) 2)
(= (fxlength 4) 3)
(= (fxlength 7) 3)
(= (fxlength -1) 0)
(= (fxlength -4) 2)
(= (fxlength -7) 3)
(= (fxlength -8) 3)
(= (fxlength (most-positive-fixnum)) (- (fixnum-width) 1))
(= (fxlength (most-negative-fixnum)) (- (fixnum-width) 1))
(test-cp0-expansion = '(fxlength 0) 0)
(test-cp0-expansion = '(fxlength 1) 1)
(test-cp0-expansion = '(fxlength 3) 2)
(test-cp0-expansion = '(fxlength 4) 3)
(test-cp0-expansion = '(fxlength 7) 3)
(test-cp0-expansion = '(fxlength -1) 0)
(test-cp0-expansion = '(fxlength -4) 2)
(test-cp0-expansion = '(fxlength -7) 3)
(test-cp0-expansion = '(fxlength -8) 3)
(test-cp0-expansion = '(fxlength (most-positive-fixnum)) (- (fixnum-width) 1))
(test-cp0-expansion = '(fxlength (most-negative-fixnum)) (- (fixnum-width) 1))
(let ()
(define r6rs-length
(lambda (x)
(do ([result 0 (fx+ result 1)]
[bits (if (fxnegative? x) (fxnot x) x)
(fxarithmetic-shift-right bits 1)])
((fxzero? bits) result))))
(let f ([n 10000])
(or (fx= n 0)
(let ([x (random (greatest-fixnum))])
(and (= (fxlength x) (r6rs-length x))
(= (fxlength (- x)) (r6rs-length (- x)))
(f (fx- n 1)))))))
)
(mat fxbit-count
(error? (fxbit-count))
(error? (fxbit-count 75 32))
(error? (fxbit-count 3.0))
(error? (fxbit-count 'a))
(error? (fxbit-count (+ (most-positive-fixnum) 1)))
(error? (fxbit-count (- (most-negative-fixnum) 1)))
(eqv? (fxbit-count 0) 0)
(eqv? (fxbit-count #xabcd) 10)
(eqv? (fxbit-count -1) -1)
(eqv? (fxbit-count -10) -3)
(equal?
(map fxbit-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 fxbit-count '(-1 -2 -3 -4 -5 -6 -7 -8 -9 -10))
'(-1 -2 -2 -3 -2 -3 -3 -4 -2 -3))
(test-cp0-expansion eqv? '(fxbit-count 0) 0)
(test-cp0-expansion eqv? '(fxbit-count #xabcd) 10)
(test-cp0-expansion eqv? '(fxbit-count -1) -1)
(test-cp0-expansion eqv? '(fxbit-count -10) -3)
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxbit-count ,x))))
'(0 1 2 3 4 5 6 7 8 9 10))
'(0 1 1 2 1 2 2 3 1 2 2))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxbit-count ,x))))
'(-1 -2 -3 -4 -5 -6 -7 -8 -9 -10))
'(-1 -2 -2 -3 -2 -3 -3 -4 -2 -3))
(let ([n (+ (greatest-fixnum) 1)])
(let f ([i 2] [j 1])
(or (= i n)
(and (eqv? (fxbit-count i) 1)
(eqv? (fxbit-count (+ i 1)) 2)
(eqv? (fxbit-count (- i 1)) j)
(f (bitwise-arithmetic-shift i 1) (+ j 1))))))
(let ([n (+ (greatest-fixnum) 1)])
(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 (= (fxbit-count r) (slow-bit-count r))
(= (fxbit-count (- r)) (slow-bit-count (- r)))
(f (fx- i 1)))))))
)
(mat fxfirst-bit-set
(error? (fxfirst-bit-set))
(error? (fxfirst-bit-set 75 32))
(error? (fxfirst-bit-set 3.0))
(error? (fxfirst-bit-set 'a))
(error? (fxfirst-bit-set (+ (most-positive-fixnum) 1)))
(error? (fxfirst-bit-set (- (most-negative-fixnum) 1)))
(eqv? (fxfirst-bit-set 0) -1)
(eqv? (fxfirst-bit-set 1) 0)
(eqv? (fxfirst-bit-set -1) 0)
(eqv? (fxfirst-bit-set -4) 2)
(eqv? (fxfirst-bit-set (least-fixnum)) (fx- (fixnum-width) 1))
(equal?
(map fxfirst-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 fxfirst-bit-set '(-1 -2 -3 -4 -5 -6 -7 -8 -9 -10))
'(0 1 0 2 0 1 0 3 0 1))
(test-cp0-expansion eqv? '(fxfirst-bit-set 0) -1)
(test-cp0-expansion eqv? '(fxfirst-bit-set 1) 0)
(test-cp0-expansion eqv? '(fxfirst-bit-set -1) 0)
(test-cp0-expansion eqv? '(fxfirst-bit-set -4) 2)
(test-cp0-expansion eqv? '(fxfirst-bit-set (least-fixnum)) (fx- (fixnum-width) 1))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxfirst-bit-set ,x))))
'(0 1 2 3 4 5 6 7 8 9 10))
'(-1 0 1 0 2 0 1 0 3 0 1))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxfirst-bit-set ,x))))
'(-1 -2 -3 -4 -5 -6 -7 -8 -9 -10))
'(0 1 0 2 0 1 0 3 0 1))
(let ([n (+ (greatest-fixnum) 1)])
(let f ([i 2] [j 1])
(or (= i n)
(and (eqv? (fxfirst-bit-set i) j)
(eqv? (fxfirst-bit-set (+ i 1)) 0)
(eqv? (fxfirst-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 (fxodd? x) 0 (+ (f (fxsrl x 1)) 1))))))
(let f ([i 10000])
(let ([r (random n)])
(unless (fx= i 0)
(unless (and (= (fxfirst-bit-set r) (slow-first-bit-set r))
(= (fxfirst-bit-set (- r)) (slow-first-bit-set (- r))))
(errorf #f "failed for ~s" r))
(f (fx- i 1)))))
#t)
)
(mat fxlogtest
(error? (fxlogtest))
(error? (fxlogtest 1))
(error? (fxlogtest 1 2 3))
(error? (fxlogtest 3.4 5))
(error? (fxlogtest 5 "3"))
(error? (fxlogtest (+ (most-positive-fixnum) 1) 0))
(error? (fxlogtest 0 (+ (most-positive-fixnum) 1)))
(error? (fxlogtest (- (most-negative-fixnum) 1) 0))
(error? (fxlogtest 0 (- (most-negative-fixnum) 1)))
(eqv? (fxlogtest 750 -1) #t)
(eqv? (fxlogtest -1 -6) #t)
(eqv? (fxlogtest 0 -1) #f)
(eqv? (fxlogtest -1 0) #f)
(eqv? (fxlogtest #b1000101001 #b0111010110) #f)
(eqv? (fxlogtest #b1000101001 #b0111110110) #t)
(eqv? (fxlogtest #b1010101001 #b0111010110) #t)
(eqv? (fxlogtest (most-positive-fixnum) 3) #t)
(eqv? (fxlogtest (most-negative-fixnum) 3) #f)
(eqv? (fxlogtest (most-negative-fixnum) (most-negative-fixnum)) #t)
(eqv? (fxlogtest (most-negative-fixnum) (most-positive-fixnum)) #f)
(test-cp0-expansion eqv? '(fxlogtest #b1000101001 #b0111010110) #f)
(test-cp0-expansion eqv? '(fxlogtest #b1000101001 #b0111110110) #t)
(test-cp0-expansion eqv? '(fxlogtest #b1010101001 #b0111010110) #t)
(test-cp0-expansion eqv? '(fxlogtest (most-positive-fixnum) 3) #t)
(test-cp0-expansion eqv? '(fxlogtest (most-negative-fixnum) 3) #f)
(test-cp0-expansion eqv? '(fxlogtest (most-negative-fixnum) (most-negative-fixnum)) #t)
(test-cp0-expansion eqv? '(fxlogtest (most-negative-fixnum) (most-positive-fixnum)) #f)
; make sure we've properly labeled fxlogtest an arith-pred in primvars.ss
(begin
(define ($fxlogtest-foo x y)
(if (fxlogtest x y)
'yes
'no))
(equal?
(list ($fxlogtest-foo 3 4) ($fxlogtest-foo 3 3))
'(no yes)))
)
(mat fxif
(error? (fxif))
(error? (fxif 0))
(error? (fxif 0 0))
(error? (fxif 0 0 0 0))
(error? (fxif 'a 0 0))
(error? (fxif 0 3.4 0))
(error? (fxif 0 0 '(a)))
(error? (fxif (+ (most-positive-fixnum) 1) 0 0))
(error? (fxif 0 (+ (most-positive-fixnum) 1) 0))
(error? (fxif 0 0 (+ (most-positive-fixnum) 1)))
(error? (fxif (- (most-negative-fixnum) 1) 0 0))
(error? (fxif 0 (- (most-negative-fixnum) 1) 0))
(error? (fxif 0 0 (- (most-negative-fixnum) 1)))
(eqv? (fxif 0 0 0) 0)
(eqv? (fxif 0 -1 0) 0)
(eqv? (fxif 0 0 -1) -1)
(eqv? (fxif #b10101010 0 -1) (fxnot #b10101010))
(eqv? (fxif #b10101010 -1 0) #b10101010)
(eqv? (fxif #b11001110001101
#b11111110000000
#b11001100110011)
#b11001110110010)
(test-cp0-expansion eqv? '(fxif 0 0 0) 0)
(test-cp0-expansion eqv? '(fxif 0 -1 0) 0)
(test-cp0-expansion eqv? '(fxif 0 0 -1) -1)
(test-cp0-expansion eqv? '(fxif #b10101010 0 -1) (fxnot #b10101010))
(test-cp0-expansion eqv? '(fxif #b10101010 -1 0) #b10101010)
(test-cp0-expansion eqv?
'(fxif #b11001110001101
#b11111110000000
#b11001100110011)
#b11001110110010)
(let ([n (+ (greatest-fixnum) 1)])
(define r6rs-fxif
(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)])
(unless (and (= (fxif x y z) (r6rs-fxif x y z))
(= (fxif (fxnot x) y z) (r6rs-fxif (fxnot x) y z))
(= (fxif (fxnot x) y (fxnot z)) (r6rs-fxif (fxnot x) y (fxnot z)))
(= (fxif x (fxnot y) z) (r6rs-fxif x (fxnot y) z))
(= (fxif (fxnot x) (fxnot y) (fxnot z)) (r6rs-fxif (fxnot x) (fxnot y) (fxnot z))))
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- i 1))))
#t)
)
(mat fxlogbit?
(error? (fxlogbit?))
(error? (fxlogbit? 1))
(error? (fxlogbit? 1 2 3))
(error? (fxlogbit? 3.4 5))
(error? (fxlogbit? 5 "3"))
(error? (fxlogbit? 0 (+ (most-positive-fixnum) 1)))
(error? (fxlogbit? 0 (- (most-negative-fixnum) 1)))
(error? (fxlogbit? -1 -1))
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (fxlogbit? i -1))])
((fx> i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (fxlogbit? i (most-positive-fixnum)))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (fxlogbit? (integer-length (most-positive-fixnum)) (most-positive-fixnum)) #f)
(eqv? (fxlogbit? 0 #b0111010110) #f)
(eqv? (fxlogbit? 4 #b0111010110) #t)
(eqv? (fxlogbit? 8 #b0111010110) #t)
(eqv? (fxlogbit? 9 #b0111010110) #f)
(eqv? (fxlogbit? (integer-length (most-positive-fixnum)) #b0111010110) #f)
(eqv? (fxlogbit? 0 -6) #f)
(eqv? (fxlogbit? 1 -6) #t)
(eqv? (fxlogbit? 2 -6) #f)
(eqv? (do ([i 3 (fx+ i 1)] [a #t (and a (fxlogbit? 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? (fxlogbit? (+ (integer-length (most-positive-fixnum)) 1) -1) #t)
(eqv? (fxlogbit? (expt (integer-length (most-positive-fixnum)) 2) (most-positive-fixnum)) #f)
(eqv? (fxlogbit? (expt (integer-length (most-positive-fixnum)) 2) -1) #t)
; make sure we've properly labeled fxlogbit? an arith-pred in primvars.ss
(begin
(define ($fxlogbit?-foo x y)
(if (fxlogbit? x y)
'yes
'no))
(equal?
(list ($fxlogbit?-foo 2 4) ($fxlogbit?-foo 3 3))
'(yes no)))
(test-cp0-expansion eqv? '(fxlogbit? (integer-length (most-positive-fixnum)) (most-positive-fixnum)) #f)
(test-cp0-expansion eqv? '(fxlogbit? 0 #b0111010110) #f)
(test-cp0-expansion eqv? '(fxlogbit? 4 #b0111010110) #t)
(test-cp0-expansion eqv? '(fxlogbit? 8 #b0111010110) #t)
(test-cp0-expansion eqv? '(fxlogbit? 9 #b0111010110) #f)
(test-cp0-expansion eqv? '(fxlogbit? (integer-length (most-positive-fixnum)) #b0111010110) #f)
(test-cp0-expansion eqv? '(fxlogbit? 0 -6) #f)
(test-cp0-expansion eqv? '(fxlogbit? 1 -6) #t)
(test-cp0-expansion eqv? '(fxlogbit? 2 -6) #f)
(test-cp0-expansion eqv? '(fxlogbit? (+ (integer-length (most-positive-fixnum)) 1) -1) #t)
(test-cp0-expansion eqv? '(fxlogbit? (expt (integer-length (most-positive-fixnum)) 2) (most-positive-fixnum)) #f)
(test-cp0-expansion eqv? '(fxlogbit? (expt (integer-length (most-positive-fixnum)) 2) -1) #t)
)
(mat fxbit-set?
(error? (fxbit-set?))
(error? (fxbit-set? 1))
(error? (fxbit-set? 1 2 3))
(error? (fxbit-set? 3.4 5))
(error? (fxbit-set? 5 "3"))
(error? (fxbit-set? (+ (most-positive-fixnum) 1) 0))
(error? (fxbit-set? (- (most-negative-fixnum) 1) 0))
(error? (fxbit-set? -1 -1))
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (fxbit-set? -1 i))])
((fx> i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (do ([i 0 (fx+ i 1)] [a #t (and a (fxbit-set? (most-positive-fixnum) i))])
((fx= i (integer-length (most-positive-fixnum))) a))
#t)
(eqv? (fxbit-set? (most-positive-fixnum) (integer-length (most-positive-fixnum))) #f)
(eqv? (fxbit-set? #b0111010110 0) #f)
(eqv? (fxbit-set? #b0111010110 4) #t)
(eqv? (fxbit-set? #b0111010110 8) #t)
(eqv? (fxbit-set? #b0111010110 9) #f)
(eqv? (fxbit-set? #b0111010110 (integer-length (most-positive-fixnum))) #f)
(eqv? (fxbit-set? -6 0) #f)
(eqv? (fxbit-set? -6 1) #t)
(eqv? (fxbit-set? -6 2) #f)
(eqv? (do ([i 3 (fx+ i 1)] [a #t (and a (fxbit-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? (fxbit-set? -1 (+ (integer-length (most-positive-fixnum)) 1)) #t)
(eqv? (fxbit-set? (most-positive-fixnum) (expt (integer-length (most-positive-fixnum)) 2)) #f)
(eqv? (fxbit-set? -1 (expt (integer-length (most-positive-fixnum)) 2)) #t)
; make sure we've properly labeled fxbit-set? an arith-pred in primvars.ss
(begin
(define ($fxbit-set?-foo x y)
(if (fxbit-set? x y)
'yes
'no))
(equal?
(list ($fxbit-set?-foo 4 2) ($fxbit-set?-foo 3 3))
'(yes no)))
;; cp0 handler tests
(test-cp0-expansion eqv? '(fxbit-set? (most-positive-fixnum) (integer-length (most-positive-fixnum))) #f)
(test-cp0-expansion eqv? '(fxbit-set? #b0111010110 0) #f)
(test-cp0-expansion eqv? '(fxbit-set? #b0111010110 4) #t)
(test-cp0-expansion eqv? '(fxbit-set? #b0111010110 8) #t)
(test-cp0-expansion eqv? '(fxbit-set? #b0111010110 9) #f)
(test-cp0-expansion eqv? '(fxbit-set? #b0111010110 (integer-length (most-positive-fixnum))) #f)
(test-cp0-expansion eqv? '(fxbit-set? -6 0) #f)
(test-cp0-expansion eqv? '(fxbit-set? -6 1) #t)
(test-cp0-expansion eqv? '(fxbit-set? -6 2) #f)
; check to see if we can look as far to the left as we please ...
(test-cp0-expansion eqv? '(fxbit-set? -1 (+ (integer-length (most-positive-fixnum)) 1)) #t)
(test-cp0-expansion eqv? '(fxbit-set? (most-positive-fixnum) (expt (integer-length (most-positive-fixnum)) 2)) #f)
(test-cp0-expansion eqv? '(fxbit-set? -1 (expt (integer-length (most-positive-fixnum)) 2)) #t)
; make sure we've properly labeled fxbit-set? an arith-pred in primvars.ss
(begin
(define ($fxbit-set?-foo x y)
(if (parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxbit-set? ,x ,y)))
'yes
'no))
(equal?
(list ($fxbit-set?-foo 4 2) ($fxbit-set?-foo 3 3))
'(yes no)))
)
(mat fxlogbit0
(error? (fxlogbit0))
(error? (fxlogbit0 1))
(error? (fxlogbit0 1 2 3))
(error? (fxlogbit0 3.4 5))
(error? (fxlogbit0 5 "3"))
(error? (fxlogbit0 0 (+ (most-positive-fixnum) 1)))
(error? (fxlogbit0 0 (- (most-negative-fixnum) 1)))
(error? (fxlogbit0 -1 -1))
(error? (fxlogbit0 (integer-length (most-positive-fixnum)) -1))
(eqv? (fxlogbit0 2 0) 0)
(eqv? (fxlogbit0 2 -1) -5)
(eqv? (fxlogbit0 3 #b10101010) #b10100010)
(eqv? (fxlogbit0 4 #b10101010) #b10101010)
(andmap values
(let ([p? (lambda (i) (fx= (fxlogbit0 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= (fxlogbit0 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)))))))))
(test-cp0-expansion eqv? '(fxlogbit0 2 0) 0)
(test-cp0-expansion eqv? '(fxlogbit0 2 -1) -5)
(test-cp0-expansion eqv? '(fxlogbit0 3 #b10101010) #b10100010)
(test-cp0-expansion eqv? '(fxlogbit0 4 #b10101010) #b10101010)
)
(mat fxlogbit1
(error? (fxlogbit1))
(error? (fxlogbit1 1))
(error? (fxlogbit1 1 2 3))
(error? (fxlogbit1 3.4 5))
(error? (fxlogbit1 5 "3"))
(error? (fxlogbit1 0 (+ (most-positive-fixnum) 1)))
(error? (fxlogbit1 0 (- (most-negative-fixnum) 1)))
(error? (fxlogbit1 -1 -1))
(error? (fxlogbit1 (integer-length (most-positive-fixnum)) 0))
(eqv? (fxlogbit1 2 0) 4)
(eqv? (fxlogbit1 2 -1) -1)
(eqv? (fxlogbit1 3 #b10101010) #b10101010)
(eqv? (fxlogbit1 4 #b10101010) #b10111010)
(andmap values
(let ([p? (lambda (i) (fx= (fxlogbit1 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= (fxlogbit1 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)))))))))
(test-cp0-expansion eqv? '(fxlogbit1 2 0) 4)
(test-cp0-expansion eqv? '(fxlogbit1 2 -1) -1)
(test-cp0-expansion eqv? '(fxlogbit1 3 #b10101010) #b10101010)
(test-cp0-expansion eqv? '(fxlogbit1 4 #b10101010) #b10111010)
)
(mat fxcopy-bit
(error? (fxcopy-bit))
(error? (fxcopy-bit 1))
(error? (fxcopy-bit 3 1))
(error? (fxcopy-bit 3 1 0 0))
(error? (fxcopy-bit 5 3.4 0))
(error? (fxcopy-bit "3" 5 0))
(error? (fxcopy-bit (+ (most-positive-fixnum) 1) 0 0))
(error? (fxcopy-bit (- (most-negative-fixnum) 1) 0 1))
(error? (fxcopy-bit -1 -1 0))
(error? (fxcopy-bit -1 -1 1))
(error? (fxcopy-bit -1 (fx- (fixnum-width) 1) 0))
(error? (fxcopy-bit -1 (fx- (fixnum-width) 1) 1))
(eqv? (fxcopy-bit 0 2 0) 0)
(eqv? (fxcopy-bit -1 2 0) -5)
(eqv? (fxcopy-bit #b10101010 3 0) #b10100010)
(eqv? (fxcopy-bit #b10101010 4 0) #b10101010)
(andmap values
(let ([p? (lambda (i) (fx= (fxcopy-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= (fxcopy-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? (fxcopy-bit 0 2 1) 4)
(eqv? (fxcopy-bit -1 2 1) -1)
(eqv? (fxcopy-bit #b10101010 3 1) #b10101010)
(eqv? (fxcopy-bit #b10101010 4 1) #b10111010)
(andmap values
(let ([p? (lambda (i) (fx= (fxcopy-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= (fxcopy-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)))))))))
;; cp0 handler tests
(test-cp0-expansion eqv? '(fxcopy-bit 0 2 1) 4)
(test-cp0-expansion eqv? '(fxcopy-bit -1 2 1) -1)
(test-cp0-expansion eqv? '(fxcopy-bit #b10101010 3 1) #b10101010)
(test-cp0-expansion eqv? '(fxcopy-bit #b10101010 4 1) #b10111010)
(andmap values
(let ([p? (lambda (i)
(fx=
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxcopy-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=
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxcopy-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)))))))))
)
(mat fxcopy-bit-field
(error? (fxcopy-bit-field))
(error? (fxcopy-bit-field 1))
(error? (fxcopy-bit-field 3 1))
(error? (fxcopy-bit-field 3 1 0))
(error? (fxcopy-bit-field 3 1 0 0 0))
(error? (fxcopy-bit-field "3" 0 0 0))
(error? (fxcopy-bit-field 0 3.4 0 0))
(error? (fxcopy-bit-field 0 0 3/4 0))
(error? (fxcopy-bit-field 0 0 0 'spam))
(error? (fxcopy-bit-field (+ (most-positive-fixnum) 1) 0 0 0))
(error? (fxcopy-bit-field (- (most-negative-fixnum) 1) 0 0 0))
(error? (fxcopy-bit-field 0 (+ (most-positive-fixnum) 1) 0 0))
(error? (fxcopy-bit-field 0 (- (most-negative-fixnum) 1) 0 0))
(error? (fxcopy-bit-field 0 0 (+ (most-positive-fixnum) 1) 0))
(error? (fxcopy-bit-field 0 0 (- (most-negative-fixnum) 1) 0))
(error? (fxcopy-bit-field 0 0 0 (+ (most-positive-fixnum) 1)))
(error? (fxcopy-bit-field 0 0 0 (+ (most-positive-fixnum) 1)))
(error? (fxcopy-bit-field 0 -1 0 0))
(error? (fxcopy-bit-field 0 0 -1 0))
(error? (fxcopy-bit-field 0 (fixnum-width) (fixnum-width) 0))
(error? (fxcopy-bit-field 0 0 (fixnum-width) 0))
(error? (fxcopy-bit-field 0 1 0 0))
(error? (fxcopy-bit-field 0 5 2 0))
(error? (fxcopy-bit-field 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2) 0))
(eqv? (fxcopy-bit-field 0 2 3 0) 0)
(eqv? (fxcopy-bit-field 0 2 3 -1) 4)
(eqv? (fxcopy-bit-field -1 2 3 0) -5)
(eqv? (fxcopy-bit-field -1 0 3 0) -8)
(eqv? (fxcopy-bit-field 0 0 3 -1) 7)
(eqv? (fxcopy-bit-field #b10101010 3 4 0) #b10100010)
(eqv? (fxcopy-bit-field #b10101010 4 5 0) #b10101010)
(eqv? (fxcopy-bit-field #b10101010 0 4 0) #b10100000)
(eqv? (fxcopy-bit-field #b10101010 0 4 #b0101) #b10100101)
(begin
(define $fxbf1
(let ([fb (fixnum-width)])
(lambda (x v)
(list
(fxcopy-bit-field x 0 (- fb 1) v)
(fxcopy-bit-field x 20 (- fb 1) v)))))
#t)
(equal?
($fxbf1 0 0)
'(0 0))
(equal?
($fxbf1 0 -1)
(list
(most-positive-fixnum)
(- (most-positive-fixnum) (- (expt 2 20) 1))))
(equal?
($fxbf1 -1 0)
(list
(most-negative-fixnum)
(+ (most-negative-fixnum) (- (expt 2 20) 1))))
(andmap values
(let ([p? (lambda (i) (fx= (fxcopy-bit-field -1 i (fx+ i 1) 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= (fxcopy-bit-field n i (fx+ i 1) 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? (fxcopy-bit-field 0 2 3 1) 4)
(eqv? (fxcopy-bit-field -1 2 3 1) -1)
(eqv? (fxcopy-bit-field #b10101010 3 4 1) #b10101010)
(eqv? (fxcopy-bit-field #b10101010 4 5 1) #b10111010)
(andmap values
(let ([p? (lambda (i) (fx= (fxcopy-bit-field 0 i (fx+ i 1) 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= (fxcopy-bit-field n i (fx+ i 1) 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)))))))))
(let ([p? (lambda (n i) (fx= (fxcopy-bit-field n i (fx+ i 3) #b110110101)
(fxior (fxsll #b101 i) (fxcopy-bit n (fx+ i 1) 0))))])
(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 (fx- (integer-length (most-positive-fixnum)) 3))
(g (fx- j 1))
(and (p? n i) (f (fx+ i 1)))))))))
(test-cp0-expansion eqv? '(fxcopy-bit-field 0 2 3 0) 0)
(test-cp0-expansion eqv? '(fxcopy-bit-field 0 2 3 -1) 4)
(test-cp0-expansion eqv? '(fxcopy-bit-field -1 2 3 0) -5)
(test-cp0-expansion eqv? '(fxcopy-bit-field -1 0 3 0) -8)
(test-cp0-expansion eqv? '(fxcopy-bit-field 0 0 3 -1) 7)
(test-cp0-expansion eqv? '(fxcopy-bit-field #b10101010 3 4 0) #b10100010)
(test-cp0-expansion eqv? '(fxcopy-bit-field #b10101010 4 5 0) #b10101010)
(test-cp0-expansion eqv? '(fxcopy-bit-field #b10101010 0 4 0) #b10100000)
(test-cp0-expansion eqv? '(fxcopy-bit-field #b10101010 0 4 #b0101) #b10100101)
(test-cp0-expansion eqv? '(fxcopy-bit-field 0 2 3 1) 4)
(test-cp0-expansion eqv? '(fxcopy-bit-field -1 2 3 1) -1)
(test-cp0-expansion eqv? '(fxcopy-bit-field #b10101010 3 4 1) #b10101010)
(test-cp0-expansion eqv? '(fxcopy-bit-field #b10101010 4 5 1) #b10111010)
)
(mat fxdiv-and-mod
; fxdiv-and-mod
(error? (fxdiv-and-mod 17 3.0))
(error? (fxdiv-and-mod 3.0 17))
(error? (fxdiv-and-mod 'a 17))
(error? (fxdiv-and-mod 17 '(a)))
(error? (fxdiv-and-mod 17 0))
(error? (fxdiv-and-mod -17 0))
(error? (fxdiv-and-mod (most-negative-fixnum) -1))
; fxdiv
(error? (fxdiv 17 3.0))
(error? (fxdiv 3.0 17))
(error? (fxdiv 'a 17))
(error? (fxdiv 17 '(a)))
(error? (fxdiv 17 0))
(error? (fxdiv -17 0))
(error? (fxdiv (most-negative-fixnum) -1))
; fxmod
(error? (fxmod 17 3.0))
(error? (fxmod 3.0 17))
(error? (fxmod 'a 17))
(error? (fxmod 17 '(a)))
(error? (fxmod 17 0))
(error? (fxmod -17 0))
; no overflow for fxmod:
(eqv? (fxmod (most-negative-fixnum) -1) 0)
; fxdiv-and-mod
(begin
(define $d&m fxdiv-and-mod)
(define ($dmpair x y)
(and (not (fx= y 0)) (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)
(equal?
($dmpairs 0 5)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
(equal?
($dmpairs 15 37)
'((0 . 15) (-1 . 22) (0 . 15) (1 . 22) (2 . 7) (-3 . 8) (-2 . 7) (3 . 8)))
(equal?
($dmpairs 24 8)
'((3 . 0) (-3 . 0) (-3 . 0) (3 . 0) (0 . 8) (-1 . 16) (0 . 8) (1 . 16)))
; fxdiv with fxmod
(begin
(set! $d&m (lambda (x y) (values (fxdiv x y) (fxmod x y))))
#t)
(equal?
($dmpairs 0 5)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
(equal?
($dmpairs 15 37)
'((0 . 15) (-1 . 22) (0 . 15) (1 . 22) (2 . 7) (-3 . 8) (-2 . 7) (3 . 8)))
(equal?
($dmpairs 24 8)
'((3 . 0) (-3 . 0) (-3 . 0) (3 . 0) (0 . 8) (-1 . 16) (0 . 8) (1 . 16)))
(equal?
(map (lambda (x) (fxdiv x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 0 0 0 0 0 1 1 1 2 2))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxdiv ,x 64))))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 0 0 0 0 0 1 1 1 2 2))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxmod ,x 64))))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 32 33 63 0 1 63 0 1))
(equal?
(map (lambda (x) (let-values ([ls (fxdiv-and-mod x 64)]) ls))
'(0 5 31 32 33 63 64 65 127 128 129))
'((0 0) (0 5) (0 31) (0 32) (0 33) (0 63) (1 0) (1 1) (1 63) (2 0) (2 1)))
(equal?
(map (lambda (x) (fxdiv x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 -1 -1 -1 -1 -1 -1 -2 -2 -2 -3))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxdiv ,x 64))))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 -1 -1 -1 -1 -1 -1 -2 -2 -2 -3))
(equal?
(map (lambda (x) (fxmod x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 59 33 32 31 1 0 63 1 0 63))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxmod ,x 64))))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 59 33 32 31 1 0 63 1 0 63))
(equal?
(map (lambda (x) (let-values ([ls (fxdiv-and-mod x 64)]) ls))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'((0 0) (-1 59) (-1 33) (-1 32) (-1 31) (-1 1) (-1 0) (-2 63) (-2 1) (-2 0) (-3 63)))
)
(mat fxdiv0-and-mod0
; fxdiv0-and-mod0
(error? (fxdiv0-and-mod0 17 3.0))
(error? (fxdiv0-and-mod0 3.0 17))
(error? (fxdiv0-and-mod0 'a 17))
(error? (fxdiv0-and-mod0 17 '(a)))
(error? (fxdiv0-and-mod0 17 0))
(error? (fxdiv0-and-mod0 -17 0))
(error? (fxdiv0-and-mod0 (most-negative-fixnum) -1))
; fxdiv0
(error? (fxdiv0 17 3.0))
(error? (fxdiv0 3.0 17))
(error? (fxdiv0 'a 17))
(error? (fxdiv0 17 '(a)))
(error? (fxdiv0 17 0))
(error? (fxdiv0 -17 0))
(error? (fxdiv0 (most-negative-fixnum) -1))
; fxmod0
(error? (fxmod0 17 3.0))
(error? (fxmod0 3.0 17))
(error? (fxmod0 'a 17))
(error? (fxmod0 17 '(a)))
(error? (fxmod0 17 0))
(error? (fxmod0 -17 0))
; no overflow for fxmod0:
(eqv? (fxmod0 (most-negative-fixnum) -1) 0)
; fxdiv0-and-mod0
(begin
(define $d&m fxdiv0-and-mod0)
(define ($dmpair x y)
(and (not (fx= y 0)) (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)
(equal?
($dmpairs 0 5)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
(equal?
($dmpairs 15 37)
'((0 . 15) (0 . -15) (0 . 15) (0 . -15)
(2 . 7) (-2 . -7) (-2 . 7) (2 . -7)))
; fxdiv0 with fxmod0
(begin
(set! $d&m (lambda (x y) (values (fxdiv0 x y) (fxmod0 x y))))
#t)
(equal?
($dmpairs 0 5)
'((0 . 0) (0 . 0) (0 . 0) (0 . 0) #f #f #f #f))
(equal?
($dmpairs 15 37)
'((0 . 15) (0 . -15) (0 . 15) (0 . -15)
(2 . 7) (-2 . -7) (-2 . 7) (2 . -7)))
(equal?
(map (lambda (x) (fxdiv0 x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 0 0 1 1 1 1 1 2 2 2))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxdiv0 ,x 64))))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 0 0 1 1 1 1 1 2 2 2))
(equal?
(map (lambda (x) (fxmod0 x 64))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 -32 -31 -1 0 1 -1 0 1))
(equal?
(map (lambda (x)
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize `(fxmod0 ,x 64))))
'(0 5 31 32 33 63 64 65 127 128 129))
'(0 5 31 -32 -31 -1 0 1 -1 0 1))
(equal?
(map (lambda (x) (let-values ([ls (fxdiv0-and-mod0 x 64)]) ls))
'(0 5 31 32 33 63 64 65 127 128 129))
'((0 0) (0 5) (0 31) (1 -32) (1 -31) (1 -1) (1 0) (1 1) (2 -1) (2 0) (2 1)))
(equal?
(map (lambda (x) (fxdiv0 x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 0 0 0 -1 -1 -1 -1 -2 -2 -2))
(equal?
(map (lambda (x) (fxmod0 x 64))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'(0 -5 -31 -32 31 1 0 -1 1 0 -1))
(equal?
(map (lambda (x) (let-values ([ls (fxdiv0-and-mod0 x 64)]) ls))
'(0 -5 -31 -32 -33 -63 -64 -65 -127 -128 -129))
'((0 0) (0 -5) (0 -31) (0 -32) (-1 31) (-1 1) (-1 0) (-1 -1) (-2 1) (-2 0) (-2 -1)))
)
(mat fx+/carry
(error? (fx+/carry))
(error? (fx+/carry 1))
(error? (fx+/carry 1 2))
(error? (fx+/carry 1 2 3 4))
(error? (fx+/carry 1.0 2 3))
(error? (fx+/carry 1 2.0 3))
(error? (fx+/carry 1 2 3.0))
(error? (fx+/carry 1/2 2 3))
(error? (fx+/carry 1 2/3 3))
(error? (fx+/carry 1 2 3/4))
(error? (fx+/carry 'a 2 3))
(error? (fx+/carry 1 'b 3))
(error? (fx+/carry 1 2 'c))
(error? (fx+/carry (+ (greatest-fixnum) 1) 2 3))
(error? (fx+/carry 1 (+ (greatest-fixnum) 1) 3))
(error? (fx+/carry 1 2 (+ (greatest-fixnum) 1)))
(error? (fx+/carry (- (least-fixnum) 1) 2 3))
(error? (fx+/carry 1 (- (least-fixnum) 1) 3))
(error? (fx+/carry 1 2 (- (least-fixnum) 1)))
(let ()
(define (r6rs-fx+/carry fx1 fx2 fx3)
(let ([s (+ fx1 fx2 fx3)])
(values
(mod0 s (expt 2 (fixnum-width)))
(div0 s (expt 2 (fixnum-width))))))
(define-syntax eqv2?
(syntax-rules ()
[(_ x y)
(let-values ([(x1 x2) x] [(y1 y2) y])
(and (eqv? x1 y1) (eqv? x2 y2)))]))
(let ([m (- (+ (greatest-fixnum) 1) (least-fixnum))])
(define (mrandom) (- (+ (greatest-fixnum) 1) (random m)))
(let f ([n 1000])
(unless (fx= n 0)
(let ([x (mrandom)] [y (mrandom)] [z (mrandom)])
(unless (eqv2? (fx+/carry x y z) (r6rs-fx+/carry x y z))
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1)))))
#t)
(let-values ([(r c) (fx+/carry 100 20 3)])
(and (= r 123) (= c 0)))
(equal?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(fx+/carry 100 20 3)))
'(#3%values 123 0))
)
(mat fx-/carry
(error? (fx-/carry))
(error? (fx-/carry 1))
(error? (fx-/carry 1 2))
(error? (fx-/carry 1 2 3 4))
(error? (fx-/carry 1.0 2 3))
(error? (fx-/carry 1 2.0 3))
(error? (fx-/carry 1 2 3.0))
(error? (fx-/carry 1/2 2 3))
(error? (fx-/carry 1 2/3 3))
(error? (fx-/carry 1 2 3/4))
(error? (fx-/carry 'a 2 3))
(error? (fx-/carry 1 'b 3))
(error? (fx-/carry 1 2 'c))
(error? (fx-/carry (+ (greatest-fixnum) 1) 2 3))
(error? (fx-/carry 1 (+ (greatest-fixnum) 1) 3))
(error? (fx-/carry 1 2 (+ (greatest-fixnum) 1)))
(error? (fx-/carry (- (least-fixnum) 1) 2 3))
(error? (fx-/carry 1 (- (least-fixnum) 1) 3))
(error? (fx-/carry 1 2 (- (least-fixnum) 1)))
(let ()
(define (r6rs-fx-/carry fx1 fx2 fx3)
(let ([s (- fx1 fx2 fx3)])
(values
(mod0 s (expt 2 (fixnum-width)))
(div0 s (expt 2 (fixnum-width))))))
(define-syntax eqv2?
(syntax-rules ()
[(_ x y)
(let-values ([(x1 x2) x] [(y1 y2) y])
(and (eqv? x1 y1) (eqv? x2 y2)))]))
(let ([m (- (+ (greatest-fixnum) 1) (least-fixnum))])
(define (mrandom) (- (+ (greatest-fixnum) 1) (random m)))
(let f ([n 1000])
(unless (fx= n 0)
(let ([x (mrandom)] [y (mrandom)] [z (mrandom)])
(unless (eqv2? (fx-/carry x y z) (r6rs-fx-/carry x y z))
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1)))))
#t)
(let-values ([(r c) (fx-/carry 100 20 3)])
(and (= r 77) (= c 0)))
(equal?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(fx-/carry 100 20 3)))
'(#3%values 77 0))
)
(mat fx*/carry
(error? (fx*/carry))
(error? (fx*/carry 1))
(error? (fx*/carry 1 2))
(error? (fx*/carry 1 2 3 4))
(error? (fx*/carry 1.0 2 3))
(error? (fx*/carry 1 2.0 3))
(error? (fx*/carry 1 2 3.0))
(error? (fx*/carry 1/2 2 3))
(error? (fx*/carry 1 2/3 3))
(error? (fx*/carry 1 2 3/4))
(error? (fx*/carry 'a 2 3))
(error? (fx*/carry 1 'b 3))
(error? (fx*/carry 1 2 'c))
(error? (fx*/carry (+ (greatest-fixnum) 1) 2 3))
(error? (fx*/carry 1 (+ (greatest-fixnum) 1) 3))
(error? (fx*/carry 1 2 (+ (greatest-fixnum) 1)))
(error? (fx*/carry (- (least-fixnum) 1) 2 3))
(error? (fx*/carry 1 (- (least-fixnum) 1) 3))
(error? (fx*/carry 1 2 (- (least-fixnum) 1)))
(let ()
(define (r6rs-fx*/carry fx1 fx2 fx3)
(let ([s (+ (* fx1 fx2) fx3)])
(values
(mod0 s (expt 2 (fixnum-width)))
(div0 s (expt 2 (fixnum-width))))))
(define-syntax eqv2?
(syntax-rules ()
[(_ x y)
(let-values ([(x1 x2) x] [(y1 y2) y])
(and (eqv? x1 y1) (eqv? x2 y2)))]))
(let ([m (- (+ (greatest-fixnum) 1) (least-fixnum))])
(define (mrandom) (- (+ (greatest-fixnum) 1) (random m)))
(let f ([n 1000])
(unless (fx= n 0)
(let ([x (mrandom)] [y (mrandom)] [z (mrandom)])
(unless (eqv2? (fx*/carry x y z) (r6rs-fx*/carry x y z))
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1)))))
#t)
(let-values ([(r c) (fx*/carry 100 20 3)])
(and (= r 2003) (= c 0)))
(equal?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(fx*/carry 100 20 3)))
'(#3%values 2003 0))
)
(mat fxrotate-bit-field
(error? (fxrotate-bit-field))
(error? (fxrotate-bit-field 0))
(error? (fxrotate-bit-field 0 0))
(error? (fxrotate-bit-field 0 0 0))
(error? (fxrotate-bit-field 0 0 0 0 0))
(error? (fxrotate-bit-field 'a 0 0 0))
(error? (fxrotate-bit-field 0 0.0 0 0))
(error? (fxrotate-bit-field 0 0 2.0 0))
(error? (fxrotate-bit-field 0 0 0 3/4))
(error? (fxrotate-bit-field 0 -1 0 0))
(error? (fxrotate-bit-field 0 0 -1 0))
(error? (fxrotate-bit-field 0 0 0 -1))
(error? (fxrotate-bit-field 0 -10 -5 0))
(error? (fxrotate-bit-field (+ (most-positive-fixnum) 1) 0 0 0))
(error? (fxrotate-bit-field (- (most-negative-fixnum) 1) 0 0 0))
(error? (fxrotate-bit-field 0 (fixnum-width) 0 0))
(error? (fxrotate-bit-field 0 (+ (most-positive-fixnum) 1) 0 0))
(error? (fxrotate-bit-field 0 (- (most-negative-fixnum) 1) 0 0))
(error? (fxrotate-bit-field 0 0 (fixnum-width) 0))
(error? (fxrotate-bit-field 0 0 (+ (most-positive-fixnum) 1) 0))
(error? (fxrotate-bit-field 0 0 (- (most-negative-fixnum) 1) 0))
(error? (fxrotate-bit-field 0 0 0 (+ (most-positive-fixnum) 1)))
(error? (fxrotate-bit-field 0 0 0 (- (most-negative-fixnum) 1)))
(error? (fxrotate-bit-field 0 7 5 0))
(error? (fxrotate-bit-field 0 (+ (most-positive-fixnum) 1) (most-positive-fixnum) 0))
(error? (fxrotate-bit-field 0 (+ (most-positive-fixnum) 2) (+ (most-positive-fixnum) 1) 0))
(error? (fxrotate-bit-field 0 5 5 1))
(eqv? (fxrotate-bit-field #b10101010 5 5 0) #b10101010)
(eqv? (fxrotate-bit-field 0 0 1 0) 0)
(eqv? (fxrotate-bit-field -1 0 1 0) -1)
(eqv?
(fxrotate-bit-field #b101101011101111 2 7 3)
#b101101011111011)
(eqv?
(fxrotate-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1) 15)
(greatest-fixnum))
(eqv?
(fxrotate-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2))
(greatest-fixnum))
(eqv?
(fxrotate-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1) 15)
(least-fixnum))
(eqv?
(fxrotate-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2))
(least-fixnum))
(eqv?
(fxrotate-bit-field -1 0 (fx- (fixnum-width) 1) 15)
-1)
(eqv?
(fxrotate-bit-field -1 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2))
-1)
(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))])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (fx= i j)
(let ([k (random (fx- j i))])
(unless (and
(= (fxrotate-bit-field x i j k)
(r6rs-bitwise-rotate-bit-field x i j k))
(= (fxrotate-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)))))))))
(test-cp0-expansion eqv? '(fxrotate-bit-field #b10101010 5 5 0) #b10101010)
(test-cp0-expansion eqv? '(fxrotate-bit-field 0 0 1 0) 0)
(test-cp0-expansion eqv? '(fxrotate-bit-field -1 0 1 0) -1)
(test-cp0-expansion eqv?
'(fxrotate-bit-field #b101101011101111 2 7 3)
#b101101011111011)
(test-cp0-expansion eqv?
'(fxrotate-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1) 15)
(greatest-fixnum))
(test-cp0-expansion eqv?
'(fxrotate-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2))
(greatest-fixnum))
(test-cp0-expansion eqv?
'(fxrotate-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1) 15)
(least-fixnum))
(test-cp0-expansion eqv?
'(fxrotate-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2))
(least-fixnum))
(test-cp0-expansion eqv?
'(fxrotate-bit-field -1 0 (fx- (fixnum-width) 1) 15)
-1)
(test-cp0-expansion eqv?
'(fxrotate-bit-field -1 0 (fx- (fixnum-width) 1) (fx- (fixnum-width) 2))
-1)
)
(mat fxreverse-bit-field
(error? (fxreverse-bit-field))
(error? (fxreverse-bit-field 0))
(error? (fxreverse-bit-field 0 0))
(error? (fxreverse-bit-field 0 0 0 0))
(error? (fxreverse-bit-field 'a 0 0))
(error? (fxreverse-bit-field 0 0.0 0))
(error? (fxreverse-bit-field 0 0 2.0))
(error? (fxreverse-bit-field 0 -1 0))
(error? (fxreverse-bit-field 0 0 -1))
(error? (fxreverse-bit-field 0 -10 -5))
(error? (fxreverse-bit-field (+ (most-positive-fixnum) 1) 0 0))
(error? (fxreverse-bit-field (- (most-negative-fixnum) 1) 0 0))
(error? (fxreverse-bit-field 0 (fixnum-width) 0))
(error? (fxreverse-bit-field 0 (+ (most-positive-fixnum) 1) 0))
(error? (fxreverse-bit-field 0 (- (most-negative-fixnum) 1) 0))
(error? (fxreverse-bit-field 0 0 (fixnum-width)))
(error? (fxreverse-bit-field 0 0 (+ (most-positive-fixnum) 1)))
(error? (fxreverse-bit-field 0 0 (- (most-negative-fixnum) 1)))
(error? (fxreverse-bit-field 0 7 5))
(eqv? (fxreverse-bit-field 0 0 10) 0)
(eqv? (fxreverse-bit-field -1 0 10) -1)
(eqv?
(fxreverse-bit-field #b101101011101111 2 7)
#b101101011101111)
(eqv?
(fxreverse-bit-field #b101101011101111 3 9)
#b101101101110111)
(eqv?
(fxreverse-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1))
(greatest-fixnum))
(eqv?
(fxreverse-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1))
(greatest-fixnum))
(eqv?
(fxreverse-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1))
(least-fixnum))
(eqv?
(fxreverse-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1))
(least-fixnum))
(eqv?
(fxreverse-bit-field -1 0 (fx- (fixnum-width) 1))
-1)
(eqv?
(fxreverse-bit-field -1 0 (fx- (fixnum-width) 1))
-1)
(let ()
(define (refimpl n start end)
(define (swap n i j)
(fxcopy-bit
(fxcopy-bit n i (fxbit-field n j (fx+ j 1)))
j (fxbit-field n i (fx+ i 1))))
(let ([end (fx- end 1)])
(if (fx>= start end)
n
(refimpl (swap n start end) (fx+ start 1) end))))
(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))])
(let-values ([(i j) (if (< i j) (values i j) (values j i))])
(unless (and
(= (fxreverse-bit-field x i j)
(refimpl x i j))
(= (fxreverse-bit-field (- x) i j)
(refimpl (- x) i j)))
(errorf #f "failed for ~s ~s ~s" x i j)))))))
(test-cp0-expansion eqv? '(fxreverse-bit-field 0 0 10) 0)
(test-cp0-expansion eqv? '(fxreverse-bit-field -1 0 10) -1)
(test-cp0-expansion eqv?
'(fxreverse-bit-field #b101101011101111 2 7)
#b101101011101111)
(test-cp0-expansion eqv?
'(fxreverse-bit-field #b101101011101111 3 9)
#b101101101110111)
(test-cp0-expansion eqv?
'(fxreverse-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1))
(greatest-fixnum))
(test-cp0-expansion eqv?
'(fxreverse-bit-field (greatest-fixnum) 0 (fx- (fixnum-width) 1))
(greatest-fixnum))
(test-cp0-expansion eqv?
'(fxreverse-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1))
(least-fixnum))
(test-cp0-expansion eqv?
'(fxreverse-bit-field (least-fixnum) 0 (fx- (fixnum-width) 1))
(least-fixnum))
(test-cp0-expansion eqv?
'(fxreverse-bit-field -1 0 (fx- (fixnum-width) 1))
-1)
(test-cp0-expansion eqv?
'(fxreverse-bit-field -1 0 (fx- (fixnum-width) 1))
-1)
)
Reference in New Issue View Git Blame Copy Permalink