[uim-commit] r3158 - in branches/r5rs/sigscheme: . src
yamaken at freedesktop.org
yamaken at freedesktop.org
Fri Mar 3 02:48:36 PST 2006
Author: yamaken
Date: 2006-03-03 02:48:32 -0800 (Fri, 03 Mar 2006)
New Revision: 3158
Added:
branches/r5rs/sigscheme/src/format.c
branches/r5rs/sigscheme/src/module-srfi28.c
branches/r5rs/sigscheme/src/module-srfi48.c
Modified:
branches/r5rs/sigscheme/NEWS
branches/r5rs/sigscheme/README
branches/r5rs/sigscheme/TODO
branches/r5rs/sigscheme/configure.in
branches/r5rs/sigscheme/src/Makefile.am
branches/r5rs/sigscheme/src/config.h
branches/r5rs/sigscheme/src/module.c
branches/r5rs/sigscheme/src/number.c
branches/r5rs/sigscheme/src/sigscheme.c
branches/r5rs/sigscheme/src/sigscheme.h
branches/r5rs/sigscheme/src/sigschemeinternal.h
Log:
* This commit add the format strings feature. It is basically working,
but just no-compile-error state and not tested yet
* sigscheme/src/config.h
- (SCM_USE_RAW_C_FORMAT, SCM_USE_SSCM_FORMAT_EXTENSION,
SCM_USE_SRFI28, SCM_USE_SRFI48, SCM_USE_FORMAT): New macro
* sigscheme/src/sigscheme.h
- (enum ScmFormatCapability, ScmValueFormat, struct
ScmValueFormat_): New type
- (SCM_VALUE_FORMAT_INIT, SCM_VALUE_FORMAT_INIT4,
SCM_VALUE_FORMAT_SPECIFIEDP): New macro
- (scm_int2string, scm_pretty_print, scm_lformat, scm_vformat,
scm_format, scm_initialize_srfi28, scm_p_srfi28_format,
scm_initialize_srfi48, scm_p_srfi48_format, scm_p_formatplus): New
function decl
* sigscheme/src/sigschemeinternal.h
- (scm_init_format): New function decl
* sigscheme/src/number.c
- (scm_int2string): New function
- (scm_p_number2string): Simplify with scm_int2string()
* sigscheme/src/format.c
- New file
- (PRETTY_PRINT_PROCEDURE_NAME, MSG_SRFI48_DIRECTIVE_HELP,
MSG_SSCM_DIRECTIVE_HELP, NEWLINE_CHAR, FORMAT_STR_INIT,
FORMAT_STR_POS, FORMAT_STR_ENDP, FORMAT_STR_READ, FORMAT_STR_PEEK,
FORMAT_STR_SKIP_CHAR, POP_FORMAT_ARG): New macro
- (format_string_t, enum format_arg_type, struct format_args): New
type
- (initialized, sym_pretty_print): New static variable
- (format_str_peek, read_number, read_number_prefix, format_int,
format_raw_c_directive, format_directive, format_internal): New
static function
- (scm_init_format, scm_pretty_print, scm_lformat, scm_vformat,
scm_format): New function
* sigscheme/src/module-srfi28.c
- New file
- (scm_initialize_srfi28, scm_p_srfi28_format): New function
* sigscheme/src/module-srfi48.c
- New file
- (srfi48_format_internal): New static function
- (scm_initialize_srfi48 scm_p_srfi48_format, scm_p_formatplus): new
function
* sigscheme/src/module.c
- (module_info_table): Add 'srfi-28' and 'srfi-48'
* sigscheme/src/sigscheme.c
- (scm_initialize_internal): Add scm_init_format()
* sigscheme/src/Makefile.am
- Add rules for functable-srfi28.c and functable-srfi48.c
- (FUNC_TABLES): Add functable-srfi28.c and functable-srfi48.c
- (libsscm_la_SOURCES): Add format.c, module-srfi28.c and
module-srfi48.c conditionally
* sigscheme/configure.in
- (USE_FORMAT, USE_RAW_C_FORMAT, USE_USE_SSCM_FORMAT_EXTENSION,
USE_SRFI28, USE_SRFI48): New variable
* sigscheme/README
- Note SRFI-28 and SRFI-48
* sigscheme/NEWS
- Ditto
* sigscheme/TODO
- Update
Modified: branches/r5rs/sigscheme/NEWS
===================================================================
--- branches/r5rs/sigscheme/NEWS 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/NEWS 2006-03-03 10:48:32 UTC (rev 3158)
@@ -1,7 +1,14 @@
-Overview of changes from 0.5.0-alpha (r2902 + local modifications)
+Overview of changes from 0.5.0 (r3097 + private modifications)
==
* New features
+ - Support format strings (covers SRFI-28 and SRFI-48)
+
+
+Overview of changes from 0.5.0-alpha (r2902 + private modifications)
+==
+* New features
+
- Support 64-bit data models (storage-compact is not yet)
- Add lacking character predicates and complete all R5RS character procedures
Modified: branches/r5rs/sigscheme/README
===================================================================
--- branches/r5rs/sigscheme/README 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/README 2006-03-03 10:48:32 UTC (rev 3158)
@@ -14,8 +14,10 @@
- SRFI-8 : Receive
- SRFI-22 : Running Scheme Scripts on Unix
- SRFI-23 : Error Reporting Mechanism
+ - SRFI-28 : Basic Format Strings
- SRFI-34 : Exception Handling for Programs
- SRFI-38 : External Representation for Data with Shared Structure
+ - SRFI-48 : Intermediate Format Strings
- SRFI-60 : Integer as Bits (partial)
- SRFI-75 : R6RS Unicode data (partial)
- Multibyte character support
Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/TODO 2006-03-03 10:48:32 UTC (rev 3158)
@@ -138,8 +138,8 @@
Assigned to YamaKen:
* Implement format string
- - Evaluate SRFI-28 and SRFI-48
- - Implement limited part of the SRFIs for both Scheme object and raw C word
+ - Write tests
+ - Complete width and padding handlings
- Replace asprintf and vasprintf
- Obsolete vprintf method of port object
Modified: branches/r5rs/sigscheme/configure.in
===================================================================
--- branches/r5rs/sigscheme/configure.in 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/configure.in 2006-03-03 10:48:32 UTC (rev 3158)
@@ -112,6 +112,9 @@
AM_CONDITIONAL(USE_DEEP_CADRS, test "x$use_yes" = xyes)
# Optional Features
+AM_CONDITIONAL(USE_FORMAT, test "x$use_yes" = xyes)
+AM_CONDITIONAL(USE_RAW_C_FORMAT, test "x$use_yes" = xyes)
+AM_CONDITIONAL(USE_USE_SSCM_FORMAT_EXTENSION, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SSCM_EXTENSIONS, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_LEGACY_MACRO, test "x$use_no" = xyes)
AM_CONDITIONAL(USE_DUMP, test "x$use_no" = xyes)
@@ -122,8 +125,10 @@
AM_CONDITIONAL(USE_SRFI8, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI22, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI23, test "x$use_yes" = xyes)
+AM_CONDITIONAL(USE_SRFI28, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI34, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI38, test "x$use_yes" = xyes)
+AM_CONDITIONAL(USE_SRFI48, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI60, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI75_NAMED_CHARS, test "x$use_yes" = xyes)
AM_CONDITIONAL(USE_SRFI75, test "x$use_yes" = xyes)
Modified: branches/r5rs/sigscheme/src/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/src/Makefile.am 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/Makefile.am 2006-03-03 10:48:32 UTC (rev 3158)
@@ -20,8 +20,10 @@
functable-srfi6.c \
functable-srfi8.c \
functable-srfi23.c \
+ functable-srfi28.c \
functable-srfi34.c \
functable-srfi38.c \
+ functable-srfi48.c \
functable-srfi60.c
SSCM_PROC_SRCS = error.c module.c
@@ -79,10 +81,14 @@
$(BUILD_FUNCTBL) $@ "scm_srfi8_func_info_table" $<
functable-srfi23.c: module-srfi23.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL) $@ "scm_srfi23_func_info_table" $<
+functable-srfi28.c: module-srfi28.c $(BUILD_FUNCTBL_DEPS)
+ $(BUILD_FUNCTBL) $@ "scm_srfi28_func_info_table" $<
functable-srfi34.c: module-srfi34.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL) $@ "scm_srfi34_func_info_table" $<
functable-srfi38.c: module-srfi38.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL) $@ "scm_srfi38_func_info_table" $<
+functable-srfi48.c: module-srfi48.c $(BUILD_FUNCTBL_DEPS)
+ $(BUILD_FUNCTBL) $@ "scm_srfi48_func_info_table" $<
functable-srfi60.c: module-srfi60.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL) $@ "scm_srfi60_func_info_table" $<
functable-siod.c: module-siod.c $(BUILD_FUNCTBL_DEPS)
@@ -146,6 +152,9 @@
pkginclude_HEADERS += encoding.h
libsscm_la_SOURCES += encoding.c
endif
+if USE_FORMAT
+ libsscm_la_SOURCES += format.c
+endif
if USE_SSCM_EXTENSIONS
libsscm_la_SOURCES += module-sscm-ext.c
endif
@@ -167,12 +176,18 @@
if USE_SRFI23
libsscm_la_SOURCES += module-srfi23.c
endif
+if USE_SRFI28
+ libsscm_la_SOURCES += module-srfi28.c
+endif
if USE_SRFI34
libsscm_la_SOURCES += module-srfi34.c
endif
if USE_SRFI38
libsscm_la_SOURCES += module-srfi38.c
endif
+if USE_SRFI48
+ libsscm_la_SOURCES += module-srfi48.c
+endif
if USE_SRFI60
libsscm_la_SOURCES += module-srfi60.c
endif
Modified: branches/r5rs/sigscheme/src/config.h
===================================================================
--- branches/r5rs/sigscheme/src/config.h 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/config.h 2006-03-03 10:48:32 UTC (rev 3158)
@@ -60,6 +60,8 @@
/*===========================================================================
Optional Features
===========================================================================*/
+#define SCM_USE_RAW_C_FORMAT 1 /* use internal format which takes raw C values from va_list */
+#define SCM_USE_SSCM_FORMAT_EXTENSION 1 /* use 'format+' */
#define SCM_USE_SSCM_EXTENSIONS 1 /* use SigScheme-specific extensions */
#define SCM_USE_LEGACY_MACRO 0 /* (not supported yet) use define-macro */
#define SCM_USE_DUMP 0 /* (not supported yet) use storage dump */
@@ -71,8 +73,10 @@
#define SCM_USE_SRFI8 1 /* use SRFI-8 'receive' */
#define SCM_USE_SRFI22 1 /* use SRFI-22 running scheme scripts on Unix */
#define SCM_USE_SRFI23 1 /* use SRFI-23 'error' */
+#define SCM_USE_SRFI28 1 /* use SRFI-28 'format' */
#define SCM_USE_SRFI34 1 /* use SRFI-34 exception handling for programs */
#define SCM_USE_SRFI38 1 /* use SRFI-38 'write-with-shared-structure' */
+#define SCM_USE_SRFI48 1 /* use SRFI-48 'format' (superset of SRFI-28) */
#define SCM_USE_SRFI60 1 /* use SRFI-60 integers as bits */
#define SCM_USE_SRFI75_NAMED_CHARS 1 /* use named characters of SRFI-75 R6RS unicode data */
#define SCM_USE_SRFI75 1 /* use SRFI-75 R6RS unicode data */
@@ -195,6 +199,21 @@
#define SCM_USE_PORT 1
#endif /* (SCM_USE_READER || SCM_USE_WRITER) */
+#if (SCM_USE_SRFI28 || SCM_USE_SRFI48 \
+ || SCM_USE_SSCM_FORMAT_EXTENSION || SCM_USE_RAW_C_FORMAT)
+#undef SCM_USE_FORMAT
+#define SCM_USE_FORMAT 1
+#endif /* (SCM_USE_SRFI28 || SCM_USE_SRFI48
+ || SCM_USE_SSCM_FORMAT_EXTENSION || SCM_USE_RAW_C_FORMAT) */
+#if SCM_USE_SSCM_FORMAT_EXTENSION
+#undef SCM_USE_SRFI48
+#define SCM_USE_SRFI48 1
+#endif /* SCM_USE_SSCM_FORMAT_EXTENSION */
+#if SCM_USE_SRFI48
+#undef SCM_USE_SRFI28
+#define SCM_USE_SRFI28 1
+#endif /* USE_SRFI48 */
+
#if SCM_COMPAT_SIOD
#undef SCM_USE_SSCM_EXTENSIONS
#define SCM_USE_SSCM_EXTENSIONS 1
Added: branches/r5rs/sigscheme/src/format.c
===================================================================
--- branches/r5rs/sigscheme/src/format.c 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/format.c 2006-03-03 10:48:32 UTC (rev 3158)
@@ -0,0 +1,616 @@
+/*===========================================================================
+ * FileName : format.c
+ * About : Format strings
+ *
+ * Copyright (C) 2006 YamaKen <yamaken AT bp.iij4u.or.jp>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+
+#include "config.h"
+
+/*=======================================
+ System Include
+=======================================*/
+#include <stddef.h>
+#include <stdarg.h>
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+#if SCM_USE_MULTIBYTE_CHAR
+#include "encoding.h"
+#endif
+
+/*=======================================
+ File Local Macro Definitions
+=======================================*/
+#define PRETTY_PRINT_PROCEDURE_NAME "pretty-print"
+
+/* FIXME */
+#define MSG_SRFI48_DIRECTIVE_HELP \
+ "\n" \
+ "\n" \
+ "\n"
+
+#if SCM_USE_SSCM_FORMAT_EXTENSION
+/* FIXME */
+#define MSG_SSCM_DIRECTIVE_HELP \
+ "\n" \
+ "\n" \
+ "\n"
+#endif /* SCM_USE_SSCM_FORMAT_EXTENSION */
+
+#define NEWLINE_CHAR \
+ (SCM_NEWLINE_STR[sizeof(SCM_NEWLINE_STR) - sizeof("") - 1])
+
+/*=======================================
+ File Local Type Definitions
+=======================================*/
+/* To allow non-ASCII string such as UCS2, format string is abstracted. */
+#if SCM_USE_MULTIBYTE_CHAR
+typedef ScmMultibyteString format_string_t;
+
+#define FORMAT_STR_INIT(mbs_fmt, str) \
+ SCM_MBS_INIT2((mbs_fmt), (str), strlen(str))
+
+#define FORMAT_STR_POS(mbs_fmt) (SCM_MBS_GET_STR(mbs_fmt))
+
+#define FORMAT_STR_ENDP(mbs_fmt) (!SCM_MBS_GET_SIZE(mbs_fmt))
+
+#define FORMAT_STR_READ(mbs_fmt) \
+ (SCM_CHARCODEC_READ_CHAR(scm_current_char_codec, (mbs_fmt)))
+
+#define FORMAT_STR_PEEK(mbs_fmt) \
+ (format_str_peek((mbs_fmt), SCM_MANGLE(name)))
+
+#else /* SCM_USE_MULTIBYTE_CHAR */
+
+typedef const char *format_string_t;
+
+#define FORMAT_STR_INIT(fmt, str) ((fmt) = (str))
+#define FORMAT_STR_POS(fmt) (fmt)
+#define FORMAT_STR_ENDP(fmt) (!*(fmt))
+#define FORMAT_STR_READ(fmt) (*(fmt)++)
+#define FORMAT_STR_PEEK(fmt) (*(fmt))
+#endif /* SCM_USE_MULTIBYTE_CHAR */
+
+#define FORMAT_STR_SKIP_CHAR(fmt) (FORMAT_STR_READ(fmt), 0)
+
+enum format_arg_type {
+ ARG_VA_LIST,
+ ARG_SCM_LIST
+};
+
+struct format_args {
+ enum format_arg_type type;
+ union {
+ va_list va;
+ ScmObj scm;
+ } lst;
+};
+
+#define POP_FORMAT_ARG(args) \
+ (((args)->type == ARG_VA_LIST) ? va_arg((args)->lst.va, ScmObj) \
+ : MUST_POP_ARG((args)->lst.scm))
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+static scm_bool initialized;
+static ScmObj sym_pretty_print;
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+#if SCM_USE_MULTIBYTE_CHAR
+static scm_ichar_t format_str_peek(ScmMultibyteString mbs_fmt,
+ const char *caller);
+#endif
+static signed char read_number(format_string_t *fmt);
+static ScmValueFormat read_number_prefix(enum ScmFormatCapability fcap,
+ format_string_t *fmt);
+static void format_int(ScmObj port,
+ ScmValueFormat vfmt, uintmax_t n, int radix);
+#if SCM_USE_RAW_C_FORMAT
+static scm_bool format_raw_c_directive(ScmObj port,
+ format_string_t *fmt, va_list *args);
+#endif
+#if SCM_USE_SRFI28
+static scm_bool format_directive(ScmObj port, scm_ichar_t prev_ch,
+ enum ScmFormatCapability fcap,
+ format_string_t *fmt,
+ struct format_args *args);
+#endif
+static ScmObj format_internal(ScmObj port, enum ScmFormatCapability fcap,
+ const char *fmt, struct format_args *args);
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void
+scm_init_format(void)
+{
+ if (!initialized) {
+ scm_gc_protect_with_init(&sym_pretty_print,
+ scm_intern(PRETTY_PRINT_PROCEDURE_NAME));
+ initialized = scm_true;
+ }
+}
+
+#if SCM_USE_MULTIBYTE_CHAR
+static scm_ichar_t
+format_str_peek(ScmMultibyteString mbs_fmt, const char *caller)
+{
+ return scm_charcodec_read_char(scm_current_char_codec, &mbs_fmt, caller);
+}
+#endif /* SCM_USE_MULTIBYTE_CHAR */
+
+void
+scm_pretty_print(ScmObj port, ScmObj obj)
+{
+ ScmObj proc_pretty_print;
+
+ proc_pretty_print = scm_symbol_value(sym_pretty_print,
+ SCM_INTERACTION_ENV);
+ if (!EQ(proc_pretty_print, SCM_UNBOUND))
+ scm_call(proc_pretty_print, LIST_1(obj));
+ else
+ scm_write(port, obj);
+}
+
+static signed char
+read_number(format_string_t *fmt)
+{
+ scm_ichar_t c;
+ scm_int_t ret;
+ scm_bool err;
+ char *bufp;
+ char buf[sizeof("99")];
+ DECLARE_INTERNAL_FUNCTION("format");
+
+ for (bufp = buf;
+ (c = FORMAT_STR_PEEK(*fmt), ICHAR_NUMERICP(c))
+ && bufp < &buf[sizeof(buf) - 1];
+ FORMAT_STR_SKIP_CHAR(*fmt))
+ {
+ *bufp++ = c;
+ }
+ *bufp = '\0';
+ ret = scm_string2number(buf, 10, &err);
+ if (err) /* empty case */
+ ret = -1;
+
+ return ret;
+}
+
+static ScmValueFormat
+read_number_prefix(enum ScmFormatCapability fcap, format_string_t *fmt)
+{
+ scm_ichar_t c;
+ ScmValueFormat vfmt;
+ DECLARE_INTERNAL_FUNCTION("format");
+
+ SCM_VALUE_FORMAT_INIT(vfmt);
+ c = FORMAT_STR_PEEK(*fmt);
+
+ if (c == '0' && (fcap & SCM_FMT_LEADING_ZEROS)) {
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ vfmt.pad = '0';
+ }
+ vfmt.width = read_number(fmt);
+ c = FORMAT_STR_PEEK(*fmt);
+
+ if (c == ',') {
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ vfmt.frac_width = read_number(fmt);
+ }
+
+ return vfmt;
+}
+
+static void
+format_int(ScmObj port, ScmValueFormat vfmt, uintmax_t n, int radix)
+{
+ char *str;
+
+ str = scm_int2string(vfmt, n, radix);
+ scm_port_puts(port, str);
+ free(str);
+}
+
+#if SCM_USE_RAW_C_FORMAT
+/* ([CP]|(0?[0-9]+(,0?[0-9]+)?)?(S|([MWQLGJTZ]?[UDXOB]))) */
+static scm_bool
+format_raw_c_directive(ScmObj port, format_string_t *fmt, va_list *args)
+{
+ const void *orig_pos;
+ scm_ichar_t c;
+ uintmax_t n; /* FIXME: sign extension */
+ int radix;
+ scm_bool modifiedp;
+ ScmValueFormat vfmt;
+ DECLARE_INTERNAL_FUNCTION("internal format");
+
+ orig_pos = FORMAT_STR_POS(*fmt);
+
+ c = FORMAT_STR_PEEK(*fmt);
+ switch (c) {
+ case 'C': /* Character */
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ scm_port_put_char(port, va_arg(*args, scm_ichar_t));
+ return scm_true;
+
+ case 'P': /* Pointer */
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ scm_port_puts(port, "0x");
+ SCM_VALUE_FORMAT_INIT4(vfmt, sizeof(void *) * CHAR_BIT / 4,
+ -1, '0', scm_false);
+ format_int(port, vfmt, (uintptr_t)va_arg(*args, void *), 16);
+ return scm_true;
+
+ default:
+ break;
+ }
+
+ vfmt = read_number_prefix(SCM_FMT_RAW_C | SCM_FMT_SSCM_ADDENDUM, fmt);
+ c = FORMAT_STR_PEEK(*fmt);
+ if (c == 'S') { /* String */
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ /* FIXME: reflect vfmt.width */
+ scm_port_puts(port, va_arg(*args, const char *));
+ return scm_true;
+ }
+
+ /* size modifiers */
+ modifiedp = scm_true;
+ switch (c) {
+ case 'M': /* scm_int_t */
+ n = va_arg(*args, scm_uint_t);
+ break;
+
+ case 'W': /* int32_t */
+ n = va_arg(*args, uint32_t);
+ break;
+
+ case 'L': /* long */
+ n = va_arg(*args, unsigned long);
+ break;
+
+ case 'Q': /* int64_t */
+ n = va_arg(*args, uint64_t);
+ break;
+
+ case 'J': /* intmax_t */
+ n = va_arg(*args, uintmax_t);
+ break;
+
+ case 'T': /* ptrdiff_t */
+ n = (uintmax_t)va_arg(*args, ptrdiff_t);
+ break;
+
+ case 'Z': /* size_t */
+ n = va_arg(*args, size_t);
+ break;
+
+ default:
+ modifiedp = scm_false;
+ n = 0; /* dummy to suppress warning */
+ break;
+ }
+ if (modifiedp) {
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ c = FORMAT_STR_PEEK(*fmt);
+ }
+
+ /* integer format specifiers */
+ switch (c) {
+ case 'U': /* Unsigned decimal */
+ vfmt.signedp = scm_false;
+ /* FALLTHROUGH */
+ case 'D': /* Decimal */
+ radix = 10;
+ break;
+
+ case 'X': /* unsigned heXadecimal */
+ radix = 16;
+ vfmt.signedp = scm_false;
+ break;
+
+ case 'O': /* unsigned Octal */
+ radix = 8;
+ vfmt.signedp = scm_false;
+ break;
+
+ case 'B': /* unsigned Binary */
+ radix = 2;
+ vfmt.signedp = scm_false;
+ break;
+
+ default:
+ /* no internal directives found */
+ SCM_ASSERT(FORMAT_STR_POS(*fmt) == orig_pos);
+ return scm_false;
+ }
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ if (!modifiedp)
+ n = va_arg(*args, unsigned int);
+ format_int(port, vfmt, n, radix);
+
+ return scm_true;
+}
+#endif /* SCM_USE_RAW_C_FORMAT */
+
+#if SCM_USE_SRFI28
+static scm_bool
+format_directive(ScmObj port, scm_ichar_t prev_ch,
+ enum ScmFormatCapability fcap,
+ format_string_t *fmt, struct format_args *args)
+{
+ const void *orig_pos;
+ char directive;
+#if SCM_USE_SRFI48
+ ScmObj obj, indirect_fmt, indirect_args;
+ scm_bool prefixedp;
+ int radix;
+ ScmValueFormat vfmt;
+#endif
+ DECLARE_INTERNAL_FUNCTION("format");
+
+#if SCM_USE_SRFI48
+ orig_pos = FORMAT_STR_POS(*fmt);
+ vfmt = read_number_prefix(fcap, fmt);
+ prefixedp = (FORMAT_STR_POS(*fmt) != orig_pos);
+#endif /* SCM_USE_SRFI48 */
+ directive = ICHAR_DOWNCASE(FORMAT_STR_PEEK(*fmt));
+
+ if (fcap & SCM_FMT_SRFI28) {
+ if (prefixedp)
+ goto err_invalid_prefix;
+
+ switch (directive) {
+ case 'a': /* Any */
+ scm_display(port, POP_FORMAT_ARG(args));
+ goto fin;
+
+ case 's': /* Slashified */
+ scm_write(port, POP_FORMAT_ARG(args));
+ goto fin;
+
+ case '%': /* Newline */
+ scm_port_newline(port);
+ goto fin;
+
+ case '~': /* Tilde */
+ scm_port_put_char(port, '~');
+ goto fin;
+
+ default:
+ break;
+ }
+ }
+
+#if SCM_USE_SRFI48
+ if (fcap & SCM_FMT_SRFI48_ADDENDUM) {
+ radix = -1;
+ switch (directive) {
+ case 'f': /* Fixed */
+ obj = POP_FORMAT_ARG(args);
+ if (STRINGP(obj)) {
+ /* FIXME: reflect vfmt.width */
+ scm_display(port, obj);
+ } else {
+ if (!INTP(obj))
+ ERR_OBJ("integer or string required but got", obj);
+ format_int(port, vfmt, SCM_INT_VALUE(obj), 10);
+ }
+ goto fin;
+
+ case 'd': /* Decimal */
+ radix = 10;
+ break;
+
+ case 'x': /* heXadecimal */
+ radix = 16;
+ break;
+
+ case 'o': /* Octal */
+ radix = 8;
+ break;
+
+ case 'b': /* Binary */
+ radix = 2;
+ break;
+
+ default:
+ break;
+ }
+ if (radix > 0 && (!prefixedp || (fcap & SCM_FMT_PREFIXED_RADIX))) {
+ obj = POP_FORMAT_ARG(args);
+ ENSURE_INT(obj);
+ format_int(port, vfmt, SCM_INT_VALUE(obj), radix);
+ goto fin;
+ }
+
+ if (prefixedp)
+ goto err_invalid_prefix;
+
+ switch (directive) {
+ case 'w': /* WriteCircular */
+ scm_write_ss(port, POP_FORMAT_ARG(args));
+ goto fin;
+
+ case 'y': /* Yuppify */
+ scm_pretty_print(port, POP_FORMAT_ARG(args));
+ goto fin;
+
+ case 'k': /* Indirection (backward compatability) */
+ case '?': /* Indirection */
+ indirect_fmt = POP_FORMAT_ARG(args);
+ ENSURE_STRING(indirect_fmt);
+ indirect_args = POP_FORMAT_ARG(args);
+ ENSURE_LIST(indirect_args);
+ scm_lformat(port,
+ fcap, SCM_STRING_STR(indirect_fmt), indirect_args);
+ goto fin;
+
+ case 'c': /* Character */
+ obj = POP_FORMAT_ARG(args);
+ ENSURE_CHAR(obj);
+ scm_port_put_char(port, SCM_CHAR_VALUE(obj));
+ goto fin;
+
+ case 't': /* Tab */
+ scm_port_put_char(port, '\t');
+ goto fin;
+
+ case '_': /* Space */
+ scm_port_put_char(port, ' ');
+ goto fin;
+
+ case '&': /* Freshline */
+ if (prev_ch != NEWLINE_CHAR)
+ scm_port_newline(port);
+ goto fin;
+
+ case 'h': /* Help */
+#if SCM_USE_SSCM_FORMAT_EXTENSION
+ if (fcap & SCM_FMT_SSCM_ADDENDUM)
+ scm_port_puts(port, MSG_SSCM_DIRECTIVE_HELP);
+ else
+#endif
+ scm_port_puts(port, MSG_SRFI48_DIRECTIVE_HELP);
+ goto fin;
+
+ default:
+ break;
+ }
+ }
+#endif /* SCM_USE_SRFI48 */
+
+ /* Although SRFI-48 does not specified about unknown directives, the
+ * reference implementation treats it as error. */
+ ERR("invalid escape sequence: ~%c", directive);
+
+ err_invalid_prefix:
+ ERR("invalid prefix for directive ~%c", directive);
+
+ fin:
+ FORMAT_STR_SKIP_CHAR(*fmt);
+ return scm_true;
+}
+#endif /* SCM_USE_SRFI28 */
+
+static ScmObj
+format_internal(ScmObj port, enum ScmFormatCapability fcap,
+ const char *fmt, struct format_args *args)
+{
+ scm_ichar_t c, prev_c;
+ format_string_t cur;
+ scm_bool implicit_portp;
+ DECLARE_INTERNAL_FUNCTION("format");
+
+ if (FALSEP(port)) {
+ port = scm_p_srfi6_open_output_string();
+ implicit_portp = scm_true;
+ } else if (EQ(port, SCM_TRUE)) {
+ port = scm_out;
+ implicit_portp = scm_false;
+ } else {
+ if (!PORTP(port))
+ ERR_OBJ("port or boolean required but got", port);
+ implicit_portp = scm_false;
+ }
+
+ prev_c = '\0';
+ FORMAT_STR_INIT(cur, fmt);
+ for (; !FORMAT_STR_ENDP(cur); prev_c = c) {
+ c = FORMAT_STR_READ(cur);
+ if (c == '~') {
+#if SCM_USE_RAW_C_FORMAT
+ if (fcap & SCM_FMT_RAW_C) {
+ SCM_ASSERT(args->type == ARG_VA_LIST);
+ if (format_raw_c_directive(port, &cur, &args->lst.va))
+ continue;
+ }
+#endif /* SCM_USE_RAW_C_FORMAT */
+#if SCM_USE_SRFI28
+ if (fcap & (SCM_FMT_SRFI28 | SCM_FMT_SRFI48 | SCM_FMT_SSCM)) {
+ SCM_ASSERT(args->type == ARG_VA_LIST
+ || args->type == ARG_SCM_LIST);
+ if (format_directive(port, prev_c, fcap, &cur, args))
+ continue;
+ }
+#endif /* SCM_USE_SRFI28 */
+ SCM_ASSERT(scm_false);
+ } else {
+ scm_port_put_char(port, c);
+ }
+ }
+
+ if (args->type == ARG_SCM_LIST)
+ ENSURE_NO_MORE_ARG(args->lst.scm);
+ return (implicit_portp) ? scm_p_srfi6_get_output_string(port) : SCM_UNDEF;
+}
+
+ScmObj
+scm_lformat(ScmObj port,
+ enum ScmFormatCapability fcap, const char *fmt, ScmObj scm_args)
+{
+ struct format_args args;
+
+ args.type = ARG_SCM_LIST;
+ args.lst.scm = scm_args;
+ return format_internal(port, fcap, fmt, &args);
+}
+
+ScmObj
+scm_vformat(ScmObj port,
+ enum ScmFormatCapability fcap, const char *fmt, va_list c_args)
+{
+ struct format_args args;
+
+ args.type = ARG_VA_LIST;
+ args.lst.va = c_args;
+ return format_internal(port, fcap, fmt, &args);
+}
+
+ScmObj
+scm_format(ScmObj port, enum ScmFormatCapability fcap, const char *fmt, ...)
+{
+ va_list args;
+ ScmObj ret;
+
+ va_start(args, fmt);
+ ret = scm_vformat(port, fcap, fmt, args);
+ va_end(args);
+
+ return ret;
+}
Added: branches/r5rs/sigscheme/src/module-srfi28.c
===================================================================
--- branches/r5rs/sigscheme/src/module-srfi28.c 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/module-srfi28.c 2006-03-03 10:48:32 UTC (rev 3158)
@@ -0,0 +1,82 @@
+/*===========================================================================
+ * FileName : module-srfi28.c
+ * About : SRFI-28 Basic Format Strings
+ *
+ * Copyright (C) 2006 YamaKen <yamaken AT bp.iij4u.or.jp>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+
+#include "config.h"
+
+/*=======================================
+ System Include
+=======================================*/
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Macro Definitions
+=======================================*/
+
+/*=======================================
+ File Local Type Definitions
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+#include "functable-srfi28.c"
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void
+scm_initialize_srfi28(void)
+{
+ scm_init_format();
+ scm_register_funcs(scm_srfi28_func_info_table);
+}
+
+ScmObj
+scm_p_srfi28_format(ScmObj fmt, ScmObj objs)
+{
+ DECLARE_FUNCTION("format", procedure_variadic_1);
+
+ ENSURE_STRING(fmt);
+
+ return scm_lformat(SCM_FALSE, SCM_FMT_SRFI28, SCM_STRING_STR(fmt), objs);
+}
Added: branches/r5rs/sigscheme/src/module-srfi48.c
===================================================================
--- branches/r5rs/sigscheme/src/module-srfi48.c 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/module-srfi48.c 2006-03-03 10:48:32 UTC (rev 3158)
@@ -0,0 +1,121 @@
+/*===========================================================================
+ * FileName : module-srfi48.c
+ * About : SRFI-48 Intermediate Format Strings
+ *
+ * Copyright (C) 2006 YamaKen <yamaken AT bp.iij4u.or.jp>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+
+#include "config.h"
+
+/*=======================================
+ System Include
+=======================================*/
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Macro Definitions
+=======================================*/
+
+/*=======================================
+ File Local Type Definitions
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+#include "functable-srfi48.c"
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+static ScmObj srfi48_format_internal(enum ScmFormatCapability fcap,
+ ScmObj fmt_or_port, ScmObj rest);
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void
+scm_initialize_srfi48(void)
+{
+ scm_init_format();
+ scm_register_funcs(scm_srfi48_func_info_table);
+
+#if !SCM_USE_SSCM_FORMAT_EXTENSION
+ SCM_SYMBOL_SET_VCELL(scm_intern("format+"), SCM_UNBOUND);
+#endif
+
+ /* SRFI-28 is a subset of SRFI-48. To prevent being overridden by SRFI-28,
+ * provide it here. */
+ scm_provide(SCM_CONST_STRING("srfi-28"));
+}
+
+static ScmObj
+srfi48_format_internal(enum ScmFormatCapability fcap,
+ ScmObj fmt_or_port, ScmObj rest)
+{
+ ScmObj port, fmt, objs;
+ DECLARE_INTERNAL_FUNCTION("format");
+
+ if (STRINGP(fmt_or_port)) {
+ port = SCM_FALSE;
+ fmt = fmt_or_port;
+ } else {
+ port = fmt_or_port;
+ fmt = MUST_POP_ARG(rest);
+ ENSURE_STRING(fmt);
+ }
+ objs = rest;
+
+ return scm_lformat(port, fcap, SCM_STRING_STR(fmt), objs);
+}
+
+/* format [port] format-string [obj ...] */
+ScmObj
+scm_p_srfi48_format(ScmObj fmt_or_port, ScmObj rest)
+{
+ DECLARE_FUNCTION("format", procedure_variadic_1);
+
+ return srfi48_format_internal(SCM_FMT_SRFI48, fmt_or_port, rest);
+}
+
+/* SigScheme specific procedure */
+/* format+ [port] format-string [obj ...] */
+ScmObj
+scm_p_formatplus(ScmObj fmt_or_port, ScmObj rest)
+{
+ DECLARE_FUNCTION("format+", procedure_variadic_1);
+
+ return srfi48_format_internal(SCM_FMT_SSCM, fmt_or_port, rest);
+}
Modified: branches/r5rs/sigscheme/src/module.c
===================================================================
--- branches/r5rs/sigscheme/src/module.c 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/module.c 2006-03-03 10:48:32 UTC (rev 3158)
@@ -82,12 +82,18 @@
#if SCM_USE_SRFI23
{"srfi-23", scm_initialize_srfi23},
#endif
+#if SCM_USE_SRFI28
+ {"srfi-28", scm_initialize_srfi28},
+#endif
#if SCM_USE_SRFI34
{"srfi-34", scm_initialize_srfi34},
#endif
#if SCM_USE_SRFI38
{"srfi-38", scm_initialize_srfi38},
#endif
+#if SCM_USE_SRFI48
+ {"srfi-48", scm_initialize_srfi48},
+#endif
#if SCM_USE_SRFI60
{"srfi-60", scm_initialize_srfi60},
#endif
Modified: branches/r5rs/sigscheme/src/number.c
===================================================================
--- branches/r5rs/sigscheme/src/number.c 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/number.c 2006-03-03 10:48:32 UTC (rev 3158)
@@ -437,36 +437,56 @@
return r;
}
+/*
+ * FIXME:
+ * - width
+ * - padding
+ */
+char *
+scm_int2string(ScmValueFormat vfmt, uintmax_t n, int radix)
+{
+ char buf[sizeof("-") + SCM_INT_BITS];
+ char *p;
+ const char *end;
+ uintmax_t un; /* must be unsinged to be capable of -INT_MIN */
+ int digit;
+ scm_bool neg;
+ DECLARE_INTERNAL_FUNCTION("scm_int2string");
+
+ SCM_ASSERT(radix == 2 || radix == 8 || radix == 10 || radix == 16);
+ neg = (vfmt.signedp && ((intmax_t)n < 0));
+ un = (neg) ? (uintmax_t)-(intmax_t)n : n;
+
+ end = p = &buf[sizeof(buf) - 1];
+ *p = '\0';
+
+ do {
+ digit = un % radix;
+ *--p = (digit <= 9) ? '0' + digit : 'a' + digit - 10;
+ } while (un /= radix);
+ if (neg)
+ *--p = '-';
+
+ return scm_strdup(p);
+}
+
ScmObj
scm_p_number2string(ScmObj num, ScmObj args)
{
- char buf[sizeof("-") + SCM_INT_BITS];
- char *p;
- const char *end;
- scm_int_t n;
- /* 'un' must be unsinged to be capable of -INT_MIN */
- scm_uint_t un, digit, r;
- scm_bool neg;
- DECLARE_FUNCTION("number->string", procedure_variadic_1);
+ char *str;
+ intmax_t n;
+ int r;
+ ScmValueFormat vfmt;
+ DECLARE_FUNCTION("number->string", procedure_variadic_1);
- ENSURE_INT(num);
+ ENSURE_INT(num);
- n = SCM_INT_VALUE(num);
- neg = (n < 0);
- un = (neg) ? -n : n;
- r = (scm_uint_t)prepare_radix(SCM_MANGLE(name), args);
+ n = (intmax_t)SCM_INT_VALUE(num);
+ r = prepare_radix(SCM_MANGLE(name), args);
+ SCM_VALUE_FORMAT_INIT(vfmt);
+ str = scm_int2string(vfmt, (uintmax_t)n, r);
- end = p = &buf[sizeof(buf) - 1];
- *p = '\0';
-
- do {
- digit = un % r;
- *--p = (digit <= 9) ? '0' + digit : 'a' + digit - 10;
- } while (un /= r);
- if (neg)
- *--p = '-';
-
- return MAKE_STRING_COPYING(p, end - p);
+ return MAKE_STRING(str, SCM_STRLEN_UNKNOWN);
}
scm_int_t
Modified: branches/r5rs/sigscheme/src/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.c 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/sigscheme.c 2006-03-03 10:48:32 UTC (rev 3158)
@@ -114,6 +114,9 @@
scm_init_storage(storage_conf);
scm_init_error();
scm_init_port();
+#if SCM_USE_FORMAT
+ scm_init_format();
+#endif
scm_init_module();
/* fallback to unibyte */
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-03-03 10:48:32 UTC (rev 3158)
@@ -928,6 +928,45 @@
: (obj))
/*=======================================
+ Format Strings
+=======================================*/
+enum ScmFormatCapability {
+ SCM_FMT_NONE = 0,
+ SCM_FMT_RAW_C = 1 << 0, /* take raw C values from va_list */
+ SCM_FMT_SRFI28 = 1 << 1,
+ SCM_FMT_SRFI48_ADDENDUM = 1 << 2,
+ SCM_FMT_LEADING_ZEROS = 1 << 3, /* padding with zeros "00034" */
+ SCM_FMT_PREFIXED_RADIX = 1 << 4, /* "8x" 65536 => " ffff" */
+
+ SCM_FMT_SRFI48 = (SCM_FMT_SRFI28 | SCM_FMT_SRFI48_ADDENDUM),
+ SCM_FMT_SSCM_ADDENDUM = (SCM_FMT_LEADING_ZEROS | SCM_FMT_PREFIXED_RADIX),
+ SCM_FMT_SSCM = (SCM_FMT_SRFI48 | SCM_FMT_SSCM_ADDENDUM),
+ SCM_FMT_INTERNAL = (SCM_FMT_RAW_C | SCM_FMT_SSCM)
+};
+
+typedef struct ScmValueFormat_ ScmValueFormat;
+struct ScmValueFormat_ {
+ signed char width; /* integer part width */
+ signed char frac_width; /* fractional part width */
+ char pad; /* char for padding prefix */
+ char signedp;
+};
+
+#define SCM_VALUE_FORMAT_INIT(vfmt) \
+ SCM_VALUE_FORMAT_INIT4(vfmt, -1, -1, ' ', scm_true)
+
+#define SCM_VALUE_FORMAT_INIT4(vfmt, w, fw, p, s) \
+ do { \
+ vfmt.width = w; \
+ vfmt.frac_width = fw; \
+ vfmt.pad = p; \
+ vfmt.signedp = s; \
+ } while (/* CONSTCOND */ 0)
+
+#define SCM_VALUE_FORMAT_SPECIFIEDP(vfmt) \
+ (vfmt.width > 0 || vfmt.frac_width > 0 || vfmt.pad != ' ' || !vfmt.signedp)
+
+/*=======================================
Variable Declarations
=======================================*/
/* storage-gc.c */
@@ -1229,6 +1268,7 @@
#if SCM_USE_NUMBER
/* number.c */
+char *scm_int2string(ScmValueFormat vfmt, uintmax_t n, int radix);
ScmObj scm_p_add(ScmObj left, ScmObj right, enum ScmReductionState *state);
ScmObj scm_p_subtract(ScmObj left, ScmObj right,
enum ScmReductionState *state);
@@ -1410,6 +1450,17 @@
ScmObj scm_p_load(ScmObj filename);
#endif /* SCM_USE_LOAD */
+#if SCM_USE_FORMAT
+/* format.c */
+void scm_pretty_print(ScmObj port, ScmObj obj);
+ScmObj scm_lformat(ScmObj port, enum ScmFormatCapability fcap,
+ const char *fmt, ScmObj scm_args);
+ScmObj scm_vformat(ScmObj port, enum ScmFormatCapability fcap,
+ const char *fmt, va_list c_args);
+ScmObj scm_format(ScmObj port, enum ScmFormatCapability fcap,
+ const char *fmt, ...);
+#endif /* SCM_USE_FORMAT */
+
/*===========================================================================
SigScheme : Optional Funtions
===========================================================================*/
@@ -1513,6 +1564,12 @@
ScmObj scm_p_srfi23_error(ScmObj reason, ScmObj args);
#endif
+#if SCM_USE_SRFI28
+/* module-srfi28.c */
+void scm_initialize_srfi28(void);
+ScmObj scm_p_srfi28_format(ScmObj fmt, ScmObj objs);
+#endif
+
#if SCM_USE_SRFI34
/* module-srfi34.c */
void scm_initialize_srfi34(void);
@@ -1528,6 +1585,13 @@
ScmObj scm_p_srfi38_write_with_shared_structure(ScmObj obj, ScmObj args);
#endif
+#if SCM_USE_SRFI48
+/* module-srfi48.c */
+void scm_initialize_srfi48(void);
+ScmObj scm_p_srfi48_format(ScmObj fmt_or_port, ScmObj rest);
+ScmObj scm_p_formatplus(ScmObj fmt_or_port, ScmObj rest);
+#endif
+
#if SCM_USE_SRFI60
/* module-srfi60.c */
void scm_initialize_srfi60(void);
Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-03-03 02:34:36 UTC (rev 3157)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-03-03 10:48:32 UTC (rev 3158)
@@ -612,6 +612,9 @@
/* write.c */
void scm_display_errobj_ss(ScmObj port, ScmObj errobj);
+/* format.c */
+void scm_init_format(void);
+
/* module.c */
void scm_init_module(void);
void scm_register_funcs(struct scm_func_registration_info *table);
More information about the uim-commit
mailing list