>From a3e1baa26da50d511dab41520649d354ef7b1063 Mon Sep 17 00:00:00 2001 From: Peter Bex
Date: Sun, 16 Jun 2013 21:03:19 +0200 Subject: [PATCH] Accept flonums in numerator and denominator procedures (fixes #1016) --- NEWS | 2 ++ chicken.h | 1 + library.scm | 21 +++++++++++++++------ runtime.c | 49 ++++++++++++++++++++++++++++++++++++++++++++++++- tests/library-tests.scm | 20 ++++++++++++++++++++ 5 files changed, 86 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index fd43687..09f65b4 100644 --- a/NEWS +++ b/NEWS @@ -37,6 +37,8 @@ (thanks to Florian Zumbiehl) - posix: memory-mapped file support for Windows (thanks to "rivo") - posix: find-file's test argument now also accepts SRE forms. + - numerator and denominator now accept inexact numbers, as per R5RS + (reported by John Cowan). - Runtime system - Special events in poll() are now handled, avoiding hangs in threaded apps. diff --git a/chicken.h b/chicken.h index ce54b3c..559d077 100644 --- a/chicken.h +++ b/chicken.h @@ -1779,6 +1779,7 @@ C_fctexport void C_ccall C_allocate_vector(C_word c, C_word closure, C_word k, C C_fctexport void C_ccall C_string_to_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret; C_fctexport void C_ccall C_build_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret; C_fctexport void C_ccall C_flonum_fraction(C_word c, C_word closure, C_word k, C_word n) C_noret; +C_fctexport void C_ccall C_flonum_rat(C_word c, C_word closure, C_word k, C_word n) C_noret; C_fctexport void C_ccall C_quotient(C_word c, C_word closure, C_word k, C_word n1, C_word n2) C_noret; C_fctexport void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num, ...) C_noret; C_fctexport void C_ccall C_fixnum_to_string(C_word c, C_word closure, C_word k, C_word num) C_noret; diff --git a/library.scm b/library.scm index 31ee708..75e8bbd 100644 --- a/library.scm +++ b/library.scm @@ -901,6 +901,7 @@ EOF (define real? number?) (define (rational? n) (##core#inline "C_i_rationalp" n)) (define ##sys#flonum-fraction (##core#primitive "C_flonum_fraction")) +(define ##sys#fprat (##core#primitive "C_flonum_rat")) (define (##sys#integer? x) (##core#inline "C_i_integerp" x)) (define integer? ##sys#integer?) (define (##sys#exact? x) (##core#inline "C_i_exactp" x)) @@ -930,15 +931,23 @@ EOF (define (numerator n) (##sys#check-number n 'numerator) - (if (##core#inline "C_i_integerp" n) - n - (##sys#signal-hook #:type-error 'numerator "bad argument type - not a rational number" n) ) ) + (cond + ((##core#inline "C_u_i_exactp" n) n) + ((##core#inline "C_i_finitep" n) + (receive (num denom) (##sys#fprat n) num)) + (else + (##sys#signal-hook + #:type-error 'numerator "bad argument type - not a rational number" n)) ) ) (define (denominator n) (##sys#check-number n 'denominator) - (if (##core#inline "C_i_integerp" n) - 1 - (##sys#signal-hook #:type-error 'numerator "bad argument type - not a rational number" n) ) ) + (cond + ((##core#inline "C_u_i_exactp" n) 1) + ((##core#inline "C_i_finitep" n) + (receive (num denom) (##sys#fprat n) denom)) + (else + (##sys#signal-hook + #:type-error 'denominator "bad argument type - not a rational number" n)) ) ) (define magnitude abs) diff --git a/runtime.c b/runtime.c index 5ce267e..b28b35c 100644 --- a/runtime.c +++ b/runtime.c @@ -31,6 +31,7 @@ #include