1036 lines
30 KiB
Scheme
1036 lines
30 KiB
Scheme
;;; fl.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 flonum->fixnum
|
|
(error? (flonum->fixnum))
|
|
(error? (flonum->fixnum 3.3 4.4))
|
|
(error? (flonum->fixnum 3))
|
|
(error? (flonum->fixnum 'a))
|
|
(error? (flonum->fixnum
|
|
(* (inexact (most-positive-fixnum)) 2.0)))
|
|
(error? (flonum->fixnum
|
|
(* (inexact (most-negative-fixnum)) 2.0)))
|
|
(eq? (+ (ash (most-positive-fixnum) -1) 1)
|
|
(flonum->fixnum (* (+ (ash (most-positive-fixnum) -1) 1) 1.0)))
|
|
(eq? (most-negative-fixnum)
|
|
(flonum->fixnum (* (most-negative-fixnum) 1.0)))
|
|
(eq? (flonum->fixnum 0.0) 0)
|
|
(eq? (flonum->fixnum 1.0) 1)
|
|
(eq? (flonum->fixnum +4.5) +4)
|
|
(eq? (flonum->fixnum +4.3) +4)
|
|
(eq? (flonum->fixnum +4.0) +4)
|
|
(eq? (flonum->fixnum +3.6) +3)
|
|
(eq? (flonum->fixnum +3.5) +3)
|
|
(eq? (flonum->fixnum +3.4) +3)
|
|
(eq? (flonum->fixnum +3.0) +3)
|
|
(eq? (flonum->fixnum +2.6) +2)
|
|
(eq? (flonum->fixnum +1.0) +1)
|
|
(eq? (flonum->fixnum +.5) 0)
|
|
(eq? (flonum->fixnum -.5) 0)
|
|
(eq? (flonum->fixnum -1.0) -1)
|
|
(eq? (flonum->fixnum -2.6) -2)
|
|
(eq? (flonum->fixnum -3.0) -3)
|
|
(eq? (flonum->fixnum -3.4) -3)
|
|
(eq? (flonum->fixnum -3.5) -3)
|
|
(eq? (flonum->fixnum -3.6) -3)
|
|
(eq? (flonum->fixnum -4.0) -4)
|
|
(eq? (flonum->fixnum -4.3) -4)
|
|
(eq? (flonum->fixnum -4.5) -4)
|
|
|
|
(test-cp0-expansion eq? '(+ (ash (most-positive-fixnum) -1) 1)
|
|
(flonum->fixnum (* (+ (ash (most-positive-fixnum) -1) 1) 1.0)))
|
|
(test-cp0-expansion eq? '(most-negative-fixnum)
|
|
(flonum->fixnum (* (most-negative-fixnum) 1.0)))
|
|
(test-cp0-expansion eq? '(flonum->fixnum 0.0) 0)
|
|
(test-cp0-expansion eq? '(flonum->fixnum 1.0) 1)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +4.5) +4)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +4.3) +4)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +4.0) +4)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +3.6) +3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +3.5) +3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +3.4) +3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +3.0) +3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +2.6) +2)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +1.0) +1)
|
|
(test-cp0-expansion eq? '(flonum->fixnum +.5) 0)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -.5) 0)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -1.0) -1)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -2.6) -2)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -3.0) -3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -3.4) -3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -3.5) -3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -3.6) -3)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -4.0) -4)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -4.3) -4)
|
|
(test-cp0-expansion eq? '(flonum->fixnum -4.5) -4)
|
|
)
|
|
|
|
(mat fixnum->flonum
|
|
(error? (fixnum->flonum))
|
|
(error? (fixnum->flonum 3 4))
|
|
(error? (fixnum->flonum 3.4))
|
|
(error? (fixnum->flonum 'a))
|
|
(error? (fixnum->flonum (+ (most-positive-fixnum) 1)))
|
|
(= (fixnum->flonum (most-positive-fixnum))
|
|
(* (most-positive-fixnum) 1.0))
|
|
(= (fixnum->flonum 0) 0.0)
|
|
(= (fixnum->flonum 1) 1.0)
|
|
(test-cp0-expansion = '(fixnum->flonum (most-positive-fixnum))
|
|
(* (most-positive-fixnum) 1.0))
|
|
(test-cp0-expansion = '(fixnum->flonum 0) 0.0)
|
|
(test-cp0-expansion = '(fixnum->flonum 1) 1.0)
|
|
(test-cp0-expansion = '(fixnum->flonum -1) -1.0)
|
|
(test-cp0-expansion = '(fixnum->flonum -1) -1.0)
|
|
)
|
|
|
|
(mat fl=
|
|
(not (fl= 3.0 4.0))
|
|
(not (fl= 4.0 3.0))
|
|
(fl= 4.1 4.1)
|
|
(not (fl= -4.1 4.1))
|
|
(not (fl= 4.1 -4.1))
|
|
(not (fl= -4.272 -3.272))
|
|
(not (fl= -3.01e-10 -.01e-3))
|
|
(fl= -4e-4)
|
|
(fl= -4e-4 -4e-4)
|
|
(fl= -4e4 -4e4 -4e4)
|
|
(error? (fl=))
|
|
(error? (fl= (list 'a)))
|
|
(error? (fl= 'a 3.1))
|
|
(error? (fl= 3.1 'a))
|
|
(error? (fl= 3.0 3.0 3))
|
|
(error? (fl= 3.0 3.1 3))
|
|
(error? (fl= 3.5 3.5 7/2 4.5))
|
|
(error? (fl= 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl= 3.0 4.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl= 3.0 (error #f "oops") 4.0))
|
|
(guard (c [#t #t]) (fl= (error #f "oops") 3.0 4.0))
|
|
(guard (c [#t #t]) (not (fl= (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl<
|
|
(fl< 3.0 4.0)
|
|
(not (fl< 4.0 3.0))
|
|
(not (fl< 4.1 4.1))
|
|
(fl< -4.1 4.1)
|
|
(not (fl< 4.1 -4.1))
|
|
(fl< -4.272 -3.272)
|
|
(not (fl< -3.01e-10 -.01e-3))
|
|
(fl< -4e-4)
|
|
(not (fl< -4e-4 -4e-4))
|
|
(not (fl< -4e-4 -4e-4 -4e-4))
|
|
(error? (fl<))
|
|
(error? (fl< (list 'a)))
|
|
(error? (fl< 'a 3.1))
|
|
(error? (fl< 3.1 'a))
|
|
(error? (fl< 3.0 3.1 3))
|
|
(error? (fl< 3.0 3.0 3))
|
|
(error? (fl< 3.5 3.5 7/2 4.5))
|
|
(error? (fl< 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl< 4.0 3.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl< 4.0 (error #f "oops") 3.0))
|
|
(guard (c [#t #t]) (fl< (error #f "oops") 4.0 3.0))
|
|
(guard (c [#t #t]) (not (fl< (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl>
|
|
(not (fl> 3.0 4.0))
|
|
(fl> 4.0 3.0)
|
|
(not (fl> 4.1 4.1))
|
|
(not (fl> -4.1 4.1))
|
|
(fl> 4.1 -4.1)
|
|
(not (fl> -4.272 -3.272))
|
|
(fl> -3.01e-10 -.01e-3)
|
|
(fl> -4e-4)
|
|
(not (fl> -4e-4 -4e-4))
|
|
(not (fl> -4e-4 -4e-4 -4e-4))
|
|
(error? (fl>))
|
|
(error? (fl> (list 'a)))
|
|
(error? (fl> 'a 3.1))
|
|
(error? (fl> 3.1 'a))
|
|
(error? (fl> 3.1 3.0 3))
|
|
(error? (fl> 3.0 3.0 3))
|
|
(error? (fl> 3.5 3.5 7/2 4.5))
|
|
(error? (fl> 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl> 3.0 4.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl> 3.0 (error #f "oops") 4.0))
|
|
(guard (c [#t #t]) (fl> (error #f "oops") 3.0 4.0))
|
|
(guard (c [#t #t]) (not (fl> (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl<=
|
|
(fl<= 3.0 4.0)
|
|
(not (fl<= 4.0 3.0))
|
|
(fl<= 4.1 4.1)
|
|
(fl<= -4.1 4.1)
|
|
(not (fl<= 4.1 -4.1))
|
|
(fl<= -4.272 -3.272)
|
|
(not (fl<= -3.01e-10 -.01e-3))
|
|
(fl<= -4e-4)
|
|
(fl<= -4e-4 -4e-4)
|
|
(fl<= -4e-4 -4e-4 -4e-4)
|
|
(error? (fl<=))
|
|
(error? (fl<= (list 'a)))
|
|
(error? (fl<= 'a 3.1))
|
|
(error? (fl<= 3.1 'a))
|
|
(error? (fl<= 3.0 3.0 3))
|
|
(error? (fl<= 3.1 3.0 3))
|
|
(error? (fl<= 3.5 3.5 7/2 4.5))
|
|
(error? (fl<= 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl<= 4.0 3.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl<= 4.0 (error #f "oops") 3.0))
|
|
(guard (c [#t #t]) (fl<= (error #f "oops") 4.0 3.0))
|
|
(guard (c [#t #t]) (not (fl<= (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl>=
|
|
(not (fl>= 3.0 4.0))
|
|
(fl>= 4.0 3.0)
|
|
(fl>= 4.1 4.1)
|
|
(not (fl>= -4.1 4.1))
|
|
(fl>= 4.1 -4.1)
|
|
(not (fl>= -4.272 -3.272))
|
|
(fl>= -3.01e-10 -.01e-3)
|
|
(fl>= -4e-4)
|
|
(fl>= -4e-4 -4e-4)
|
|
(fl>= -4e-4 -4e-4 -4e-4)
|
|
(error? (fl>=))
|
|
(error? (fl>= (list 'a)))
|
|
(error? (fl>= 'a 3.1))
|
|
(error? (fl>= 3.1 'a))
|
|
(error? (fl>= 3.0 3.0 3))
|
|
(error? (fl>= 3.0 3.1 3))
|
|
(error? (fl>= 3.5 3.5 7/2 4.5))
|
|
(error? (fl>= 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl>= 3.0 4.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl>= 3.0 (error #f "oops") 4.0))
|
|
(guard (c [#t #t]) (fl>= (error #f "oops") 3.0 4.0))
|
|
(guard (c [#t #t]) (not (fl>= (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl=?
|
|
(not (fl=? 3.0 4.0))
|
|
(not (fl=? 4.0 3.0))
|
|
(fl=? 4.1 4.1)
|
|
(not (fl=? -4.1 4.1))
|
|
(not (fl=? 4.1 -4.1))
|
|
(not (fl=? -4.272 -3.272))
|
|
(not (fl=? -3.01e-10 -.01e-3))
|
|
(fl=? -4e-4 -4e-4)
|
|
(fl=? -4e4 -4e4 -4e4)
|
|
(error? (fl=?))
|
|
(error? (fl=? 3.4))
|
|
(error? (fl=? 'a 3.1))
|
|
(error? (fl=? 3.1 'a))
|
|
(error? (fl=? 3.0 3.0 3))
|
|
(error? (fl=? 3.0 3.1 3))
|
|
(error? (fl=? 3.5 3.5 7/2 4.5))
|
|
(error? (fl=? 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl=? 3.0 4.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl=? 3.0 (error #f "oops") 4.0))
|
|
(guard (c [#t #t]) (fl=? (error #f "oops") 3.0 4.0))
|
|
(guard (c [#t #t]) (not (fl=? (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl<?
|
|
(fl<? 3.0 4.0)
|
|
(not (fl<? 4.0 3.0))
|
|
(not (fl<? 4.1 4.1))
|
|
(fl<? -4.1 4.1)
|
|
(not (fl<? 4.1 -4.1))
|
|
(fl<? -4.272 -3.272)
|
|
(not (fl<? -3.01e-10 -.01e-3))
|
|
(not (fl<? -4e-4 -4e-4))
|
|
(not (fl<? -4e-4 -4e-4 -4e-4))
|
|
(error? (fl<?))
|
|
(error? (fl<? 3.4))
|
|
(error? (fl<? 'a 3.1))
|
|
(error? (fl<? 3.1 'a))
|
|
(error? (fl<? 3.0 3.1 3))
|
|
(error? (fl<? 3.0 3.0 3))
|
|
(error? (fl<? 3.5 3.5 7/2 4.5))
|
|
(error? (fl<? 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl<? 4.0 3.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl<? 4.0 (error #f "oops") 3.0))
|
|
(guard (c [#t #t]) (fl<? (error #f "oops") 4.0 3.0))
|
|
(guard (c [#t #t]) (not (fl<? (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl>?
|
|
(not (fl>? 3.0 4.0))
|
|
(fl>? 4.0 3.0)
|
|
(not (fl>? 4.1 4.1))
|
|
(not (fl>? -4.1 4.1))
|
|
(fl>? 4.1 -4.1)
|
|
(not (fl>? -4.272 -3.272))
|
|
(fl>? -3.01e-10 -.01e-3)
|
|
(not (fl>? -4e-4 -4e-4))
|
|
(not (fl>? -4e-4 -4e-4 -4e-4))
|
|
(error? (fl>?))
|
|
(error? (fl>? 3.4))
|
|
(error? (fl>? 'a 3.1))
|
|
(error? (fl>? 3.1 'a))
|
|
(error? (fl>? 3.1 3.0 3))
|
|
(error? (fl>? 3.0 3.0 3))
|
|
(error? (fl>? 3.5 3.5 7/2 4.5))
|
|
(error? (fl>? 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl>? 3.0 4.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl>? 3.0 (error #f "oops") 4.0))
|
|
(guard (c [#t #t]) (fl>? (error #f "oops") 3.0 4.0))
|
|
(guard (c [#t #t]) (not (fl>? (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl<=?
|
|
(fl<=? 3.0 4.0)
|
|
(not (fl<=? 4.0 3.0))
|
|
(fl<=? 4.1 4.1)
|
|
(fl<=? -4.1 4.1)
|
|
(not (fl<=? 4.1 -4.1))
|
|
(fl<=? -4.272 -3.272)
|
|
(not (fl<=? -3.01e-10 -.01e-3))
|
|
(fl<=? -4e-4 -4e-4)
|
|
(fl<=? -4e-4 -4e-4 -4e-4)
|
|
(error? (fl<=?))
|
|
(error? (fl<=? 3.4))
|
|
(error? (fl<=? 'a 3.1))
|
|
(error? (fl<=? 3.1 'a))
|
|
(error? (fl<=? 3.0 3.0 3))
|
|
(error? (fl<=? 3.1 3.0 3))
|
|
(error? (fl<=? 3.5 3.5 7/2 4.5))
|
|
(error? (fl<=? 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl<=? 4.0 3.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl<=? 4.0 (error #f "oops") 3.0))
|
|
(guard (c [#t #t]) (fl<=? (error #f "oops") 4.0 3.0))
|
|
(guard (c [#t #t]) (not (fl<=? (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl>=?
|
|
(not (fl>=? 3.0 4.0))
|
|
(fl>=? 4.0 3.0)
|
|
(fl>=? 4.1 4.1)
|
|
(not (fl>=? -4.1 4.1))
|
|
(fl>=? 4.1 -4.1)
|
|
(not (fl>=? -4.272 -3.272))
|
|
(fl>=? -3.01e-10 -.01e-3)
|
|
(fl>=? -4e-4 -4e-4)
|
|
(fl>=? -4e-4 -4e-4 -4e-4)
|
|
(error? (fl>=?))
|
|
(error? (fl>=? 3.4))
|
|
(error? (fl>=? 'a 3.1))
|
|
(error? (fl>=? 3.1 'a))
|
|
(error? (fl>=? 3.0 3.0 3))
|
|
(error? (fl>=? 3.0 3.1 3))
|
|
(error? (fl>=? 3.5 3.5 7/2 4.5))
|
|
(error? (fl>=? 3.5 4.5 7/2 3.5))
|
|
(guard (c [#t #t]) (fl>=? 3.0 4.0 (error #f "oops")))
|
|
(guard (c [#t #t]) (fl>=? 3.0 (error #f "oops") 4.0))
|
|
(guard (c [#t #t]) (fl>=? (error #f "oops") 3.0 4.0))
|
|
(guard (c [#t #t]) (not (fl>=? (error #f "oops"))))
|
|
)
|
|
|
|
(mat fl+
|
|
(eqv? (fl+) 0.0)
|
|
(eqv? (fl+ -3.0) -3.0)
|
|
(eqv? (fl+ -3.0 4.0) 1.0)
|
|
(eqv? (fl+ (inexact 1/3) (inexact 1/3))
|
|
(+ (inexact 1/3) (inexact 1/3)))
|
|
(eqv? (fl+ 3.25 4.375 5.625) (+ 3.25 4.375 5.625))
|
|
(error? (fl+ '(a . b)))
|
|
(error? (fl+ 2.0 1))
|
|
(error? (fl+ 1.0 -3.0 2/3))
|
|
(string=? (number->string (fl+)) "0.0")
|
|
(test-cp0-expansion eqv? '(fl+) 0.0)
|
|
(test-cp0-expansion eqv? '(fl+ -3.0) -3.0)
|
|
(test-cp0-expansion eqv? '(fl+ -3.0 4.0) 1.0)
|
|
(test-cp0-expansion eqv?
|
|
'(fl+ (inexact 1/3) (inexact 1/3))
|
|
(+ (inexact 1/3) (inexact 1/3)))
|
|
(test-cp0-expansion eqv? '(fl+ 3.25 4.375 5.625) (+ 3.25 4.375 5.625))
|
|
)
|
|
|
|
(mat fl-
|
|
(error? (fl-))
|
|
(eqv? (fl- -3.0) 3.0)
|
|
(eqv? (fl- -3.0 4.0) -7.0)
|
|
(eqv? (fl- (inexact 1/3) (inexact 1/7))
|
|
(- (inexact 1/3) (inexact 1/7)))
|
|
(eqv? (fl- 3.25 4.375 5.625) (- 3.25 4.375 5.625))
|
|
(error? (fl- '(a . b)))
|
|
(error? (fl- 2.0 1))
|
|
(error? (fl- 'a 'b))
|
|
(error? (fl- 'a 'b 'c))
|
|
(error? (fl- 1.0 -3.0 2/3))
|
|
(error? (fl- 1.0 'b 2.0))
|
|
(test-cp0-expansion eqv? '(fl- -3.0) 3.0)
|
|
(test-cp0-expansion eqv? '(fl- -3.0 4.0) -7.0)
|
|
(test-cp0-expansion eqv?
|
|
'(fl- (inexact 1/3) (inexact 1/7))
|
|
(- (inexact 1/3) (inexact 1/7)))
|
|
(test-cp0-expansion eqv? '(fl- 3.25 4.375 5.625) (- 3.25 4.375 5.625))
|
|
)
|
|
|
|
(mat fl*
|
|
(eqv? (fl*) 1.0)
|
|
(eqv? (fl* -3.0) -3.0)
|
|
(eqv? (fl* -3.0 4.0) -12.0)
|
|
(eqv? (fl* (inexact 1/3) (inexact 1/3))
|
|
(* (inexact 1/3) (inexact 1/3)))
|
|
(eqv? (fl* 3.25 4.375 5.625) (* 3.25 4.375 5.625))
|
|
(error? (fl* '(a . b)))
|
|
(error? (fl* 2.0 1))
|
|
(error? (fl* 1.0 -3.0 2/3))
|
|
(string=? (number->string (fl*)) "1.0")
|
|
(test-cp0-expansion eqv? '(fl*) 1.0)
|
|
(test-cp0-expansion eqv? '(fl* -3.0) -3.0)
|
|
(test-cp0-expansion eqv? '(fl* -3.0 4.0) -12.0)
|
|
(test-cp0-expansion eqv?
|
|
'(fl* (inexact 1/3) (inexact 1/3))
|
|
(* (inexact 1/3) (inexact 1/3)))
|
|
(test-cp0-expansion eqv? '(fl* 3.25 4.375 5.625) (* 3.25 4.375 5.625))
|
|
)
|
|
|
|
(mat fl/
|
|
(error? (fl/))
|
|
(eqv? (fl/ -3.0) (/ -3.0))
|
|
(eqv? (fl/ -3.0 4.0) -.75)
|
|
(eqv? (fl/ (inexact 1/3) (inexact 1/7))
|
|
(/ (inexact 1/3) (inexact 1/7)))
|
|
(eqv? (fl/ 3.25 4.375 5.625) (/ 3.25 4.375 5.625))
|
|
(error? (fl/ '(a . b)))
|
|
(error? (fl/ 2.0 1))
|
|
(error? (fl/ 1.0 -3.0 2/3))
|
|
(test-cp0-expansion eqv? '(fl/ -3.0) (/ -3.0))
|
|
(test-cp0-expansion eqv? '(fl/ -3.0 4.0) -.75)
|
|
(test-cp0-expansion eqv?
|
|
'(fl/ (inexact 1/3) (inexact 1/7))
|
|
(/ (inexact 1/3) (inexact 1/7)))
|
|
(test-cp0-expansion eqv? '(fl/ 3.25 4.375 5.625) (/ 3.25 4.375 5.625))
|
|
)
|
|
|
|
(mat flabs
|
|
(error? (flabs))
|
|
(error? (flabs 1 2))
|
|
(error? (flabs 'a))
|
|
(error? (flabs 1))
|
|
(error? (flabs -3/4))
|
|
(error? (flabs 3+4i))
|
|
(error? (flabs 3.3+4.5i))
|
|
(fl~= (flabs 1.83) 1.83)
|
|
(fl~= (flabs -0.093) 0.093)
|
|
(== (flabs -0.0) 0.0)
|
|
(== (flabs 0.0) 0.0)
|
|
(== (flabs +inf.0) +inf.0)
|
|
(== (flabs -inf.0) +inf.0)
|
|
(== (flabs +nan.0) +nan.0)
|
|
(eqv? (flabs 0.0) 0.0)
|
|
(eqv? (flabs -1.0) 1.0)
|
|
(eqv? (flabs 1.0) 1.0)
|
|
)
|
|
|
|
(mat fllog
|
|
(error? (fllog))
|
|
(error? (fllog 3))
|
|
(error? (fllog 'a))
|
|
(error? (fllog 0))
|
|
(fl~= (fllog 1.0) 0.0)
|
|
(fl~= (fllog (exp 7.0)) 7.0)
|
|
(fl~= (fllog (exp 10.2)) 10.2)
|
|
(fl~= (fllog 1e30) (inexact (log #e1e30)))
|
|
(fl~= (/ (log (expt 10 500)) (fllog 10.0)) 500.0)
|
|
(fl~= (log 3/4) (fllog .75))
|
|
(fl~= (fllog 10.0 10.0) 1.0)
|
|
(fl~= (fllog 50.0 50.0) 1.0)
|
|
(fl~= (fllog 1000.0 10.0) 3.0)
|
|
; r6rs:
|
|
(== (fllog +inf.0) +inf.0)
|
|
(== (fllog 0.0) -inf.0)
|
|
(== (fllog -inf.0) +nan.0)
|
|
)
|
|
|
|
(mat flexp
|
|
(error? (flexp))
|
|
(error? (flexp 3.0 4.0))
|
|
(error? (flexp 'a))
|
|
(error? (flexp 3))
|
|
(fl= (flexp 0.0) 1.0)
|
|
(~= (* (flexp 1.0) (flexp 1.0)) (flexp 2.0))
|
|
(fl~= (/ (flexp 24.2) (flexp 2.0)) (flexp 22.2))
|
|
; r6rs:
|
|
(== (flexp +inf.0) +inf.0)
|
|
(== (flexp -inf.0) 0.0)
|
|
)
|
|
|
|
(mat flsin
|
|
(and (> pi 3.14159265) (< pi 3.14159266))
|
|
(error? (flsin))
|
|
(error? (flsin 3.0 4.0))
|
|
(error? (flsin 'a))
|
|
(error? (flsin 3))
|
|
(fl~= (flsin (/ pi 6)) 0.5)
|
|
)
|
|
|
|
(mat flcos
|
|
(error? (flcos))
|
|
(error? (flcos 3.0 4.0))
|
|
(error? (flcos 'a))
|
|
(error? (flcos 3))
|
|
(fl~= (flcos (/ pi 3)) 0.5)
|
|
(let ([x 3.3])
|
|
(let ([s (flsin x)] [c (flcos x)])
|
|
(~= (+ (* s s) (* c c)) 1.0)))
|
|
)
|
|
|
|
(mat fltan
|
|
(error? (fltan))
|
|
(error? (fltan 3.0 4.0))
|
|
(error? (fltan 'a))
|
|
(error? (fltan 3))
|
|
(fl~= (fltan (/ pi 4)) 1.0)
|
|
(let ([x 4.4]) (~= (fltan x) (/ (flsin x) (flcos x))))
|
|
)
|
|
|
|
(mat flasin
|
|
(error? (flasin))
|
|
(error? (flasin 3.0 4.0))
|
|
(error? (flasin 'a))
|
|
(error? (flasin 3))
|
|
(fl~= (flasin 1.0) (/ pi 2))
|
|
(let ([x 1.0]) (fl~= (flasin (flsin x)) x))
|
|
(let ([x 0.5]) (fl~= (flasin (flsin x)) x))
|
|
)
|
|
|
|
(mat flacos
|
|
(error? (flacos))
|
|
(error? (flacos 3.0 4.0))
|
|
(error? (flacos 'a))
|
|
(error? (flacos 3))
|
|
(fl~= (flacos 0.5) (/ pi 3))
|
|
(let ([x 0.5]) (fl~= (flacos (flcos x)) x))
|
|
)
|
|
|
|
(mat flatan
|
|
(error? (flatan))
|
|
(error? (flatan 3.0 4.0 5.0))
|
|
(error? (flatan 'a))
|
|
(error? (flatan 'a 3.0))
|
|
(error? (flatan 3.0 'a))
|
|
(error? (flatan 3 4))
|
|
(error? (flatan +i))
|
|
(error? (flatan -i))
|
|
(fl~= (flatan 1.0) (/ pi 4))
|
|
(fl~= (flatan 2.0 2.0) (/ pi 4))
|
|
(let ([x 0.5]) (fl~= (flatan (fltan x)) x))
|
|
(fl~= (flatan 10.0 -10.0) (angle -10+10i))
|
|
(fl~= (flatan 10.0 -10.0) (angle -10.0+10.0i))
|
|
(fl~= (flatan 10.0 -10.0) (flatan 10.0 -10.0))
|
|
; r6rs:
|
|
(== (flatan -inf.0) -1.5707963267948965)
|
|
(== (flatan +inf.0) 1.5707963267948965)
|
|
)
|
|
|
|
(mat flsqrt
|
|
(error? (flsqrt))
|
|
(error? (flsqrt 3.0 4.0))
|
|
(error? (flsqrt 'a))
|
|
(error? (flsqrt 3))
|
|
(== (flsqrt -1.0) (nan))
|
|
(~= (flsqrt 9.0) 3.0)
|
|
(~= (flsqrt #i1/4) #e1/2)
|
|
(~= (* (flsqrt 189.0) (flsqrt 189.0)) 189.0)
|
|
(fl~= (* (flsqrt 2.0) (flsqrt 2.0)) 2.0)
|
|
(~= (flsqrt 1e38) (sqrt #e1e38))
|
|
; r6rs:
|
|
(== (flsqrt +inf.0) +inf.0)
|
|
(== (flsqrt -0.0) -0.0)
|
|
)
|
|
|
|
(mat flexpt
|
|
(error? (flexpt))
|
|
(error? (flexpt 5.0))
|
|
(error? (flexpt 3.0 4.0 5.0))
|
|
(error? (flexpt 'a 3.0))
|
|
(error? (flexpt 3.0 'a))
|
|
(error? (flexpt 0.0 -1))
|
|
(error? (flexpt 0.0 +1i))
|
|
(fl~= (flexpt 10.0 -20.0) 1e-20)
|
|
(eqv? (flexpt 2.0 10.0) 1024.0)
|
|
(eqv? (flexpt 0.0 0.0) 1.0)
|
|
(eqv? (flexpt 0.0 2.0) 0.0)
|
|
(eqv? (flexpt 100.0 0.0) 1.0)
|
|
(eqv? (flexpt 2.0 -10.0) #i1/1024)
|
|
(eqv? (flexpt #i-1/2 #i5) #i-1/32)
|
|
(fl~= (flexpt 9.0 #i1/2) 3.0)
|
|
(fl~= (flexpt 3.0 3.0) 27.0)
|
|
(~= (flexpt -0.5 2.0) .25)
|
|
(~= (flexpt -0.5 -2.0) 4.0)
|
|
(~= (flexpt 3.0 2.5) (flsqrt (* 3.0 3.0 3.0 3.0 3.0)))
|
|
(fl= (flexpt 0.0 2.0) 0.0)
|
|
(fl= (flexpt 0.0 0.0) 1.0)
|
|
(fl= (flexpt 2.0 0.0) 1.0)
|
|
(fl~= (flexpt #i-2/3 #i-3) #i-27/8)
|
|
(fl= (flexpt 10.0 -1000.0) 0.0)
|
|
(fl= (flexpt .1 1000.0) 0.0)
|
|
(~= (flexpt #i11 #i1/2) (flsqrt #i11))
|
|
(fl~= (flexpt 1.5e-20 0.5) (flsqrt 1.5e-20))
|
|
(equal?
|
|
(let ([ls '(a b c)])
|
|
(let ([n (flexpt (begin (set! ls (append ls ls)) 2.0)
|
|
(begin (set! ls (reverse ls)) 3.0))])
|
|
(cons n ls)))
|
|
'(8.0 c b a c b a))
|
|
)
|
|
|
|
(mat fltruncate
|
|
(error? (fltruncate))
|
|
(error? (fltruncate 2.0 3.0))
|
|
(error? (fltruncate 'a))
|
|
(error? (fltruncate 3))
|
|
(error? (fltruncate 2+1.0i))
|
|
(error? (fltruncate 2+1i))
|
|
(eqv? (fltruncate 19.0) 19.0)
|
|
(eqv? (fltruncate #i2/3) 0.0)
|
|
(fl~= (fltruncate #i-2/3) 0.0)
|
|
(fl= (fltruncate #i17.3) 17.0)
|
|
(eqv? (fltruncate #i-17/2) -8.0)
|
|
(fl= (fltruncate 2.5) 2.0)
|
|
; r6rs:
|
|
(== (fltruncate +nan.0) +nan.0)
|
|
)
|
|
|
|
(mat flfloor
|
|
(error? (flfloor))
|
|
(error? (flfloor 2.0 3.0))
|
|
(error? (flfloor 'a))
|
|
(error? (flfloor 3))
|
|
(error? (flfloor 2+1.0i))
|
|
(error? (flfloor 2+1i))
|
|
(eqv? (flfloor 19.0) 19.0)
|
|
(eqv? (flfloor #i2/3) 0.0)
|
|
(eqv? (flfloor #i-2/3) -1.0)
|
|
(fl= (flfloor #i17.3) 17.0)
|
|
(eqv? (flfloor #i-17/2) -9.0)
|
|
(fl= (flfloor 2.5) 2.0)
|
|
; r6rs:
|
|
(== (flfloor +inf.0) +inf.0)
|
|
)
|
|
|
|
(mat flceiling
|
|
(error? (flceiling))
|
|
(error? (flceiling 2.0 3.0))
|
|
(error? (flceiling 'a))
|
|
(error? (flceiling 3))
|
|
(error? (flceiling 2+1.0i))
|
|
(eqv? (flceiling 19.0) 19.0)
|
|
(eqv? (flceiling #i2/3) 1.0)
|
|
(fl~= (flceiling #i-2/3) 0.0)
|
|
(fl= (flceiling #i17.3) 18.0)
|
|
(eqv? (flceiling #i-17/2) -8.0)
|
|
(fl= (flceiling 2.5) 3.0)
|
|
; r6rs:
|
|
(== (flceiling -inf.0) -inf.0)
|
|
)
|
|
|
|
(mat flround
|
|
(error? (flround))
|
|
(error? (flround 2.0 3))
|
|
(error? (flround 'a))
|
|
(error? (flround 2+1.0i))
|
|
(error? (flround 2+1i))
|
|
(error? (flround 19))
|
|
(error? (flround 2/3))
|
|
(fl= (flround 17.3) 17.0)
|
|
(fl= (flround 2.5) 2.0)
|
|
(fl= (flround 0.5000000000000000) 0.0)
|
|
(fl= (flround 0.5000000000000001) 1.0)
|
|
)
|
|
|
|
(mat flinteger?
|
|
(error? (flinteger? 'a))
|
|
(error? (flinteger? "hi"))
|
|
(error? (flinteger? (cons 3 4)))
|
|
(error? (flinteger? 3.0+0.0i))
|
|
(error? (flinteger? 3.0+1.0i))
|
|
(flinteger? 3.0)
|
|
(flinteger? 23048230482304.0)
|
|
(not (flinteger? #i-3/4))
|
|
(flinteger? -1.0)
|
|
(flinteger? 0.0)
|
|
(flinteger? -12083.0)
|
|
(flinteger? 4.0)
|
|
(not (flinteger? 3.5))
|
|
(not (flinteger? 1.8e-10))
|
|
(flinteger? 1.8e10)
|
|
(flinteger? -3e5)
|
|
(not (flinteger? -1231.2344))
|
|
)
|
|
|
|
(mat flnan?
|
|
(error? (flnan? 3))
|
|
(error? (flnan? 3/4))
|
|
(error? (flnan? 'hi))
|
|
(flnan? (nan))
|
|
(not (flnan? 5.0))
|
|
(not (flnan? +inf.0))
|
|
(not (flnan? -inf.0))
|
|
)
|
|
|
|
(mat flfinite?
|
|
(error? (flfinite? 3))
|
|
(error? (flfinite? 3/4))
|
|
(error? (flfinite? 'hi))
|
|
(not (flfinite? (nan)))
|
|
(flfinite? 5.0)
|
|
(not (flfinite? +inf.0))
|
|
(not (flfinite? -inf.0))
|
|
; r6rs:
|
|
(not (flfinite? +inf.0))
|
|
(flfinite? 5.0)
|
|
)
|
|
|
|
(mat flinfinite?
|
|
(error? (flinfinite? 3))
|
|
(error? (flinfinite? 3/4))
|
|
(error? (flinfinite? 'hi))
|
|
(not (flinfinite? (nan)))
|
|
(not (flinfinite? 5.0))
|
|
(flinfinite? +inf.0)
|
|
(flinfinite? -inf.0)
|
|
; r6rs:
|
|
(not (flinfinite? 5.0))
|
|
(flinfinite? +inf.0)
|
|
)
|
|
|
|
(mat flzero?
|
|
(error? (flzero?))
|
|
(error? (flzero? 0.0 1.0))
|
|
(error? (flzero? 'a))
|
|
(error? (flzero? 3))
|
|
(flzero? 0.0)
|
|
(flzero? #i0/5)
|
|
(not (flzero? 234.0))
|
|
(not (flzero? #i23423423/234241211))
|
|
(not (flzero? 23.4))
|
|
(not (flzero? -1734234.0))
|
|
(not (flzero? #i-2/3))
|
|
(not (flzero? -0.1))
|
|
)
|
|
|
|
(mat flpositive?
|
|
(error? (flpositive?))
|
|
(error? (flpositive? 0.0 1.0))
|
|
(error? (flpositive? 'a))
|
|
(error? (flpositive? 3))
|
|
(error? (flpositive? 1+1.0i))
|
|
(error? (flpositive? 1+1i))
|
|
(not (flpositive? 0.0))
|
|
(not (flpositive? #i0/5))
|
|
(flpositive? 234.0)
|
|
(flpositive? #i23423423/234241211)
|
|
(flpositive? 23.4)
|
|
(not (flpositive? -1734234.0))
|
|
(not (flpositive? #i-2/3))
|
|
(not (flpositive? -0.1))
|
|
)
|
|
|
|
(mat flnegative?
|
|
(error? (flnegative?))
|
|
(error? (flnegative? 0.0 1.0))
|
|
(error? (flnegative? 'a))
|
|
(error? (flnegative? 3))
|
|
(error? (flnegative? 1+1.0i))
|
|
(error? (flnegative? 1+1i))
|
|
(not (flnegative? 0.0))
|
|
(not (flnegative? #i0/5))
|
|
(not (flnegative? 234.0))
|
|
(not (flnegative? #i23423423/234241211))
|
|
(not (flnegative? 23.4))
|
|
(flnegative? -1734234.0)
|
|
(flnegative? #i-2/3)
|
|
(flnegative? -0.1)
|
|
; r6rs:
|
|
(not (flnegative? -0.0))
|
|
)
|
|
|
|
(mat flnonpositive?
|
|
(error? (flnonpositive?))
|
|
(error? (flnonpositive? 0.0 1.0))
|
|
(error? (flnonpositive? 'a))
|
|
(error? (flnonpositive? 3))
|
|
(error? (flnonpositive? 1+1.0i))
|
|
(error? (flnonpositive? 1+1i))
|
|
(flnonpositive? 0.0)
|
|
(flnonpositive? #i0/5)
|
|
(not (flnonpositive? 234.0))
|
|
(not (flnonpositive? #i23423423/234241211))
|
|
(not (flnonpositive? 23.4))
|
|
(flnonpositive? -1734234.0)
|
|
(flnonpositive? #i-2/3)
|
|
(flnonpositive? -0.1)
|
|
)
|
|
|
|
(mat flnonnegative?
|
|
(error? (flnonnegative?))
|
|
(error? (flnonnegative? 0.0 1.0))
|
|
(error? (flnonnegative? 'a))
|
|
(error? (flnonnegative? 3))
|
|
(error? (flnonnegative? 1+1i))
|
|
(error? (flnonnegative? 1.0+1.0i))
|
|
(flnonnegative? 0.0)
|
|
(flnonnegative? #i0/5)
|
|
(flnonnegative? 234.0)
|
|
(flnonnegative? #i23423423/234241211)
|
|
(flnonnegative? 23.4)
|
|
(not (flnonnegative? -1734234.0))
|
|
(not (flnonnegative? #i-2/3))
|
|
(not (flnonnegative? -0.1))
|
|
)
|
|
|
|
(mat fleven?
|
|
(error? (fleven?))
|
|
(error? (fleven? 0.0 1.0))
|
|
(error? (fleven? 'a))
|
|
(error? (fleven? 3))
|
|
(error? (fleven? 3.2))
|
|
(error? (fleven? 3.0+1.0i))
|
|
(error? (fleven? 1+1i))
|
|
(error? (fleven? +inf.0))
|
|
(error? (fleven? +nan.0))
|
|
(not (fleven? -3.0))
|
|
(fleven? 2.0)
|
|
(not (fleven? 1208312083280477.0))
|
|
(fleven? 1208312083280478.0)
|
|
(fleven? 4.0)
|
|
(not (fleven? 3.0))
|
|
)
|
|
|
|
(mat flodd?
|
|
(error? (flodd?))
|
|
(error? (flodd? 0.0 1.0))
|
|
(error? (flodd? 'a))
|
|
(error? (flodd? 3))
|
|
(error? (flodd? 3.2))
|
|
(error? (flodd? 3.0+1.0i))
|
|
(error? (flodd? 3+1i))
|
|
(error? (flodd? +inf.0))
|
|
(error? (flodd? +nan.0))
|
|
(flodd? -3.0)
|
|
(not (flodd? 2.0))
|
|
(flodd? 1208312083280477.0)
|
|
(not (flodd? 1208312083280478.0))
|
|
(not (flodd? 4.0))
|
|
(flodd? 3.0)
|
|
)
|
|
|
|
(mat flmin
|
|
(error? (flmin))
|
|
(error? (flmin 'a))
|
|
(error? (flmin 1.0 'a))
|
|
(error? (flmin 1.0 'a 2.0))
|
|
(error? (flmin 1.0 3 2.0))
|
|
(error? (flmin 1.0 2.0 3.0 'a))
|
|
(error? (flmin 1.0 2.0 3.0 0+1.0i))
|
|
(error? (flmin 1.0 2.0 3.0 +1i))
|
|
(eqv? (flmin -17.0) -17.0)
|
|
(eqv? (flmin 3.0 -3.0) -3.0)
|
|
(eqv? (flmin 3.2 1.0) 1.0)
|
|
(fl= (flmin 3.2 1.0) 1.0)
|
|
(fl= (flmin #i1/2 0.5) 0.5)
|
|
(fl= (flmin #i-1/2 0.5) -0.5)
|
|
(eqv? (flmin 3.0 5.0 1.0 4.0 6.0 2.0) 1.0)
|
|
(== (flmin 4.5 (nan)) (nan))
|
|
(== (flmin (nan) 4.5) (nan))
|
|
(== (flmin +inf.0 (nan)) (nan))
|
|
(== (flmin (nan) +inf.0) (nan))
|
|
(== (flmin -inf.0 (nan)) (nan))
|
|
(== (flmin (nan) -inf.0) (nan))
|
|
(== (flmin 3.0 4.5 (nan) 17.3 -1.5) (nan))
|
|
(fl= (flmin 3.0 4.5 +inf.0 17.3 -1.5) -1.5)
|
|
(fl= (flmin 3.0 4.5 -inf.0 17.3 -1.5) -inf.0)
|
|
)
|
|
|
|
(mat flmax
|
|
(error? (flmax))
|
|
(error? (flmax 'a))
|
|
(error? (flmax 1.0 'a))
|
|
(error? (flmax 1.0 3))
|
|
(error? (flmax 1.0 'a 2.0))
|
|
(error? (flmax 1.0 2.0 3.0 'a))
|
|
(error? (flmax 1.0 2.0 3.0 0+1.0i))
|
|
(error? (flmax 1.0 2.0 3.0 +1i))
|
|
(eqv? (flmax 1.0) 1.0)
|
|
(eqv? (flmax 3.0 -3.0) 3.0)
|
|
(fl= (flmax 3.2 1.0) 3.2)
|
|
(fl= (flmax 3.2 1.0) 3.2)
|
|
(fl= (flmax #i1/2 0.5) 0.5)
|
|
(fl= (flmax #i1/2 -0.5) 0.5)
|
|
(eqv? (flmax 3.0 5.0 1.0 4.0 6.0 2.0) 6.0)
|
|
(== (flmax 4.5 (nan)) (nan))
|
|
(== (flmax (nan) 4.5) (nan))
|
|
(== (flmax +inf.0 (nan)) (nan))
|
|
(== (flmax (nan) +inf.0) (nan))
|
|
(== (flmax -inf.0 (nan)) (nan))
|
|
(== (flmax (nan) -inf.0) (nan))
|
|
(== (flmax 3.0 4.5 (nan) 17.3 -1.5) (nan))
|
|
(fl= (flmax 3.0 4.5 +inf.0 17.3 -1.5) +inf.0)
|
|
(fl= (flmax 3.0 4.5 -inf.0 17.3 -1.5) 17.3)
|
|
)
|
|
|
|
(mat flnumerator
|
|
(error? (flnumerator))
|
|
(error? (flnumerator 3.0 4.0))
|
|
(error? (flnumerator 'a))
|
|
(error? (flnumerator 3))
|
|
(error? (flnumerator +1i))
|
|
(error? (flnumerator 2.2+1.1i))
|
|
(eqv? (flnumerator 3.25) 13.0)
|
|
(eqv? (flnumerator 9.0) 9.0)
|
|
(fl~= (let ([n (flnumerator #i2/3)] [d (fldenominator #i2/3)]) (/ n d)) #i2/3)
|
|
(fl~= (flnumerator #i-9/4) -9.0)
|
|
(== (flnumerator +nan.0) +nan.0)
|
|
; r6rs:
|
|
(== (flnumerator +inf.0) +inf.0)
|
|
(== (flnumerator -inf.0) -inf.0)
|
|
(== (flnumerator 0.75) 3.0)
|
|
)
|
|
|
|
(mat fldenominator
|
|
(error? (fldenominator))
|
|
(error? (fldenominator 3.0 4.0))
|
|
(error? (fldenominator 'a))
|
|
(error? (fldenominator 3))
|
|
(error? (fldenominator +1i))
|
|
(error? (fldenominator 2.2+1.1i))
|
|
(eqv? (fldenominator 3.25) 4.0)
|
|
(eqv? (fldenominator 9.0) 1.0)
|
|
(eqv? (fldenominator #i-9/4) 4.0)
|
|
(== (fldenominator +nan.0) +nan.0)
|
|
; r6rs:
|
|
(== (fldenominator +inf.0) 1.0)
|
|
(== (fldenominator -inf.0) 1.0)
|
|
(== (fldenominator 0.75) 4.0)
|
|
)
|
|
|
|
(mat fldiv-and-mod
|
|
; fldiv-and-mod
|
|
(error? (fldiv-and-mod 17 3.0))
|
|
(error? (fldiv-and-mod 3.0 17))
|
|
(error? (fldiv-and-mod 'a 17.0))
|
|
(error? (fldiv-and-mod 17.0 '(a)))
|
|
; fldiv
|
|
(error? (fldiv 17 3.0))
|
|
(error? (fldiv 3.0 17))
|
|
(error? (fldiv 'a 17.0))
|
|
(error? (fldiv 17.0 '(a)))
|
|
; flmod
|
|
(error? (flmod 17 3.0))
|
|
(error? (flmod 3.0 17))
|
|
(error? (flmod 'a 17.0))
|
|
(error? (flmod 17.0 '(a)))
|
|
; fldiv-and-mod
|
|
(begin
|
|
(define $d&m fldiv-and-mod)
|
|
(define ($dmpair x y) (call-with-values (lambda () ($d&m x y)) cons))
|
|
(define ($dmpairs x y)
|
|
(list ($dmpair x y) ($dmpair (- x) y) ($dmpair x (- y)) ($dmpair (- x) (- y))
|
|
($dmpair y x) ($dmpair (- y) x) ($dmpair y (- x)) ($dmpair (- y) (- x))))
|
|
(define ($dmequal? x y)
|
|
(cond
|
|
[(pair? x)
|
|
(and (pair? y)
|
|
($dmequal? (car x) (car y))
|
|
($dmequal? (cdr x) (cdr y)))]
|
|
[(number? x)
|
|
(and (number? y)
|
|
(if (inexact? x)
|
|
(and (inexact? y) (== x y))
|
|
(and (exact? y) (= x y))))]
|
|
[else (eq? x y)]))
|
|
#t)
|
|
($dmequal?
|
|
($dmpairs 0.0 3.5)
|
|
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
|
|
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
|
|
($dmequal?
|
|
($dmpairs 3.5 11.25)
|
|
'((0.0 . 3.5) (-1.0 . 7.75) (-0.0 . 3.5) (1.0 . 7.75)
|
|
(3.0 . 0.75) (-4.0 . 2.75) (-3.0 . 0.75) (4.0 . 2.75)))
|
|
; fldiv with flmod
|
|
(begin
|
|
(set! $d&m (lambda (x y) (values (fldiv x y) (flmod x y))))
|
|
#t)
|
|
($dmequal?
|
|
($dmpairs 0.0 3.5)
|
|
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
|
|
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
|
|
($dmequal?
|
|
($dmpairs 3.5 11.25)
|
|
'((0.0 . 3.5) (-1.0 . 7.75) (-0.0 . 3.5) (1.0 . 7.75)
|
|
(3.0 . 0.75) (-4.0 . 2.75) (-3.0 . 0.75) (4.0 . 2.75)))
|
|
)
|
|
|
|
(mat fldiv0-and-mod0
|
|
; fldiv0-and-mod0
|
|
(error? (fldiv0-and-mod0 17 3.0))
|
|
(error? (fldiv0-and-mod0 3.0 17))
|
|
(error? (fldiv0-and-mod0 'a 17.0))
|
|
(error? (fldiv0-and-mod0 17.0 '(a)))
|
|
; fldiv0
|
|
(error? (fldiv0 17 3.0))
|
|
(error? (fldiv0 3.0 17))
|
|
(error? (fldiv0 'a 17.0))
|
|
(error? (fldiv0 17.0 '(a)))
|
|
; flmod0
|
|
(error? (flmod0 17 3.0))
|
|
(error? (flmod0 3.0 17))
|
|
(error? (flmod0 'a 17.0))
|
|
(error? (flmod0 17.0 '(a)))
|
|
; fldiv0-and-mod0
|
|
(begin
|
|
(define $d&m fldiv0-and-mod0)
|
|
(define ($dmpair x y) (call-with-values (lambda () ($d&m x y)) cons))
|
|
(define ($dmpairs x y)
|
|
(list ($dmpair x y) ($dmpair (- x) y) ($dmpair x (- y)) ($dmpair (- x) (- y))
|
|
($dmpair y x) ($dmpair (- y) x) ($dmpair y (- x)) ($dmpair (- y) (- x))))
|
|
#t)
|
|
($dmequal?
|
|
($dmpairs 0.0 3.5)
|
|
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
|
|
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
|
|
($dmequal?
|
|
($dmpairs 3.5 11.25)
|
|
'((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
|
|
(3.0 . 0.75) (-3.0 . -0.75) (-3.0 . 0.75) (3.0 . -0.75)))
|
|
($dmequal?
|
|
($dmpairs 10.0 4.0)
|
|
'((3.0 . -2.0) (-2.0 . -2.0) (-3.0 . -2.0) (2.0 . -2.0)
|
|
(0.0 . 4.0) (0.0 . -4.0) (-0.0 . 4.0) (0.0 . -4.0)))
|
|
; fldiv0 with flmod0
|
|
(begin
|
|
(set! $d&m (lambda (x y) (values (fldiv0 x y) (flmod0 x y))))
|
|
#t)
|
|
($dmequal?
|
|
($dmpairs 0.0 3.5)
|
|
'((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
|
|
(+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
|
|
($dmequal?
|
|
($dmpairs 3.5 11.25)
|
|
'((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
|
|
(3.0 . 0.75) (-3.0 . -0.75) (-3.0 . 0.75) (3.0 . -0.75)))
|
|
($dmequal?
|
|
($dmpairs 10.0 4.0)
|
|
'((3.0 . -2.0) (-2.0 . -2.0) (-3.0 . -2.0) (2.0 . -2.0)
|
|
(0.0 . 4.0) (0.0 . -4.0) (-0.0 . 4.0) (0.0 . -4.0)))
|
|
)
|