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

1036 lines
30 KiB
Scheme
Raw Normal View History

feat: 9.5.9
2022-07-29 15:12:07 +02:00
;;; 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)))
)
Reference in a new issue Copy permalink