~ chicken-core (chicken-5) b792fc2a869a838009b2d4500cfbfc4faad01342
commit b792fc2a869a838009b2d4500cfbfc4faad01342
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Jan 22 08:17:16 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move flonum procedures to new chicken.flonum module
diff --git a/c-backend.scm b/c-backend.scm
index 9635b97e..eb93f46e 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -44,6 +44,7 @@
chicken.compiler.core
chicken.compiler.c-platform
chicken.compiler.support
+ chicken.flonum
chicken.foreign
chicken.internal)
diff --git a/c-platform.scm b/c-platform.scm
index bf025ab0..be17ca7c 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -137,17 +137,21 @@
list-ref abs char-ready? peek-char list->string string->list
current-input-port current-output-port) )
+(define-constant flonum-bindings
+ (map (lambda (x) (symbol-append 'chicken.flonum# x))
+ '(fp/? fp+ fp- fp* fp/ fp> fp< fp= fp>= fp<= fpmin fpmax fpneg fpgcd
+ fpfloor fpceiling fptruncate fpround fpsin fpcos fptan fpasin fpacos
+ fpatan fpatan2 fpexp fpexpt fplog fpsqrt fpabs fpinteger?)))
+
(set! default-extended-bindings
- '(bignum? cplxnum? ratnum? chicken.bitwise#integer-length
+ `(bignum? cplxnum? ratnum? ,@flonum-bindings
+ chicken.bitwise#integer-length
chicken.bitwise#bitwise-and chicken.bitwise#bitwise-not
chicken.bitwise#bitwise-ior chicken.bitwise#bitwise-xor
chicken.bitwise#arithmetic-shift chicken.bitwise#bit-set?
- add1 sub1 fx+ fx- fx* fx/ fxgcd fx+? fx-? fx*? fx/? fxmod fxrem fp/?
+ add1 sub1 fx+ fx- fx* fx/ fxgcd fx+? fx-? fx*? fx/? fxmod fxrem
fx= fx> fx< fx>= fx<= fixnum? fxneg fxmax fxmin fxlen fxand fxnot fxior
- fxxor fxshr fxshl fxodd? fxeven? fp+ fp- fp* fp/ fpmin fpmax fpneg
- fpgcd fp> fp< fp= fp>= fp<= fpfloor fpceiling fptruncate fpround fpsin
- fpcos fptan fpasin fpacos fpatan fpatan2 fpexp fpexpt fplog fpsqrt fpabs
- fpinteger? exact-integer? flonum? nan? finite? infinite?
+ fxxor fxshr fxshl fxodd? fxeven? exact-integer? flonum? nan? finite? infinite?
void flush-output print print* error call/cc blob-size
identity blob=? equal=? make-polar make-rectangular real-part imag-part
string->symbol symbol-append foldl foldr setter
@@ -487,7 +491,7 @@
(rewrite 'nan? 2 1 "C_i_nanp" #f)
(rewrite 'finite? 2 1 "C_i_finitep" #f)
(rewrite 'infinite? 2 1 "C_i_infinitep" #f)
-(rewrite 'fpinteger? 2 1 "C_u_i_fpintegerp" #f)
+(rewrite 'chicken.flonum#fpinteger? 2 1 "C_u_i_fpintegerp" #f)
(rewrite '##sys#pointer? 2 1 "C_anypointerp" #t)
(rewrite 'pointer? 2 1 "C_i_safe_pointerp" #t)
(rewrite '##sys#generic-structure? 2 1 "C_structurep" #t)
@@ -528,15 +532,15 @@
(rewrite 'fx< 2 2 "C_fixnum_lessp" #t)
(rewrite 'fx>= 2 2 "C_fixnum_greater_or_equal_p" #t)
(rewrite 'fx<= 2 2 "C_fixnum_less_or_equal_p" #t)
-(rewrite 'fp= 2 2 "C_flonum_equalp" #f)
-(rewrite 'fp> 2 2 "C_flonum_greaterp" #f)
-(rewrite 'fp< 2 2 "C_flonum_lessp" #f)
-(rewrite 'fp>= 2 2 "C_flonum_greater_or_equal_p" #f)
-(rewrite 'fp<= 2 2 "C_flonum_less_or_equal_p" #f)
+(rewrite 'chicken.flonum#fp= 2 2 "C_flonum_equalp" #f)
+(rewrite 'chicken.flonum#fp> 2 2 "C_flonum_greaterp" #f)
+(rewrite 'chicken.flonum#fp< 2 2 "C_flonum_lessp" #f)
+(rewrite 'chicken.flonum#fp>= 2 2 "C_flonum_greater_or_equal_p" #f)
+(rewrite 'chicken.flonum#fp<= 2 2 "C_flonum_less_or_equal_p" #f)
(rewrite 'fxmax 2 2 "C_i_fixnum_max" #t)
(rewrite 'fxmin 2 2 "C_i_fixnum_min" #t)
-(rewrite 'fpmax 2 2 "C_i_flonum_max" #f)
-(rewrite 'fpmin 2 2 "C_i_flonum_min" #f)
+(rewrite 'chicken.flonum#fpmax 2 2 "C_i_flonum_max" #f)
+(rewrite 'chicken.flonum#fpmin 2 2 "C_i_flonum_min" #f)
(rewrite 'fxgcd 2 2 "C_i_fixnum_gcd" #t)
(rewrite 'fxlen 2 1 "C_i_fixnum_length" #t)
(rewrite 'char-numeric? 2 1 "C_u_i_char_numericp" #t)
@@ -574,13 +578,13 @@
(rewrite 'chicken.bitwise#bitwise-not 22 1 "C_s_a_i_bitwise_not" #t 6 "C_fixnum_not")
-(rewrite 'fp+ 16 2 "C_a_i_flonum_plus" #f words-per-flonum)
-(rewrite 'fp- 16 2 "C_a_i_flonum_difference" #f words-per-flonum)
-(rewrite 'fp* 16 2 "C_a_i_flonum_times" #f words-per-flonum)
-(rewrite 'fp/ 16 2 "C_a_i_flonum_quotient" #f words-per-flonum)
-(rewrite 'fp/? 16 2 "C_a_i_flonum_quotient_checked" #f words-per-flonum)
-(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 'chicken.flonum#fp+ 16 2 "C_a_i_flonum_plus" #f words-per-flonum)
+(rewrite 'chicken.flonum#fp- 16 2 "C_a_i_flonum_difference" #f words-per-flonum)
+(rewrite 'chicken.flonum#fp* 16 2 "C_a_i_flonum_times" #f words-per-flonum)
+(rewrite 'chicken.flonum#fp/ 16 2 "C_a_i_flonum_quotient" #f words-per-flonum)
+(rewrite 'chicken.flonum#fp/? 16 2 "C_a_i_flonum_quotient_checked" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpneg 16 1 "C_a_i_flonum_negate" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpgcd 16 2 "C_a_i_flonum_gcd" #f words-per-flonum)
(rewrite 'zero? 5 "C_eqp" 0 'fixnum)
(rewrite 'zero? 2 1 "C_i_zerop" #t)
@@ -700,26 +704,26 @@
(rewrite 'fxodd? 2 1 "C_i_fixnumoddp" #t)
(rewrite 'fxeven? 2 1 "C_i_fixnumevenp" #t)
-(rewrite 'floor 15 'flonum 'fixnum 'fpfloor #f)
-(rewrite 'ceiling 15 'flonum 'fixnum 'fpceiling #f)
-(rewrite 'truncate 15 'flonum 'fixnum 'fptruncate #f)
-
-(rewrite 'fpsin 16 1 "C_a_i_flonum_sin" #f words-per-flonum)
-(rewrite 'fpcos 16 1 "C_a_i_flonum_cos" #f words-per-flonum)
-(rewrite 'fptan 16 1 "C_a_i_flonum_tan" #f words-per-flonum)
-(rewrite 'fpasin 16 1 "C_a_i_flonum_asin" #f words-per-flonum)
-(rewrite 'fpacos 16 1 "C_a_i_flonum_acos" #f words-per-flonum)
-(rewrite 'fpatan 16 1 "C_a_i_flonum_atan" #f words-per-flonum)
-(rewrite 'fpatan2 16 2 "C_a_i_flonum_atan2" #f words-per-flonum)
-(rewrite 'fpexp 16 1 "C_a_i_flonum_exp" #f words-per-flonum)
-(rewrite 'fpexpt 16 2 "C_a_i_flonum_expt" #f words-per-flonum)
-(rewrite 'fplog 16 1 "C_a_i_flonum_log" #f words-per-flonum)
-(rewrite 'fpsqrt 16 1 "C_a_i_flonum_sqrt" #f words-per-flonum)
-(rewrite 'fpabs 16 1 "C_a_i_flonum_abs" #f words-per-flonum)
-(rewrite 'fptruncate 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
-(rewrite 'fpround 16 1 "C_a_i_flonum_round" #f words-per-flonum)
-(rewrite 'fpceiling 16 1 "C_a_i_flonum_ceiling" #f words-per-flonum)
-(rewrite 'fpround 16 1 "C_a_i_flonum_floor" #f words-per-flonum)
+(rewrite 'floor 15 'flonum 'fixnum 'chicken.flonum#fpfloor #f)
+(rewrite 'ceiling 15 'flonum 'fixnum 'chicken.flonum#fpceiling #f)
+(rewrite 'truncate 15 'flonum 'fixnum 'chicken.flonum#fptruncate #f)
+
+(rewrite 'chicken.flonum#fpsin 16 1 "C_a_i_flonum_sin" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpcos 16 1 "C_a_i_flonum_cos" #f words-per-flonum)
+(rewrite 'chicken.flonum#fptan 16 1 "C_a_i_flonum_tan" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpasin 16 1 "C_a_i_flonum_asin" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpacos 16 1 "C_a_i_flonum_acos" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpatan 16 1 "C_a_i_flonum_atan" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpatan2 16 2 "C_a_i_flonum_atan2" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpexp 16 1 "C_a_i_flonum_exp" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpexpt 16 2 "C_a_i_flonum_expt" #f words-per-flonum)
+(rewrite 'chicken.flonum#fplog 16 1 "C_a_i_flonum_log" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpsqrt 16 1 "C_a_i_flonum_sqrt" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpabs 16 1 "C_a_i_flonum_abs" #f words-per-flonum)
+(rewrite 'chicken.flonum#fptruncate 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpround 16 1 "C_a_i_flonum_round" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpceiling 16 1 "C_a_i_flonum_ceiling" #f words-per-flonum)
+(rewrite 'chicken.flonum#fpround 16 1 "C_a_i_flonum_floor" #f words-per-flonum)
(rewrite 'cons 16 2 "C_a_i_cons" #t 3)
(rewrite '##sys#cons 16 2 "C_a_i_cons" #t 3)
diff --git a/chicken-install.scm b/chicken-install.scm
index e752df4b..c8e4c97b 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -52,6 +52,7 @@
"chicken.eval.import.so"
"chicken.expand.import.so"
"chicken.files.import.so"
+ "chicken.flonum.import.so"
"chicken.foreign.import.so"
"chicken.format.import.so"
"chicken.gc.import.so"
diff --git a/chicken.import.scm b/chicken.import.scm
index 60345fe1..93b04037 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -76,50 +76,11 @@
fixnum-bits
fixnum-precision
fixnum?
- flonum-decimal-precision
- flonum-epsilon
- flonum-maximum-decimal-exponent
- flonum-maximum-exponent
- flonum-minimum-decimal-exponent
- flonum-minimum-exponent
- flonum-precision
- flonum-print-precision
- flonum-radix
flonum?
flush-output
foldl
foldr
force-finalizers
- fp-
- fp*
- fp/
- fp+
- fp<
- fp<=
- fp=
- fp>
- fp>=
- fpabs
- fpacos
- fpasin
- fpatan
- fpatan2
- fpexp
- fpexpt
- fpfloor
- fpceiling
- fpcos
- fpinteger?
- fplog
- fpgcd
- fpmax
- fpmin
- fpneg
- fpround
- fpsin
- fpsqrt
- fptan
- fptruncate
fx-
fx*
fx/
@@ -169,8 +130,6 @@
make-parameter
make-promise
make-property-condition
- maximum-flonum
- minimum-flonum
module-environment
most-negative-fixnum
most-positive-fixnum
diff --git a/defaults.make b/defaults.make
index 8022aa6b..22944694 100644
--- a/defaults.make
+++ b/defaults.make
@@ -264,8 +264,8 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign
DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
-DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise format gc io keyword locative \
- posix pretty-print random
+DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise flonum format gc io keyword \
+ locative posix pretty-print random
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
eval expand files internal irregex lolevel ports read-syntax \
repl tcp utils
diff --git a/distribution/manifest b/distribution/manifest
index b1f81b7a..1f410116 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -258,6 +258,8 @@ chicken.expand.import.scm
chicken.expand.import.c
chicken.files.import.scm
chicken.files.import.c
+chicken.flonum.import.scm
+chicken.flonum.import.c
chicken.foreign.import.scm
chicken.foreign.import.c
chicken.format.import.scm
diff --git a/eval.scm b/eval.scm
index e74329da..25620448 100644
--- a/eval.scm
+++ b/eval.scm
@@ -81,6 +81,7 @@
(chicken.eval . eval)
(chicken.expand . expand)
(chicken.files . files)
+ (chicken.flonum . library)
(chicken.foreign . chicken-ffi-syntax)
(chicken.format . extras)
(chicken.gc . library)
diff --git a/library.scm b/library.scm
index 33035add..66d82b9a 100644
--- a/library.scm
+++ b/library.scm
@@ -799,6 +799,18 @@ EOF
(define (fx*? x y) (##core#inline "C_i_o_fixnum_times" x y) )
(define (fx/? x y) (##core#inline "C_i_o_fixnum_quotient" x y) )
+(define (flonum? x) (##core#inline "C_i_flonump" x))
+(define (bignum? x) (##core#inline "C_i_bignump" x))
+(define (ratnum? x) (##core#inline "C_i_ratnump" x))
+(define (cplxnum? x) (##core#inline "C_i_cplxnump" x))
+
+(define (finite? x) (##core#inline "C_i_finitep" x))
+(define (infinite? x) (##core#inline "C_i_infinitep" x))
+(define (nan? x) (##core#inline "C_i_nanp" x))
+
+(module chicken.flonum *
+(import chicken scheme chicken.foreign)
+
(define maximum-flonum (foreign-value "DBL_MAX" double))
(define minimum-flonum (foreign-value "DBL_MIN" double))
(define flonum-radix (foreign-value "FLT_RADIX" int))
@@ -810,15 +822,6 @@ EOF
(define flonum-maximum-decimal-exponent (foreign-value "DBL_MAX_10_EXP" int))
(define flonum-minimum-decimal-exponent (foreign-value "DBL_MIN_10_EXP" int))
-(define (flonum? x) (##core#inline "C_i_flonump" x))
-(define (bignum? x) (##core#inline "C_i_bignump" x))
-(define (ratnum? x) (##core#inline "C_i_ratnump" x))
-(define (cplxnum? x) (##core#inline "C_i_cplxnump" x))
-
-(define (finite? x) (##core#inline "C_i_finitep" x))
-(define (infinite? x) (##core#inline "C_i_infinitep" x))
-(define (nan? x) (##core#inline "C_i_nanp" x))
-
(define-inline (fp-check-flonum x loc)
(unless (flonum? x)
(##sys#error-hook (foreign-value "C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR" int) loc x) ) )
@@ -899,10 +902,6 @@ EOF
(fp-check-flonum x 'fpceiling)
(##core#inline_allocate ("C_a_i_flonum_ceiling" 4) x))
-(define ##sys#floor fpfloor) ;XXX needed for backwards compatibility with "numbers" egg (really?)
-(define ##sys#truncate fptruncate)
-(define ##sys#ceiling fpceiling)
-
(define (fpsin x)
(fp-check-flonum x 'fpsin)
(##core#inline_allocate ("C_a_i_flonum_sin" 4) x))
@@ -955,6 +954,13 @@ EOF
(fp-check-flonum x 'fpinteger?)
(##core#inline "C_u_i_fpintegerp" x))
+(define (flonum-print-precision #!optional prec)
+ (let ((prev (##core#inline "C_get_print_precision")))
+ (when prec
+ (##sys#check-fixnum prec 'flonum-print-precision)
+ (##core#inline "C_set_print_precision" prec))
+ prev)))
+
(define-inline (integer-negate x)
(##core#inline_allocate ("C_s_a_u_i_integer_negate" 6) x))
@@ -992,7 +998,7 @@ EOF
(define-inline (%cplxnum-imag c) (##sys#slot c 2))
(define (make-complex r i)
- (if (or (eq? i 0) (and (##core#inline "C_i_flonump" i) (fp= i 0.0)))
+ (if (or (eq? i 0) (and (##core#inline "C_i_flonump" i) (chicken.flonum#fp= i 0.0)))
r
(##sys#make-structure '##sys#cplxnum
(if (inexact? i) (exact->inexact r) r)
@@ -1086,7 +1092,7 @@ EOF
(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))
+ (do ((x x (chicken.flonum#fp* x 2.0))
(i 0 (fx+ i 1)))
((##core#inline "C_u_i_fpintegerp" x) i)))
@@ -1097,12 +1103,12 @@ EOF
(##sys#/-2 (##sys#/-2 (%flo->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 (* x (expt 2.0 flonum-precision))
+ (if (and (chicken.flonum#fp< x 1.0) ; Watch out for denormalized numbers
+ (chicken.flonum#fp> x -1.0)) ; XXX: Needs a test, it seems pointless
+ (deliver (* x (expt 2.0 chicken.flonum#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))
+ (##sys#integer-power 2 chicken.flonum#flonum-precision))
(deliver x 1)))
(define (inexact->exact x)
@@ -1158,7 +1164,7 @@ EOF
(make-complex x y) ))
((or (##core#inline "C_i_flonump" x) (##core#inline "C_i_flonump" y))
;; This may be incorrect when one is a ratnum consisting of bignums
- (fp/ (exact->inexact x) (exact->inexact y)))
+ (chicken.flonum#fp/ (exact->inexact x) (exact->inexact y)))
((ratnum? x)
(if (ratnum? y)
;; a/b / c/d = a*d / b*c [generic]
@@ -1196,7 +1202,7 @@ EOF
(define (floor x)
(cond ((exact-integer? x) x)
- ((##core#inline "C_i_flonump" x) (fpfloor x))
+ ((##core#inline "C_i_flonump" x) (chicken.flonum#fpfloor x))
;; (floor x) = greatest integer <= x
((ratnum? x) (let* ((n (%ratnum-numerator x))
(q (quotient n (%ratnum-denominator x))))
@@ -1205,7 +1211,7 @@ EOF
(define (ceiling x)
(cond ((exact-integer? x) x)
- ((##core#inline "C_i_flonump" x) (fpceiling x))
+ ((##core#inline "C_i_flonump" x) (chicken.flonum#fpceiling x))
;; (ceiling x) = smallest integer >= x
((ratnum? x) (let* ((n (%ratnum-numerator x))
(q (quotient n (%ratnum-denominator x))))
@@ -1214,7 +1220,7 @@ EOF
(define (truncate x)
(cond ((exact-integer? x) x)
- ((##core#inline "C_i_flonump" x) (fptruncate x))
+ ((##core#inline "C_i_flonump" x) (chicken.flonum#fptruncate x))
;; (rational-truncate x) = integer of largest magnitude <= (abs x)
((ratnum? x) (quotient (%ratnum-numerator x)
(%ratnum-denominator x)))
@@ -1350,7 +1356,7 @@ EOF
;; General case: sin^{-1}(z) = -i\ln(iz + \sqrt{1-z^2})
(define (asin n)
(##sys#check-number n 'asin)
- (cond ((and (##core#inline "C_i_flonump" n) (fp>= n -1.0) (fp<= n 1.0))
+ (cond ((and (##core#inline "C_i_flonump" n) (chicken.flonum#fp>= n -1.0) (chicken.flonum#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)
@@ -1367,7 +1373,7 @@ EOF
(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))
+ (cond ((and (##core#inline "C_i_flonump" n) (chicken.flonum#fp>= n -1.0) (chicken.flonum#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)
@@ -1635,12 +1641,13 @@ EOF
(if (not (negative? point))
(exact->inexact (* mant (##sys#integer-power 10 point)))
(let* ((scl (##sys#integer-power 10 (abs point)))
- (bex (fx- (fx- (chicken.bitwise#integer-length mant) (chicken.bitwise#integer-length scl))
- flonum-precision)))
+ (bex (fx- (fx- (chicken.bitwise#integer-length mant)
+ (chicken.bitwise#integer-length scl))
+ chicken.flonum#flonum-precision)))
(if (fx< bex 0)
(let* ((num (chicken.bitwise#arithmetic-shift mant (fxneg bex)))
(quo (round-quotient num scl)))
- (cond ((> (chicken.bitwise#integer-length quo) flonum-precision)
+ (cond ((> (chicken.bitwise#integer-length quo) chicken.flonum#flonum-precision)
;; Too many bits of quotient; readjust
(set! bex (fx+ 1 bex))
(set! quo (round-quotient num (* scl 2)))))
@@ -1890,13 +1897,6 @@ EOF
(define ##sys#integer->string (##core#primitive "C_integer_to_string"))
(define ##sys#number->string number->string)
-(define (flonum-print-precision #!optional prec)
- (let ([prev (##core#inline "C_get_print_precision")])
- (when prec
- (##sys#check-fixnum prec 'flonum-print-precision)
- (##core#inline "C_set_print_precision" prec) )
- prev ) )
-
(define (equal=? x y)
(define (compare-slots x y start)
(let ((l1 (##sys#size x))
diff --git a/manual/Unit library b/manual/Unit library
index 26091dac..d314893c 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -170,6 +170,8 @@ Platform-specific fixnum limits.
==== Arithmetic floating-point operations
+These procedures are provided by the {{(chicken flonum)}} module.
+
<procedure>(fp+ X Y)</procedure>
<procedure>(fp- X Y)</procedure>
<procedure>(fp* X Y)</procedure>
diff --git a/modules.scm b/modules.scm
index d3451150..62db6e99 100644
--- a/modules.scm
+++ b/modules.scm
@@ -938,6 +938,7 @@
(##sys#register-module-alias 'data-structures 'chicken.data-structures)
(##sys#register-module-alias 'expand 'chicken.expand)
(##sys#register-module-alias 'files 'chicken.files)
+(##sys#register-module-alias 'flonum 'chicken.flonum)
(##sys#register-module-alias 'foreign 'chicken.foreign)
(##sys#register-module-alias 'format 'chicken.format)
(##sys#register-module-alias 'gc 'chicken.gc)
diff --git a/rules.make b/rules.make
index aebbc8aa..d7788e1f 100644
--- a/rules.make
+++ b/rules.make
@@ -519,6 +519,7 @@ $(foreach lib, $(filter-out chicken,$(COMPILER_OBJECTS_1)),\
# special cases for modules not corresponding directly to units
$(eval $(call declare-emitted-import-lib-dependency,chicken.posix,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
@@ -561,6 +562,7 @@ c-backend.c: c-backend.scm mini-srfi-1.scm \
chicken.compiler.core.import.scm \
chicken.bitwise.import.scm \
chicken.data-structures.import.scm \
+ chicken.flonum.import.scm \
chicken.format.import.scm
core.c: core.scm mini-srfi-1.scm \
chicken.compiler.scrutinizer.import.scm \
@@ -753,6 +755,7 @@ bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTION
library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) \
-emit-import-library chicken.bitwise \
+ -emit-import-library chicken.flonum \
-emit-import-library chicken.gc \
-emit-import-library chicken.keyword
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
diff --git a/tests/compiler-tests-3.scm b/tests/compiler-tests-3.scm
index 65164d16..fb3118a4 100644
--- a/tests/compiler-tests-3.scm
+++ b/tests/compiler-tests-3.scm
@@ -1,5 +1,6 @@
;;; compiler-tests-3.scm - tests for unboxing
+(use flonum)
;;; unboxing introduced binding in test-position of conditional
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index 037ae156..124dc9aa 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -1,7 +1,7 @@
;;;; compiler-tests.scm
-(import bitwise foreign srfi-4)
+(import bitwise flonum foreign srfi-4)
(import-for-syntax data-structures expand)
;; test dropping of previous toplevel assignments
diff --git a/tests/fft.scm b/tests/fft.scm
index d0c2aacc..5815a417 100644
--- a/tests/fft.scm
+++ b/tests/fft.scm
@@ -9,7 +9,7 @@
(block)
(not safe)))
(else
- (use bitwise)))
+ (use bitwise flonum)))
;;; All the following redefinitions are *ignored* by the Gambit compiler
;;; because of the declarations above.
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index d0d1e31d..21b27fd6 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -1,6 +1,6 @@
;;;; library-tests.scm
-(use bitwise keyword ports)
+(use bitwise flonum keyword ports)
(define-syntax assert-fail
(syntax-rules ()
diff --git a/tests/numbers-test.scm b/tests/numbers-test.scm
index 0e56d0ec..81231b86 100644
--- a/tests/numbers-test.scm
+++ b/tests/numbers-test.scm
@@ -2,7 +2,7 @@
(include "test.scm")
-(use bitwise format posix)
+(use bitwise flonum format posix)
;; The default "comparator" doesn't know how to deal with extended number types
(current-test-comparator
diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 3eabf489..78565e35 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -1,4 +1,4 @@
-(require-extension data-structures format files io ports posix srfi-4 tcp utils)
+(require-extension data-structures files flonum format io ports posix srfi-4 tcp utils)
(include "test.scm")
(test-begin)
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 3a6ca023..d8cd48a9 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -43,6 +43,7 @@ for x in \
chicken.continuation.import.so \
chicken.data-structures.import.so \
chicken.files.import.so \
+ chicken.flonum.import.so \
chicken.foreign.import.so \
chicken.format.import.so \
chicken.gc.import.so \
diff --git a/types.db b/types.db
index ee0e761e..00b9c03d 100644
--- a/types.db
+++ b/types.db
@@ -493,7 +493,7 @@
(gcd (#(procedure #:clean #:enforce #:foldable) gcd (#!rest (or integer float)) (or integer float))
(() '0)
((fixnum fixnum) (fixnum) (fxgcd #(1) #(2)))
- ((float float) (float) (fpgcd #(1) #(2)))
+ ((float float) (float) (chicken.flonum#fpgcd #(1) #(2)))
((integer integer) (integer)
(##core#inline_allocate ("C_s_a_u_i_integer_gcd" 6) #(1) #(2)))
((* *) (##sys#gcd #(1) #(2))))
@@ -1022,6 +1022,13 @@
(file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or false string)))
(directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or false string)))
+(flush-output (#(procedure #:enforce) flush-output (#!optional output-port) undefined))
+
+(foldl (forall (a b) (#(procedure #:enforce) foldl ((procedure (a b) a) a (list-of b)) a)))
+(foldr (forall (a b) (#(procedure #:enforce) foldr ((procedure (a b) b) b (list-of a)) b)))
+
+(force-finalizers (procedure force-finalizers () undefined))
+
(nan? (#(procedure #:clean #:enforce #:foldable) nan? (number) boolean)
(((or integer ratnum)) (let ((#(tmp) #(1))) '#f))
((float) (##core#inline "C_u_i_flonum_nanp" #(1)))
@@ -1041,115 +1048,108 @@
(fixnum-precision fixnum)
(fixnum? (#(procedure #:pure #:predicate fixnum) fixnum? (*) boolean))
-
-(flonum-decimal-precision fixnum)
-(flonum-epsilon float)
-(flonum-maximum-decimal-exponent fixnum)
-(flonum-maximum-exponent fixnum)
-(flonum-minimum-decimal-exponent fixnum)
-(flonum-minimum-exponent fixnum)
-(flonum-precision fixnum)
-(flonum-print-precision (#(procedure #:clean #:enforce) (#!optional fixnum) fixnum))
-(flonum-radix fixnum)
-
(flonum? (#(procedure #:pure #:predicate float) flonum? (*) boolean))
-(flush-output (#(procedure #:enforce) flush-output (#!optional output-port) undefined))
+;; flonum
-(foldl (forall (a b) (#(procedure #:enforce) foldl ((procedure (a b) a) a (list-of b)) a)))
-(foldr (forall (a b) (#(procedure #:enforce) foldr ((procedure (a b) b) b (list-of a)) b)))
+(chicken.flonum#flonum-decimal-precision fixnum)
+(chicken.flonum#flonum-epsilon float)
+(chicken.flonum#flonum-maximum-decimal-exponent fixnum)
+(chicken.flonum#flonum-maximum-exponent fixnum)
+(chicken.flonum#flonum-minimum-decimal-exponent fixnum)
+(chicken.flonum#flonum-minimum-exponent fixnum)
+(chicken.flonum#flonum-precision fixnum)
+(chicken.flonum#flonum-print-precision (#(procedure #:clean #:enforce) chicken.flonum#flonum-print-precision (#!optional fixnum) fixnum))
+(chicken.flonum#flonum-radix fixnum)
-(force-finalizers (procedure force-finalizers () undefined))
-
-(fp- (#(procedure #:clean #:enforce #:foldable) fp- (float float) float)
+(chicken.flonum#fp- (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp- (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)) ))
-(fp* (#(procedure #:clean #:enforce #:foldable) fp* (float float) float)
+(chicken.flonum#fp* (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp* (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2)) ))
-(fp/ (#(procedure #:clean #:enforce #:foldable) fp/ (float float) float)
+(chicken.flonum#fp/ (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp/ (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2)) ))
-(fpgcd (#(procedure #:clean #:enforce #:foldable) fpgcd (float float) float)
+(chicken.flonum#fpgcd (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpgcd (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_gcd" 4) #(1) #(2)) ))
-(fp+ (#(procedure #:clean #:enforce #:foldable) fp+ (float float) float)
+(chicken.flonum#fp+ (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp+ (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2)) ))
-(fp< (#(procedure #:clean #:enforce #:foldable) fp< (float float) boolean)
+(chicken.flonum#fp< (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp< (float float) boolean)
((float float) (##core#inline "C_flonum_lessp" #(1) #(2)) ))
-(fp<= (#(procedure #:clean #:enforce #:foldable) fp<= (float float) boolean)
+(chicken.flonum#fp<= (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp<= (float float) boolean)
((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2)) ))
-(fp= (#(procedure #:clean #:enforce #:foldable) fp= (float float) boolean)
+(chicken.flonum#fp= (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp= (float float) boolean)
((float float) (##core#inline "C_flonum_equalp" #(1) #(2)) ))
-(fp> (#(procedure #:clean #:enforce #:foldable) fp> (float float) boolean)
+(chicken.flonum#fp> (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp> (float float) boolean)
((float float) (##core#inline "C_flonum_greaterp" #(1) #(2)) ))
-(fp>= (#(procedure #:clean #:enforce #:foldable) fp>= (float float) boolean)
+(chicken.flonum#fp>= (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fp>= (float float) boolean)
((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2)) ))
-(fpabs (#(procedure #:clean #:enforce #:foldable) fpabs (float) float)
+(chicken.flonum#fpabs (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpabs (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1) )))
-(fpacos (#(procedure #:clean #:enforce #:foldable) fpacos (float) float)
+(chicken.flonum#fpacos (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpacos (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1) )))
-(fpasin (#(procedure #:clean #:enforce #:foldable) fpasin (float) float)
+(chicken.flonum#fpasin (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpasin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1) )))
-(fpatan (#(procedure #:clean #:enforce #:foldable) fpatan (float) float)
+(chicken.flonum#fpatan (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpatan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1) )))
-(fpatan2 (#(procedure #:clean #:enforce #:foldable) fpatan2 (float float) float)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4)
- #(1) #(2))))
-(fpceiling (#(procedure #:clean #:enforce #:foldable) fpceiling (float) float)
+(chicken.flonum#fpatan2 (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpatan2 (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
+
+(chicken.flonum#fpceiling (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpceiling (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1) )))
-(fpcos (#(procedure #:clean #:enforce #:foldable) fpcos (float) float)
+(chicken.flonum#fpcos (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpcos (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1) )))
-(fpexp (#(procedure #:clean #:enforce #:foldable) fpexp (float) float)
+(chicken.flonum#fpexp (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpexp (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1) )))
-(fpexpt (#(procedure #:clean #:enforce #:foldable) fpexpt (float float) float)
- ((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4)
- #(1) #(2))))
+(chicken.flonum#fpexpt (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpexpt (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2))))
-(fpfloor (#(procedure #:clean #:enforce #:foldable) fpfloor (float) float)
+(chicken.flonum#fpfloor (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpfloor (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1) )))
-(fpinteger? (#(procedure #:clean #:enforce #:foldable) fpinteger? (float) boolean)
+(chicken.flonum#fpinteger? (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpinteger? (float) boolean)
((float) (##core#inline "C_u_i_fpintegerp" #(1) )))
-(fplog (#(procedure #:clean #:enforce #:foldable) fplog (float) float)
+(chicken.flonum#fplog (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fplog (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1) )))
-(fpmax (#(procedure #:clean #:enforce #:foldable) fpmax (float float) float)
+(chicken.flonum#fpmax (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpmax (float float) float)
((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
-(fpmin (#(procedure #:clean #:enforce #:foldable) fpmin (float float) float)
+(chicken.flonum#fpmin (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpmin (float float) float)
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
-(fpneg (#(procedure #:clean #:enforce #:foldable) fpneg (float) float)
+(chicken.flonum#fpneg (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpneg (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1) )))
-(fpround (#(procedure #:clean #:enforce #:foldable) fpround (float) float)
+(chicken.flonum#fpround (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpround (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1) )))
-(fpsin (#(procedure #:clean #:enforce #:foldable) fpsin (float) float)
+(chicken.flonum#fpsin (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpsin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1) )))
-(fpsqrt (#(procedure #:clean #:enforce #:foldable) fpsqrt (float) float)
+(chicken.flonum#fpsqrt (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fpsqrt (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1) )))
-(fptan (#(procedure #:clean #:enforce #:foldable) fptan (float) float)
+(chicken.flonum#fptan (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fptan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1) )))
-(fptruncate (#(procedure #:clean #:enforce #:foldable) fptruncate (float) float)
+(chicken.flonum#fptruncate (#(procedure #:clean #:enforce #:foldable) chicken.flonum#fptruncate (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1) )))
;;XXX should these be enforcing?
@@ -1223,8 +1223,8 @@
(make-composite-condition (#(procedure #:clean #:enforce) make-composite-condition (#!rest (struct condition)) (struct condition)))
(make-parameter (#(procedure #:clean #:enforce) make-parameter (* #!optional procedure) procedure))
(make-property-condition (#(procedure #:clean #:enforce) make-property-condition (symbol #!rest *) (struct condition)))
-(maximum-flonum float)
-(minimum-flonum float)
+(chicken.flonum#maximum-flonum float)
+(chicken.flonum#minimum-flonum float)
(module-environment (#(procedure #:clean #:enforce) module-environment (symbol #!optional symbol) (struct environment)))
(most-negative-fixnum fixnum)
(most-positive-fixnum fixnum)
Trap