From f0cf88feb657c039dd01e798a8aa62014817be9e Mon Sep 17 00:00:00 2001 From: Shiro Kawai Date: Tue, 7 Jan 2025 21:24:23 -1000 Subject: [PATCH] Allow number->string to take Cf. https://github.com/shirok/Gauche/issues/1096 --- ChangeLog | 6 +++++ src/libnum.scm | 63 +++++++++++++++++++++++++++++++------------------- src/number.c | 4 +++- 3 files changed, 48 insertions(+), 25 deletions(-) diff --git a/ChangeLog b/ChangeLog index b5398944c..2fd808341 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2025-01-07 Shiro Kawai + + * src/libnum.scm (number->string): Allow the first optional argument + to be a + https://github.com/shirok/Gauche/issues/1096 + 2025-01-04 Shiro Kawai * src/number.c, lib/gauche/numioutil.scm: Support repeating decimal diff --git a/src/libnum.scm b/src/libnum.scm index efc50958d..cc5300916 100644 --- a/src/libnum.scm +++ b/src/libnum.scm @@ -37,6 +37,7 @@ (.include "gauche/priv/configP.h" "gauche/vminsn.h" "gauche/priv/bignumP.h" + "gauche/priv/writerP.h" ) @@ -219,35 +220,49 @@ (define-inline inexact exact->inexact) ;R6RS (select-module scheme) -(define-cproc number->string (obj :optional (radix:: 10) +(define-cproc number->string (obj :optional (control-or-radix #f) (flags #f) (precision:: -1)) :fast-flonum :constant - (let* ([f::u_long 0] - [fmt::ScmNumberFormat] + (let* ([fmt::ScmNumberFormat] [o::ScmPort* (SCM_PORT (Scm_MakeOutputStringPort TRUE))]) - (when (or (< radix SCM_RADIX_MIN) (> radix SCM_RADIX_MAX)) - (Scm_Error "radix must be an integer between %d and %d, but got %d" - SCM_RADIX_MIN SCM_RADIX_MAX radix)) - (cond [(or (SCM_FALSEP flags) (SCM_NULLP flags)) (set! f 0)] - [(SCM_TRUEP flags) (set! f SCM_NUMBER_FORMAT_USE_UPPER)];compatibility - [(SCM_PAIRP flags) - (unless (SCM_FALSEP (Scm_Memq 'uppercase flags)) - (logior= f SCM_NUMBER_FORMAT_USE_UPPER)) - (unless (SCM_FALSEP (Scm_Memq 'plus flags)) - (logior= f SCM_NUMBER_FORMAT_SHOW_PLUS)) - (unless (SCM_FALSEP (Scm_Memq 'radix flags)) - (logior= f SCM_NUMBER_FORMAT_ALT_RADIX)) - (unless (SCM_FALSEP (Scm_Memq 'notational flags)) - (logior= f SCM_NUMBER_FORMAT_ROUND_NOTATIONAL))] - [else - (Scm_Error "flags argument must be a list of symbols (uppercase, \ - plus, radix, notational) or a boolean, but got: %S" - flags)]) (Scm_NumberFormatInit (& fmt)) - (set! (ref fmt radix) radix) - (set! (ref fmt flags) f) - (set! (ref fmt precision) precision) + (cond + [(SCM_WRITE_CONTROLS_P control-or-radix) + (let* ([c::ScmWriteControls* (SCM_WRITE_CONTROLS control-or-radix)]) + (set! (ref fmt radix) (-> c printBase)) + (when (-> c printRadix) + (logior= (ref fmt flags) SCM_NUMBER_FORMAT_ALT_RADIX)) + (when (-> c exactDecimal) + (logior= (ref fmt flags) SCM_NUMBER_FORMAT_EXACT_DECIMAL_POINT)))] + [(SCM_INTP control-or-radix) + (let* ([f::u_long 0] + [radix::ScmSmallInt (SCM_INT_VALUE control-or-radix)]) + (when (or (< radix SCM_RADIX_MIN) (> radix SCM_RADIX_MAX)) + (Scm_Error "radix must be an integer between %d and %d, but got %d" + SCM_RADIX_MIN SCM_RADIX_MAX radix)) + (cond [(or (SCM_FALSEP flags) (SCM_NULLP flags)) (set! f 0)] + [(SCM_TRUEP flags) (set! f SCM_NUMBER_FORMAT_USE_UPPER)];compatibility + [(SCM_PAIRP flags) + (unless (SCM_FALSEP (Scm_Memq 'uppercase flags)) + (logior= f SCM_NUMBER_FORMAT_USE_UPPER)) + (unless (SCM_FALSEP (Scm_Memq 'plus flags)) + (logior= f SCM_NUMBER_FORMAT_SHOW_PLUS)) + (unless (SCM_FALSEP (Scm_Memq 'radix flags)) + (logior= f SCM_NUMBER_FORMAT_ALT_RADIX)) + (unless (SCM_FALSEP (Scm_Memq 'notational flags)) + (logior= f SCM_NUMBER_FORMAT_ROUND_NOTATIONAL))] + [else + (Scm_Error "flags argument must be a list of symbols (uppercase, \ + plus, radix, notational) or a boolean, but got: %S" + flags)]) + (set! (ref fmt radix) radix) + (set! (ref fmt flags) f) + (set! (ref fmt precision) precision))] + [(SCM_FALSEP control-or-radix)] ;default + [else + (Scm_Error " or fixnum expected, but got: %S" + control-or-radix)]) (Scm_PrintNumber o obj (& fmt)) (return (Scm_GetOutputString o 0)))) diff --git a/src/number.c b/src/number.c index cf4e6546c..260b5186f 100644 --- a/src/number.c +++ b/src/number.c @@ -4270,7 +4270,9 @@ void Scm_NumberFormatFromWriteContext(ScmNumberFormat* fmt, } } -/* API */ +/* API + This is for users' convenience. The 'real' operation is done by + Scm_PrintNumber. */ ScmObj Scm_NumberToString(ScmObj obj, int radix, u_long flags) { if (radix < SCM_RADIX_MIN || radix > SCM_RADIX_MAX)