2907 lines
103 KiB
Scheme
2907 lines
103 KiB
Scheme
|
;;; 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)
|
||
|
)
|