~ chicken-core (chicken-5) f89539d7cd0df71361202687ca876a16f61781ed
commit f89539d7cd0df71361202687ca876a16f61781ed
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Jan 25 20:07:11 2015 +0100
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun May 31 14:14:25 2015 +0200
Make exact->inexact and inexact->exact aware of extended number types.
Implement rounding operations: round, floor, ceiling, truncate.
Add rationalize, remove ratnum restrictions from "Deviations from the standard".
Update angle, log, exp, expt and the trig functions to accept extended numbers.
After bootstrapping this with itself, numbers-string-conversion-tests works!
diff --git a/c-platform.scm b/c-platform.scm
index 383495a5..8808160e 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -127,7 +127,8 @@
integer->char eof-object? vector-length string-length string-ref string-set! vector-ref
vector-set! char=? char<? char>? char>=? char<=? gcd lcm reverse symbol? string->symbol
number? complex? real? integer? rational? odd? even? positive? negative? exact? inexact?
- max min quotient remainder modulo floor ceiling truncate round exact->inexact inexact->exact
+ max min quotient remainder modulo floor ceiling truncate round rationalize
+ exact->inexact inexact->exact
exp log sin expt sqrt cos tan asin acos atan number->string string->number char-ci=?
char-ci<? char-ci>? char-ci>=? char-ci<=? char-alphabetic? char-whitespace? char-numeric?
char-lower-case? char-upper-case? char-upcase char-downcase string? string=? string>? string<?
@@ -539,17 +540,6 @@
(rewrite 'fpneg 16 1 "C_a_i_flonum_negate" #f words-per-flonum)
(rewrite 'fpgcd 16 2 "C_a_i_flonum_gcd" #f words-per-flonum)
-(rewrite 'exp 16 1 "C_a_i_exp" #t words-per-flonum)
-(rewrite 'sin 16 1 "C_a_i_sin" #t words-per-flonum)
-(rewrite 'cos 16 1 "C_a_i_cos" #t words-per-flonum)
-(rewrite 'tan 16 1 "C_a_i_tan" #t words-per-flonum)
-(rewrite 'log 16 1 "C_a_i_log" #t words-per-flonum)
-(rewrite 'asin 16 1 "C_a_i_asin" #t words-per-flonum)
-(rewrite 'acos 16 1 "C_a_i_acos" #t words-per-flonum)
-(rewrite 'atan 16 1 "C_a_i_atan" #t words-per-flonum)
-(rewrite 'sqrt 16 1 "C_a_i_sqrt" #t words-per-flonum)
-(rewrite 'atan 16 2 "C_a_i_atan2" #t words-per-flonum)
-
(rewrite 'zero? 5 "C_eqp" 0 'fixnum)
(rewrite 'zero? 2 1 "C_i_zerop" #t)
(rewrite 'zero? 2 1 "C_u_i_zerop" #f)
@@ -570,7 +560,6 @@
(rewrite 'vector-length 2 1 "C_i_vector_length" #t)
(rewrite '##sys#vector-length 2 1 "C_i_vector_length" #t)
(rewrite 'string-length 2 1 "C_i_string_length" #t)
-(rewrite 'inexact->exact 2 1 "C_i_inexact_to_exact" #t)
(rewrite '##sys#check-exact 2 1 "C_i_check_exact" #t)
(rewrite '##sys#check-number 2 1 "C_i_check_number" #t)
@@ -625,8 +614,6 @@
(rewrite 'lcm 18 1)
(rewrite 'list 18 '())
-(rewrite 'exact->inexact 16 1 "C_a_i_exact_to_inexact" #t 4) ; words-per-flonum
-
(rewrite '= 17 2 "C_i_nequalp")
(rewrite '> 17 2 "C_i_greaterp")
(rewrite '< 17 2 "C_i_lessp")
diff --git a/chicken.h b/chicken.h
index 00871212..1e7ce304 100644
--- a/chicken.h
+++ b/chicken.h
@@ -664,7 +664,6 @@ static inline int isinf_ld (long double x)
#define C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR 50
#define C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR 51
-
/* Platform information */
#if defined(C_BIG_ENDIAN)
# define C_MACHINE_BYTE_ORDER "big-endian"
@@ -1903,13 +1902,13 @@ C_fctexport void C_ccall C_u_integer_quotient(C_word c, C_word self, C_word k, C
C_fctexport void C_ccall C_basic_remainder(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
C_fctexport void C_ccall C_u_integer_remainder(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
C_fctexport void C_ccall C_basic_divrem(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
-void C_ccall C_u_integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
+C_fctexport void C_ccall C_u_integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
+C_fctexport void C_ccall C_u_flo_to_int(C_word c, C_word self, C_word k, C_word x) C_noret;
C_fctexport void C_ccall C_nequalp(C_word c, C_word closure, C_word k, ...) C_noret;
C_fctexport void C_ccall C_greaterp(C_word c, C_word closure, C_word k, ...) C_noret;
C_fctexport void C_ccall C_lessp(C_word c, C_word closure, C_word k, ...) C_noret;
C_fctexport void C_ccall C_greater_or_equal_p(C_word c, C_word closure, C_word k, ...) C_noret;
C_fctexport void C_ccall C_less_or_equal_p(C_word c, C_word closure, C_word k, ...) C_noret;
-C_fctexport void C_ccall C_expt(C_word c, C_word closure, C_word k, C_word n1, C_word n2) C_noret;
C_fctexport void C_ccall C_gc(C_word c, C_word closure, C_word k, ...) C_noret;
C_fctexport void C_ccall C_open_file_port(C_word c, C_word closure, C_word k, C_word port, C_word channel, C_word mode) C_noret;
C_fctexport void C_ccall C_allocate_vector(C_word c, C_word closure, C_word k, C_word size, C_word type, C_word init, C_word align8) C_noret;
@@ -2014,6 +2013,7 @@ C_fctexport C_word C_fcall C_i_memv(C_word x, C_word lst) C_regparm;
C_fctexport C_word C_fcall C_i_member(C_word x, C_word lst) C_regparm;
C_fctexport C_word C_fcall C_i_length(C_word lst) C_regparm;
C_fctexport C_word C_fcall C_u_i_length(C_word lst) C_regparm;
+/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport C_word C_fcall C_i_inexact_to_exact(C_word n) C_regparm;
C_fctexport C_word C_fcall C_i_check_closure_2(C_word x, C_word loc) C_regparm;
C_fctexport C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) C_regparm;
@@ -2090,9 +2090,11 @@ C_fctexport double C_fcall C_milliseconds(void) C_regparm;
C_fctexport double C_fcall C_cpu_milliseconds(void) C_regparm;
C_fctexport double C_fcall C_bignum_to_double(C_word bignum) C_regparm;
+
C_fctexport C_word C_fcall C_a_i_cpu_time(C_word **a, int c, C_word buf) C_regparm;
/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport C_word C_fcall C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix) C_regparm;
+/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport C_word C_fcall C_a_i_exact_to_inexact(C_word **a, int c, C_word n) C_regparm;
C_fctexport C_word C_fcall C_i_file_exists_p(C_word name, C_word file, C_word dir) C_regparm;
diff --git a/library.scm b/library.scm
index cdf65e04..347ec574 100644
--- a/library.scm
+++ b/library.scm
@@ -35,8 +35,8 @@
##sys#print-exit
##sys#format-here-doc-warning
exit-in-progress
- maximal-string-length
- make-complex ratnum rat+/-
+ maximal-string-length find-ratio-between find-ratio
+ make-complex flonum->ratnum ratnum rat+/- minimum-denorm-flonum-expt
+maximum-allowed-exponent+ mantexp->dbl ldexp round-quotient
##sys#string->compnum)
(not inline ##sys#user-read-hook ##sys#error-hook ##sys#signal-hook ##sys#schedule
@@ -316,10 +316,8 @@ EOF
(##sys#error-bad-integer x (and (pair? loc) (car loc))) ) )
(define (##sys#check-real x . loc)
- (unless (##core#inline "C_i_realp" x)
- (##sys#error-hook
- (foreign-value "C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR" int)
- (and (pair? loc) (car loc)) x) ) )
+ (unless (##core#inline "C_i_realp" x)
+ (##sys#error-bad-real x (and (pair? loc) (car loc))) ) )
(define (##sys#check-range i from to . loc)
(##sys#check-exact i loc)
@@ -448,6 +446,14 @@ EOF
(##sys#error-hook
(foreign-value "C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR" int) loc arg))
+(define (##sys#error-bad-inexact arg #!optional loc)
+ (##sys#error-hook
+ (foreign-value "C_CANT_REPRESENT_INEXACT_ERROR" int) loc arg))
+
+(define (##sys#error-bad-real arg #!optional loc)
+ (##sys#error-hook
+ (foreign-value "C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR" int) loc arg))
+
(define (##sys#error-bad-base arg #!optional loc)
(##sys#error-hook
(foreign-value "C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR" int) loc arg))
@@ -939,7 +945,6 @@ EOF
(define (inexact? x) (##core#inline "C_i_inexactp" x))
(define ##sys#exact? exact?)
(define ##sys#inexact? inexact?)
-(define expt (##core#primitive "C_expt"))
(define (##sys#fits-in-int? n) (##core#inline "C_fits_in_int_p" n))
(define (##sys#fits-in-unsigned-int? n) (##core#inline "C_fits_in_unsigned_int_p" n))
(define (##sys#flonum-in-fixnum-range? n) (##core#inline "C_flonum_in_fixnum_range_p" n))
@@ -985,7 +990,9 @@ EOF
(define (angle n)
(##sys#check-number n 'angle)
- (if (< n 0) (fp* 2.0 (acos 0.0)) 0.0) )
+ (##core#inline_allocate ("C_a_i_atan2" 4)
+ (exact->inexact (imag-part n))
+ (exact->inexact (real-part n))))
(define (magnitude x)
(cond ((cplxnum? x)
@@ -1063,9 +1070,93 @@ EOF
((< n 0) (if (##sys#exact? n) -1 -1.0))
(else (if (##sys#exact? n) 0 0.0) ) ) )
-;; hooks for numbers
-(define (exact->inexact n) (##core#inline_allocate ("C_a_i_exact_to_inexact" 4) n))
-(define (inexact->exact n) (##core#inline "C_i_inexact_to_exact" n))
+(define (flonum->ratnum x)
+ ;; Try to multiply by two until we reach an integer
+ (define (float-fraction-length x)
+ (do ((x x (fp* x 2.0))
+ (i 0 (fx+ i 1)))
+ ((##core#inline "C_u_i_fpintegerp" x) i)))
+
+ (define (deliver y d)
+ (let* ((q (##sys#integer-power 2 (float-fraction-length y)))
+ (scaled-y (##sys#*-2 y (exact->inexact q))))
+ (if (finite? scaled-y) ; Shouldn't this always be true?
+ (##sys#/-2 (##sys#/-2 ((##core#primitive "C_u_flo_to_int") scaled-y) q) d)
+ (##sys#error-bad-inexact x 'inexact->exact))))
+
+ (if (and (fp< x 1.0) ; Watch out for denormalized numbers
+ (fp> x -1.0)) ; XXX: Needs a test, it seems pointless
+ (deliver (##sys#*-2 x (expt 2.0 flonum-precision))
+ ;; Can be bignum (is on 32-bit), so must wait until after init.
+ ;; We shouldn't need to calculate this every single time, tho..
+ (##sys#integer-power 2 flonum-precision))
+ (deliver x 1)))
+
+(define (inexact->exact x)
+ (cond ((exact? x) x)
+ ((##core#inline "C_i_flonump" x)
+ (cond ((##core#inline "C_u_i_fpintegerp" x)
+ ((##core#primitive "C_u_flo_to_int") x))
+ ((##core#inline "C_u_i_flonum_finitep" x)
+ (flonum->ratnum x))
+ (else (##sys#error-bad-inexact x 'inexact->exact))))
+ ((cplxnum? x)
+ (make-complex (inexact->exact (%cplxnum-real x))
+ (inexact->exact (%cplxnum-imag x))))
+ (else (##sys#error-bad-number x 'inexact->exact))))
+
+;; Exponent of the lowest allowed flonum; if we get any lower we get zero.
+;; In other words, this is the first (smallest) flonum after 0.
+;; Equal to (expt 2.0 (- flonum-minimum-exponent flonum-precision))
+(define minimum-denorm-flonum-expt (fx- flonum-minimum-exponent flonum-precision))
+
+(define (exact->inexact x)
+ (cond ((##core#inline "C_fixnump" x)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) x))
+ ((##core#inline "C_i_flonump" x) x)
+ ((##core#inline "C_i_bignump" x)
+ (##core#inline_allocate ("C_a_u_i_big_to_flo" 4) x))
+ ((ratnum? x)
+ ;; This tries to keep the numbers within representable ranges
+ ;; and tries to drop as few significant digits as possible by
+ ;; bringing the two numbers to within the same powers of two.
+ ;; See algorithms M & N in Knuth, 4.2.1
+ (let* ((n1 (%ratnum-numerator x))
+ (an ((##core#primitive "C_u_integer_abs") n1))
+ (d1 (%ratnum-denominator x))
+ ;; Approximate distance between the numbers in powers
+ ;; of 2 ie, 2^e-1 < n/d < 2^e+1 (e is the *un*biased
+ ;; value of e_w in M2)
+ ;; XXX: What if b != 2 (ie, flonum-radix is not 2)?
+ (e (fx- (integer-length an) (integer-length d1)))
+ (rnd (lambda (n d e) ; Here, 1 <= n/d < 2 (normalized) [N5]
+ ;; Cannot shift above the available precision,
+ ;; and can't have an exponent that's below the
+ ;; minimum flonum exponent.
+ (let* ((s (min (fx- flonum-precision 1)
+ (fx- e minimum-denorm-flonum-expt)))
+ (normalized (##sys#/-2 (arithmetic-shift n s) d))
+ (r (round normalized))
+ (fraction (exact->inexact r))
+ (exp (fx- e s)))
+ (let ((res (fp* fraction (expt 2.0 exp))))
+ (if (negative? n1) (##sys#--2 0 res) res)))))
+ (scale (lambda (n d) ; Here, 1/2 <= n/d < 2 [N3]
+ (if (##sys#<-2 n d) ; n/d < 1?
+ ;; Scale left [N3]; only needed once (see note in M3)
+ (rnd (arithmetic-shift n 1) d (fx- e 1))
+ ;; Already normalized
+ (rnd n d e)))))
+ ;; After this step, which shifts the smaller number to
+ ;; align with the larger, "f" in algorithm N is represented
+ ;; in the procedures above by n/d.
+ (if (negative? e)
+ (scale (arithmetic-shift an (##sys#--2 0 e)) d1)
+ (scale an (arithmetic-shift d1 e)))))
+ ((cplxnum? x)
+ (make-complex (exact->inexact (%cplxnum-real x))
+ (exact->inexact (%cplxnum-imag x))))
+ (else (##sys#error-bad-number x 'exact->inexact))))
(define ##sys#exact->inexact exact->inexact)
(define ##sys#inexact->exact inexact->exact)
@@ -1147,8 +1238,8 @@ EOF
(%make-ratnum (##sys#integer-negate (%ratnum-numerator x))
(%ratnum-denominator x)))
((cplxnum? x)
- (%make-complex (##sys#negate (compnum-real x))
- (##sys#negate (compnum-imag x))))
+ (make-complex (##sys#negate (%cplxnum-real x))
+ (##sys#negate (%cplxnum-imag x))))
(else (##sys#error-bad-number x '-)) ) ) ; loc?
(define (##sys#extended-minus x y)
@@ -1289,28 +1380,66 @@ EOF
(else (##sys#error-bad-number y '/))) )
(define (floor x)
- (##sys#check-number x 'floor)
- (if (##core#inline "C_fixnump" x)
- x
- (fpfloor x) ) )
+ (cond ((exact-integer? x) x)
+ ((##core#inline "C_i_flonump" x) (fpfloor x))
+ ;; (floor x) = greatest integer <= x
+ ((ratnum? x) (let* ((n (%ratnum-numerator x))
+ (q (quotient n (%ratnum-denominator x))))
+ (if (##sys#>=-2 n 0) q (##sys#--2 q 1))))
+ (else (##sys#error-bad-real x 'floor))))
(define (ceiling x)
- (##sys#check-number x 'ceiling)
- (if (##core#inline "C_fixnump" x)
- x
- (fpceiling x) ) )
+ (cond ((exact-integer? x) x)
+ ((##core#inline "C_i_flonump" x) (fpceiling x))
+ ;; (ceiling x) = smallest integer >= x
+ ((ratnum? x) (let* ((n (%ratnum-numerator x))
+ (q (quotient n (%ratnum-denominator x))))
+ (if (##sys#>=-2 n 0) (##sys#+-2 q 1) q)))
+ (else (##sys#error-bad-real x 'ceiling))) )
(define (truncate x)
- (##sys#check-number x 'truncate)
- (if (##core#inline "C_fixnump" x)
- x
- (fptruncate x) ) )
+ (cond ((exact-integer? x) x)
+ ((##core#inline "C_i_flonump" x) (fptruncate x))
+ ;; (rational-truncate x) = integer of largest magnitude <= (abs x)
+ ((ratnum? x) (quotient (%ratnum-numerator x)
+ (%ratnum-denominator x)))
+ (else (##sys#error-bad-real x 'truncate))))
(define (round x)
- (##sys#check-number x 'round)
- (if (##core#inline "C_fixnump" x)
- x
- (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) x)))
+ (cond ((exact-integer? x) x)
+ ((##core#inline "C_i_flonump" x)
+ (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) x))
+ ((ratnum? x)
+ (let* ((x+1/2 (##sys#+-2 x (%make-ratnum 1 2)))
+ (r (floor x+1/2)))
+ (if (and (##sys#=-2 r x+1/2) (odd? r)) (##sys#--2 r 1) r)))
+ (else (##sys#error-bad-real x 'round))))
+
+(define (find-ratio-between x y)
+ (define (sr x y)
+ (let ((fx (inexact->exact (floor x)))
+ (fy (inexact->exact (floor y))))
+ (cond ((not (##sys#<-2 fx x)) (list fx 1))
+ ((##sys#=-2 fx fy)
+ (let ((rat (sr (##sys#/-2 1 (##sys#--2 y fy))
+ (##sys#/-2 1 (##sys#--2 x fx)))))
+ (list (##sys#+-2 (cadr rat) (##sys#*-2 fx (car rat)))
+ (car rat))))
+ (else (list (##sys#+-2 1 fx) 1)))))
+ (cond ((##sys#<-2 y x) (find-ratio-between y x))
+ ((not (##sys#<-2 x y)) (list x 1))
+ ((positive? x) (sr x y))
+ ((negative? y) (let ((rat (sr (##sys#--2 0 y) (##sys#--2 0 x))))
+ (list (##sys#--2 0 (car rat)) (cadr rat))))
+ (else '(0 1))))
+
+(define (find-ratio x e) (find-ratio-between (##sys#--2 x e) (##sys#+-2 x e)))
+
+(define (rationalize x e)
+ (let ((result (apply ##sys#/-2 (find-ratio x e))))
+ (if (or (inexact? x) (inexact? e))
+ (exact->inexact result)
+ result)))
(define quotient (##core#primitive "C_basic_quotient"))
(define ##sys#integer-quotient (##core#primitive "C_u_integer_quotient"))
@@ -1361,34 +1490,113 @@ EOF
(##sys#slot xs 1)) ) ) ) )
(define (exp n)
- (##core#inline_allocate ("C_a_i_exp" 4) n) )
-
-(define (log n)
- (##core#inline_allocate ("C_a_i_log" 4) n) )
+ (##sys#check-number n 'exp)
+ (if (cplxnum? n)
+ (##sys#*-2 (##core#inline_allocate ("C_a_i_exp" 4)
+ (exact->inexact (%cplxnum-real n)))
+ (let ((p (%cplxnum-imag n)))
+ (make-complex
+ (##core#inline_allocate
+ ("C_a_i_cos" 4) (exact->inexact p))
+ (##core#inline_allocate
+ ("C_a_i_sin" 4) (exact->inexact p)) ) ) )
+ (##core#inline_allocate ("C_a_i_flonum_exp" 4) (exact->inexact n))))
+
+(define (##sys#log-1 x) ; log_e(x)
+ (cond
+ ((eq? x 0) ; Exact zero? That's undefined
+ (##sys#signal-hook #:arithmetic-error 'log "log of exact 0 is undefined" x))
+ ;; avoid calling inexact->exact on X here (to avoid overflow?)
+ ((or (cplxnum? x) (negative? x)) ; General case
+ (##sys#+-2 (##sys#log-1 (magnitude x))
+ (##sys#*-2 (make-complex 0 1) (angle x))))
+ (else ; Real number case (< already ensured the argument type is a number)
+ (##core#inline_allocate ("C_a_i_log" 4) (exact->inexact x)))))
+
+(define (log a #!optional b)
+ (if b (##sys#/-2 (##sys#log-1 a) (##sys#log-1 b)) (##sys#log-1 a)))
+
+;; OBSOLETE: These can be removed after integration into core and
+;; bootstrapping, when the compiler can write these objects natively.
+(define %i (make-complex 0 1))
+(define %-i (make-complex 0 -1))
+(define %i2 (make-complex 0 2))
(define (sin n)
- (##core#inline_allocate ("C_a_i_sin" 4) n) )
+ (##sys#check-number n 'sin)
+ (if (cplxnum? n)
+ (let ((in (##sys#*-2 %i n)))
+ (##sys#/-2 (##sys#--2 (exp in) (exp (##sys#--2 0 in))) %i2))
+ (##core#inline_allocate ("C_a_i_sin" 4) (exact->inexact n))))
(define (cos n)
- (##core#inline_allocate ("C_a_i_cos" 4) n) )
+ (##sys#check-number n 'cos)
+ (if (cplxnum? n)
+ (let ((in (##sys#*-2 %i n)))
+ (##sys#/-2 (##sys#+-2 (exp in) (exp (##sys#--2 0 in))) 2) )
+ (##core#inline_allocate ("C_a_i_cos" 4) (exact->inexact n))))
(define (tan n)
- (##core#inline_allocate ("C_a_i_tan" 4) n) )
+ (##sys#check-number n 'tan)
+ (if (cplxnum? n)
+ (##sys#/-2 (sin n) (cos n))
+ (##core#inline_allocate ("C_a_i_tan" 4) (exact->inexact n))))
+;; General case: sin^{-1}(z) = -i\ln(iz + \sqrt{1-z^2})
(define (asin n)
- (##core#inline_allocate ("C_a_i_asin" 4) n) )
-
-(define (acos n)
- (##core#inline_allocate ("C_a_i_acos" 4) n) )
-
-(define (sqrt n)
- (##core#inline_allocate ("C_a_i_sqrt" 4) n) )
-
-(define (atan n1 . n2)
- (if (null? n2)
- (##core#inline_allocate ("C_a_i_atan" 4) n1)
- (let ([n2 (car n2)])
- (##core#inline_allocate ("C_a_i_atan2" 4) n1 n2) ) ) )
+ (##sys#check-number n 'asin)
+ (cond ((and (##core#inline "C_i_flonump" n) (fp>= n -1.0) (fp<= n 1.0))
+ (##core#inline_allocate ("C_a_i_asin" 4) n))
+ ((and (##core#inline "C_fixnump" n) (fx>= n -1) (fx<= n 1))
+ (##core#inline_allocate ("C_a_i_asin" 4)
+ (##core#inline_allocate
+ ("C_a_i_fix_to_flo" 4) n)))
+ ;; General definition can return compnums
+ (else (##sys#*-2 %-i
+ (##sys#log-1
+ (##sys#+-2 (##sys#*-2 %i n)
+ (##sys#sqrt/loc
+ 'asin (##sys#--2 1 (##sys#*-2 n n)))))))))
+
+;; General case:
+;; cos^{-1}(z) = 1/2\pi + i\ln(iz + \sqrt{1-z^2}) = 1/2\pi - sin^{-1}(z) = sin(1) - sin(z)
+(define acos
+ (let ((asin1 (##core#inline_allocate ("C_a_i_asin" 4) 1)))
+ (lambda (n)
+ (##sys#check-number n 'acos)
+ (cond ((and (##core#inline "C_i_flonump" n) (fp>= n -1.0) (fp<= n 1.0))
+ (##core#inline_allocate ("C_a_i_acos" 4) n))
+ ((and (##core#inline "C_fixnump" n) (fx>= n -1) (fx<= n 1))
+ (##core#inline_allocate ("C_a_i_acos" 4)
+ (##core#inline_allocate
+ ("C_a_i_fix_to_flo" 4) n)))
+ ;; General definition can return compnums
+ (else (##sys#--2 asin1 (asin n)))))))
+
+(define (atan n #!optional b)
+ (##sys#check-number n 'atan)
+ (cond ((cplxnum? n)
+ (if b
+ (##sys#error-bad-real n 'atan)
+ (let ((in (##sys#*-2 %i n)))
+ (##sys#/-2 (##sys#--2 (##sys#log-1 (##sys#+-2 1 in))
+ (##sys#log-1 (##sys#--2 1 in))) %i2))))
+ (b
+ (##core#inline_allocate
+ ("C_a_i_atan2" 4) (exact->inexact n) (exact->inexact b)))
+ (else
+ (##core#inline_allocate
+ ("C_a_i_atan" 4) (exact->inexact n)))))
+
+;; TODO: replace this with an actual sqrt implementation
+(define (##sys#sqrt/loc loc x)
+ (##core#inline_allocate ("C_a_i_sqrt" 4) n))
+
+(define (sqrt x) (##sys#sqrt/loc 'sqrt x))
+
+;; TODO: unimplemented
+(define (##sys#exact-integer-nth-root/loc loc k n)
+ (error "not yet implemented"))
(define (##sys#integer-power base e)
(define (square x) (##sys#*-2 x x))
@@ -1402,6 +1610,55 @@ EOF
(else
(lp (##sys#*-2 res base) (##sys#--2 e2 1)))))))
+(define (expt a b)
+ (define (log-expt a b)
+ (exp (##sys#*-2 b (##sys#log-1 a))))
+ (define (slow-expt a b)
+ (if (eq? 0 a)
+ (##sys#signal-hook
+ #:arithmetic-error 'expt
+ "exponent of exact 0 with complex argument is undefined" a b)
+ (exp (##sys#*-2 b (##sys#log-1 a)))))
+ (cond ((not (number? a)) (##sys#error-bad-number a 'expt))
+ ((not (number? b)) (##sys#error-bad-number b 'expt))
+ ((and (ratnum? a) (not (inexact? b)))
+ ;; (n*d)^b = n^b * d^b = n^b * x^{-b} | x = 1/b
+ ;; Hopefully faster than integer-power
+ (##sys#*-2 (expt (%ratnum-numerator a) b)
+ (expt (%ratnum-denominator a) (##sys#negate b))))
+ ((ratnum? b)
+ ;; x^{a/b} = (x^{1/b})^a
+ (cond
+ ((exact-integer? a)
+ (if (negative? a)
+ (log-expt (exact->inexact a) (exact->inexact b))
+ (receive (ds^n r)
+ (##sys#exact-integer-nth-root/loc
+ 'expt a (%ratnum-denominator b))
+ (if (eq? r 0)
+ (##sys#integer-power ds^n (%ratnum-numerator b))
+ (##core#inline_allocate ("C_a_i_flonum_expt" 4)
+ (exact->inexact a)
+ (exact->inexact b))))))
+ ((##core#inline "C_i_flonump" a)
+ (log-expt a (exact->inexact b)))
+ (else (slow-expt a b))))
+ ((or (cplxnum? b) (and (cplxnum? a) (not (integer? b))))
+ (slow-expt a b))
+ ((and (##core#inline "C_i_flonump" b)
+ (not (##core#inline "C_u_i_fpintegerp" b)))
+ (if (negative? a)
+ (log-expt (exact->inexact a) (exact->inexact b))
+ (##core#inline_allocate
+ ("C_a_i_flonum_expt" 4) (exact->inexact a) b)))
+ ((##core#inline "C_i_flonump" a)
+ (##core#inline_allocate ("C_a_i_flonum_expt" 4) a (exact->inexact b)))
+ ;; this doesn't work that well, yet...
+ ;; (XXX: What does this mean? why not? I do know this is ugly... :P)
+ (else (if (or (inexact? a) (inexact? b))
+ (exact->inexact (##sys#integer-power a (inexact->exact b)))
+ (##sys#integer-power a b)))) )
+
(define (##sys#integer-gcd a b)
;; Currently this is only Euclidean GCD algorithm. TODO: Restore
;; Lehmer's algorithm when everything else has been implemented.
@@ -1444,7 +1701,7 @@ EOF
(##sys#slot next 1)) ) ) ) ) )
(define (##sys#lcm x y)
- (quotient (* x y) (##sys#internal-gcd 'lcm x y)) )
+ (abs (quotient (* x y) (##sys#internal-gcd 'lcm x y)) ))
(define (lcm . ns)
(if (null? ns)
diff --git a/manual/Deviations from the standard b/manual/Deviations from the standard
index 59570e4e..65dd11c6 100644
--- a/manual/Deviations from the standard
+++ b/manual/Deviations from the standard
@@ -15,20 +15,12 @@ is 120. This is an implementation restriction that is unlikely
to be lifted.
-=== {{numerator}}, {{denominator}} and {{rationalize}}
-
-The {{numerator}} and {{denominator}} procedures cannot be
-applied to inexact numbers, and the procedure {{rationalize}} is not
-implemented at all.
-
-
=== Numeric string-conversion considerations
-The runtime system uses the numerical string-conversion
-routines of the underlying C library and so does only understand
-standard (C-library) syntax for floating-point constants. Consequently,
-the procedures {{string->number}}, {{read}}, {{write}}, and {{display}} do not obey
-read/write invariance to inexact numbers.
+In some cases the runtime system uses the numerical string-conversion
+routines of the underlying C library. Consequently, the procedures
+{{string->number}}, {{read}}, {{write}}, and {{display}} do not obey
+read/write invariance for inexact numbers.
=== Environments and non-standard syntax
diff --git a/modules.scm b/modules.scm
index a9ee89f0..bf259a71 100644
--- a/modules.scm
+++ b/modules.scm
@@ -875,8 +875,9 @@
member assq assv assoc symbol? symbol->string string->symbol number?
integer? exact? real? complex? inexact? rational? zero? odd? even?
positive? negative? max min + - * / = > < >= <= quotient remainder
- modulo gcd lcm abs floor ceiling truncate round exact->inexact
- inexact->exact exp log expt sqrt sin cos tan asin acos atan
+ modulo gcd lcm abs floor ceiling truncate round rationalize
+ exact->inexact inexact->exact exp log expt sqrt
+ sin cos tan asin acos atan
number->string string->number char? char=? char>? char<? char>=?
char<=? char-ci=? char-ci<? char-ci>? char-ci>=? char-ci<=?
char-alphabetic? char-whitespace? char-numeric? char-upper-case?
diff --git a/runtime.c b/runtime.c
index 0908c894..154e26cf 100644
--- a/runtime.c
+++ b/runtime.c
@@ -527,6 +527,7 @@ static C_regparm void bignum_divrem(C_word c, C_word self, C_word k, C_word x, C
static void divrem_intflo_2(C_word c, C_word self, ...) C_noret;
static void bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big) C_noret;
static C_word rat_cmp(C_word x, C_word y);
+static void flo_to_int_2(C_word c, C_word self, C_word result) C_noret;
static void fabs_frexp_to_digits(C_uword exp, double sign, C_uword *start, C_uword *scan);
static C_word flo_to_tmp_bignum(C_word x);
static C_word int_flo_cmp(C_word intnum, C_word flonum);
@@ -542,6 +543,7 @@ static C_word C_fcall convert_string_to_number(C_char *str, int radix, C_word *f
static void digits_to_integer_2(C_word c, C_word self, C_word result) C_noret;
static C_regparm C_word str_to_bignum(C_word bignum, char *str, char *str_end, int radix);
static void bignum_to_str_2(C_word c, C_word self, C_word string) C_noret;
+/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
static C_word C_fcall maybe_inexact_to_exact(C_word n) C_regparm;
static void C_fcall remark_system_globals(void) C_regparm;
static void C_fcall really_remark(C_word *x) C_regparm;
@@ -836,7 +838,7 @@ static C_PTABLE_ENTRY *create_initial_ptable()
{
/* IMPORTANT: hardcoded table size -
this must match the number of C_pte calls + 1 (NULL terminator)! */
- C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 74);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 73);
int i = 0;
if(pt == NULL)
@@ -875,7 +877,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_greater_or_equal_p);
C_pte(C_less_or_equal_p);
C_pte(C_quotient);
- C_pte(C_expt);
C_pte(C_number_to_string);
C_pte(C_make_symbol);
C_pte(C_string_to_symbol);
@@ -5382,6 +5383,7 @@ C_regparm C_word C_fcall C_u_i_length(C_word lst)
return C_fix(n);
}
+/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_regparm C_word maybe_inexact_to_exact(C_word n)
{
double m;
@@ -5396,6 +5398,7 @@ C_regparm C_word maybe_inexact_to_exact(C_word n)
return C_SCHEME_FALSE;
}
+/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_regparm C_word C_fcall C_i_inexact_to_exact(C_word n)
{
C_word r;
@@ -7848,6 +7851,41 @@ C_regparm double C_fcall C_bignum_to_double(C_word bignum)
return(C_bignum_negativep(bignum) ? -accumulator : accumulator);
}
+void C_ccall C_u_flo_to_int(C_word c, C_word self, C_word k, C_word x)
+{
+ int exponent;
+ double significand = frexp(C_flonum_magnitude(x), &exponent);
+
+ assert(C_truep(C_u_i_fpintegerp(x)));
+
+ if (exponent <= 0) {
+ C_kontinue(k, C_fix(0));
+ } else if (exponent == 1) { /* TODO: check significand * 2^exp fits fixnum? */
+ C_kontinue(k, significand < 0.0 ? C_fix(-1) : C_fix(1));
+ } else {
+ C_word kab[C_SIZEOF_CLOSURE(4) + C_SIZEOF_FLONUM], *ka = kab, k2, size,
+ negp = C_mk_bool(C_flonum_magnitude(x) < 0.0),
+ sign = C_flonum(&ka, fabs(significand));
+
+ k2 = C_closure(&ka, 4, (C_word)flo_to_int_2, k, C_fix(exponent), sign);
+
+ size = C_fix(C_BIGNUM_BITS_TO_DIGITS(exponent));
+ C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
+ }
+}
+
+static void flo_to_int_2(C_word c, C_word self, C_word result)
+{
+ C_word k = C_block_item(self, 1);
+ C_uword exponent = C_unfix(C_block_item(self, 2)),
+ *start = C_bignum_digits(result),
+ *scan = start + C_bignum_size(result);
+ double significand = C_flonum_magnitude(C_block_item(self, 3));
+
+ fabs_frexp_to_digits(exponent, significand, start, scan);
+ C_kontinue(k, C_bignum_simplify(result));
+}
+
static void
fabs_frexp_to_digits(C_uword exp, double sign, C_uword *start, C_uword *scan)
{
@@ -8440,34 +8478,6 @@ C_regparm C_word C_fcall C_i_integer_less_or_equalp(C_word x, C_word y)
}
}
-void C_ccall C_expt(C_word c, C_word closure, C_word k, C_word n1, C_word n2)
-{
- double m1, m2;
- C_word r;
- C_alloc_flonum;
-
- if(c != 4) C_bad_argc(c, 4);
-
- if(n1 & C_FIXNUM_BIT) m1 = C_unfix(n1);
- else if(!C_immediatep(n1) && C_block_header(n1) == C_FLONUM_TAG)
- m1 = C_flonum_magnitude(n1);
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "expt", n1);
-
- if(n2 & C_FIXNUM_BIT) m2 = C_unfix(n2);
- else if(!C_immediatep(n2) && C_block_header(n2) == C_FLONUM_TAG)
- m2 = C_flonum_magnitude(n2);
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "expt", n2);
-
- m1 = pow(m1, m2);
- r = (C_word)m1;
-
- if(r == m1 && (n1 & C_FIXNUM_BIT) && (n2 & C_FIXNUM_BIT) && modf(m1, &m2) == 0.0 && C_fitsinfixnump(r))
- C_kontinue(k, C_fix(r));
-
- C_kontinue_flonum(k, m1);
-}
-
-
void C_ccall C_gc(C_word c, C_word closure, C_word k, ...)
{
int f;
@@ -9055,6 +9065,7 @@ void C_ccall C_string_to_symbol(C_word c, C_word closure, C_word k, C_word strin
}
+/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_regparm C_word C_fcall
C_a_i_exact_to_inexact(C_word **a, int c, C_word n)
{
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 523cc163..f5dfdaeb 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -103,12 +103,12 @@
;;; A few denormalised numbers, cribbed from NetBSD ATF tests for ldexp():
;; On some machines/OSes these tests fail due to missing hardware support
;; and sometimes due to broken libc/libm support, so we have disabled them.
-(assert (equal? 1.0 (numerator 1.1125369292536006915451e-308)))
-(assert (equal? +inf.0 (denominator 1.1125369292536006915451e-308)))
-(assert (equal? -1.0 (numerator -5.5626846462680034577256e-309)))
-(assert (equal? +inf.0 (denominator -5.5626846462680034577256e-309)))
-(assert (equal? 1.0 (numerator 4.9406564584124654417657e-324)))
-(assert (equal? +inf.0 (denominator 4.9406564584124654417657e-324)))
+;(assert (equal? 1.0 (numerator 1.1125369292536006915451e-308)))
+;(assert (equal? +inf.0 (denominator 1.1125369292536006915451e-308)))
+;(assert (equal? -1.0 (numerator -5.5626846462680034577256e-309)))
+;(assert (equal? +inf.0 (denominator -5.5626846462680034577256e-309)))
+;(assert (equal? 1.0 (numerator 4.9406564584124654417657e-324)))
+;(assert (equal? +inf.0 (denominator 4.9406564584124654417657e-324)))
(assert (equal? 4.0 (denominator -1.25)))
(assert (equal? 1e10 (numerator 1e10)))
diff --git a/types.db b/types.db
index 5d08a3c7..ab1575c7 100644
--- a/types.db
+++ b/types.db
@@ -500,79 +500,86 @@
((float) (float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1)))
((integer) (integer) (##sys#integer-abs #(1))))
-(floor (#(procedure #:clean #:enforce #:foldable) floor (number) number)
+(floor (#(procedure #:clean #:enforce #:foldable) floor ((or integer ratnum float)) (or integer ratnum float))
((fixnum) (fixnum) #(1))
+ ((integer) (integer) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1))))
-(ceiling (#(procedure #:clean #:enforce #:foldable) ceiling (number) number)
+(ceiling (#(procedure #:clean #:enforce #:foldable) ceiling ((or integer ratnum float)) (or integer ratnum float))
((fixnum) (fixnum) #(1))
+ ((integer) (integer) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
-(truncate (#(procedure #:clean #:enforce #:foldable) truncate (number) number)
+(truncate (#(procedure #:clean #:enforce #:foldable) truncate ((or integer ratnum float)) (or integer ratnum float))
((fixnum) (fixnum) #(1))
+ ((integer) (integer) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
-(round (#(procedure #:clean #:enforce #:foldable) round (number) number)
+(round (#(procedure #:clean #:enforce #:foldable) round ((or integer ratnum float)) (or integer ratnum float))
((fixnum) (fixnum) #(1))
+ ((integer) (integer) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_round_proper" 4) #(1))))
-(exact->inexact (#(procedure #:clean #:enforce #:foldable) exact->inexact (number) float)
- ((float) #(1))
- ((fixnum) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
+(exact->inexact (#(procedure #:clean #:enforce #:foldable) exact->inexact (number) (or float cplxnum))
+ ((float) (float) #(1))
+ ((fixnum) (float) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
-(inexact->exact (#(procedure #:clean #:enforce #:foldable) inexact->exact (number) fixnum) ((fixnum) #(1)))
+(inexact->exact (#(procedure #:clean #:enforce #:foldable) inexact->exact (number) (or integer ratnum))
+ ((fixnum) (fixnum) #(1))
+ ((integer) (integer) #(1))
+ ((ratnum) (ratnum) #(1))
+ (((or integer ratnum)) #(1)))
-(exp (#(procedure #:clean #:enforce #:foldable) exp (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1))))
+(exp (#(procedure #:clean #:enforce #:foldable) exp (number) (or float cplxnum))
+ ((float) (float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1))))
-(log (#(procedure #:clean #:enforce #:foldable) log (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1))))
+(log (#(procedure #:clean #:enforce #:foldable) log (number) (or float cplxnum))
+ ;; Unfortunately this doesn't work when the argument is negative
+ ;;((float) (float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1)))
+ ((number) (##sys#log-1 #(1))))
(expt (#(procedure #:clean #:enforce #:foldable) expt (number number) number)
- ((float float) (float)
- (##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2)))
- ((float fixnum) (float)
+ ;; This breaks in some extreme edge cases... Worth disabling?
+ #;((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2)))
+ #;((float fixnum) (float)
(##core#inline_allocate ("C_a_i_flonum_expt" 4)
#(1)
(##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
- ((fixnum float) (float)
+ #;((fixnum float) (float)
(##core#inline_allocate ("C_a_i_flonum_expt" 4)
(##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
#(2))))
-(sqrt (#(procedure #:clean #:enforce #:foldable) sqrt (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1))))
+(sqrt (#(procedure #:clean #:enforce #:foldable) sqrt (number) number)
+ ;; Unfortunately this doesn't work when the argument is negative
+ #;((float) (float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1))))
-(sin (#(procedure #:clean #:enforce #:foldable) sin (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1))))
+(sin (#(procedure #:clean #:enforce #:foldable) sin (number) (or float cplxnum))
+ ((float) (float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1))))
-(cos (#(procedure #:clean #:enforce #:foldable) cos (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1))))
+(cos (#(procedure #:clean #:enforce #:foldable) cos (number) (or float cplxnum))
+ ((float) (float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1))))
-(tan (#(procedure #:clean #:enforce #:foldable) tan (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1))))
+(tan (#(procedure #:clean #:enforce #:foldable) tan (number) (or float cplxnum))
+ ((float) (float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1))))
-(asin (#(procedure #:clean #:enforce #:foldable) asin (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1))))
+(asin (#(procedure #:clean #:enforce #:foldable) asin (number) (or float cplxnum))
+ ;; Unfortunately this doesn't work when the number is > 1.0 (returns compnum)
+ #;((float) (float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
-(acos (#(procedure #:clean #:enforce #:foldable) acos (number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
+(acos (#(procedure #:clean #:enforce #:foldable) acos (number) (or float cplxnum))
+ ;; Unfortunately this doesn't work when the number is > 1.0 (returns compnum)
+ #;((float) (float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
-(atan (#(procedure #:clean #:enforce #:foldable) atan (number #!optional number) float)
- ((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1)))
- ((float fixnum)
- (##core#inline_allocate ("C_a_i_flonum_atan2" 4)
- #(1)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
- ((fixnum float)
- (##core#inline_allocate ("C_a_i_flonum_atan2" 4)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
- #(2)))
- ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
+(atan (#(procedure #:clean #:enforce #:foldable) atan (number #!optional number) (or float cplxnum))
+ ((float) (float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
(number->string (#(procedure #:clean #:enforce) number->string (number #!optional fixnum) string)
((fixnum fixnum) (##sys#fixnum->string #(1) #(2)))
@@ -789,6 +796,17 @@
((float) (float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1)))
(((or fixnum float bignum ratnum)) (abs #(1))))
+(angle (#(procedure #:clean #:enforce #:foldable) angle (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) '0.0 #(1)))
+ ((fixnum) (##core#inline_allocate
+ ("C_a_i_flonum_atan2" 4)
+ '0.0
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
+ ((cplxnum) (##core#inline_allocate
+ ("C_a_i_flonum_atan2" 4)
+ (##sys#exact->inexact (##sys#slot #(1) '2))
+ (##sys#exact->inexact (##sys#slot #(1) '1)))))
+
(numerator (#(procedure #:clean #:enforce #:foldable) numerator ((or float integer ratnum)) (or float integer))
((fixnum) (fixnum) #(1))
((bignum) (bignum) #(1))
Trap