[uim-commit] r1829 - in branches/r5rs/sigscheme: . test
kzk at freedesktop.org
kzk at freedesktop.org
Thu Oct 6 16:57:19 PDT 2005
Author: kzk
Date: 2005-10-06 16:57:16 -0700 (Thu, 06 Oct 2005)
New Revision: 1829
Added:
branches/r5rs/sigscheme/operations-srfi6.c
branches/r5rs/sigscheme/test/test-srfi6.scm
Modified:
branches/r5rs/sigscheme/config.h
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemeinternal.h
branches/r5rs/sigscheme/sigschemetype.h
Log:
* implement SRFI-6 : "Basic String Ports"
* sigscheme/io.c
- (ScmOp_close_input_port,
ScmOp_close_output_port): no need to close string port
- (ScmOp_read_char): use SCM_PORT_GETC
* sigscheme/sigschemeinternal.h
- (PORTBUFFER_SIZE): new macro
- (scm_portbuffer): buffer for SCM_PORT_PRINT to handle printf style
format string
* sigscheme/config.h
- (SCM_USE_SRFI6): new build flag
* sigscheme/read.c
- (SCM_PORT_GETC,
SCM_PORT_UNGETC): move to sigscheme.h
* sigscheme/operations.c
- include operations-srfi6.c when SCM_USE_SRFI6 is on
* sigscheme/debug.c
- (SCM_PORT_PRINT): moved to sigscheme.h
- (scm_portbuffer): buffer for SCM_PORT_PRINT to handle printf style
format string
- use scm_portbuffer for handling printf style format string
* sigscheme/datas.c
- (fileport_print): change args
- (stringport_print): change args and now implemented properly
- (SigScm_InitStorage): allocate scm_portbuffer
- (SigScm_FinalizeStorage): free scm_portbuffer
- (Scm_NewStringPort): change arg
* sigscheme/sigscheme.c
- add "srfi-6" entry to module_info_table
- (Scm_eval_c_string_internal): change Scm_NewStringPort argument
* sigscheme/operations-srfi6.c
- (ScmOp_SRFI6_open_input_string,
ScmOp_SRFI6_open_output_string,
ScmOp_SRFI6_get_output_string): new func
* sigscheme/sigscheme.h
- (SCM_PORT_GETC, SCM_PORT_UNGETC): moved from read.c
- (SCM_PORT_PRINT): moved from debug.c
- (ScmOp_SRFI6_open_input_string,
ScmOp_SRFI6_open_output_string,
ScmOp_SRFI6_get_output_string): new func
* sigscheme/sigschemetype.h
- (print_func): change arg
* sigscheme/test/test-srfi6.scm
- new file
Modified: branches/r5rs/sigscheme/config.h
===================================================================
--- branches/r5rs/sigscheme/config.h 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/config.h 2005-10-06 23:57:16 UTC (rev 1829)
@@ -42,6 +42,7 @@
#define SCM_USE_SRFI1 1 /* use SRFI-1 list library */
#define SCM_USE_SRFI2 1 /* use SRFI-2 'and-let*' */
+#define SCM_USE_SRFI6 1 /* use SRFI-6 basic string ports */
#define SCM_USE_SRFI8 1 /* use SRFI-8 'receive' */
#define SCM_USE_SRFI23 1 /* use SRFI-23 'error' */
#define SCM_USE_SRFI34 1 /* use SRFI-34 exception handling for programs */
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/datas.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -225,9 +225,9 @@
/* port */
static int fileport_getc(ScmObj port);
-static void fileport_print(ScmObj port, const char *str, ...);
+static void fileport_print(ScmObj port, const char *str);
static int stringport_getc(ScmObj port);
-static void stringport_print(ScmObj port, const char *str, ...);
+static void stringport_print(ScmObj port, const char *str);
/* continuation */
static void initialize_continuation_env(void);
@@ -267,6 +267,7 @@
{
initialize_special_constants();
allocate_heap(&scm_heaps, scm_heap_num, SCM_HEAP_SIZE, &scm_freelist);
+ scm_portbuffer = (char*)malloc(sizeof(char) * PORTBUFFER_SIZE + 1);
#if SCM_USE_VALUECONS
/*
@@ -289,6 +290,7 @@
finalize_heap();
finalize_symbol_hash();
finalize_protected_var();
+ free(scm_portbuffer);
}
static void *malloc_aligned(size_t size)
@@ -844,16 +846,12 @@
return c;
}
-static void fileport_print(ScmObj port, const char *str, ...)
+static void fileport_print(ScmObj port, const char *str)
{
- va_list va;
-
- va_start(va, str);
- vfprintf(SCM_PORT_FILE(port), str, va);
- va_end(va);
+ fprintf(SCM_PORT_FILE(port), str);
}
-ScmObj Scm_NewStringPort(const char *str)
+ScmObj Scm_NewStringPort(const char *str, enum ScmPortDirection pdirection)
{
ScmObj obj = SCM_FALSE;
ScmPortInfo *pinfo = (ScmPortInfo *)malloc(sizeof(ScmPortInfo));
@@ -861,13 +859,17 @@
SCM_NEW_OBJ_INTERNAL(obj);
SCM_ENTYPE_PORT(obj);
- SCM_PORT_SET_PORTDIRECTION(obj, PORT_INPUT);
+ SCM_PORT_SET_PORTDIRECTION(obj, pdirection);
SCM_PORT_SET_PORTINFO(obj, pinfo);
SCM_PORT_SET_PORTTYPE(obj, PORT_STRING);
- SCM_PORT_SET_STR(obj, strdup(str));
+ if (str)
+ SCM_PORT_SET_STR(obj, strdup(str));
+ else
+ SCM_PORT_SET_STR(obj, NULL);
SCM_PORT_SET_STR_CURRENTPOS(obj, SCM_PORT_STR(obj));
SCM_PORT_SET_GETC_FUNC(obj, stringport_getc);
+ SCM_PORT_SET_PRINT_FUNC(obj, stringport_print);
SCM_PORT_SET_UNGOTTENCHAR(obj, 0);
return obj;
@@ -887,9 +889,31 @@
return c;
}
-static void stringport_print(ScmObj port, const char *str, ...)
+static void stringport_print(ScmObj port, const char *str)
{
- /* not implemented yet */
+ char *p = NULL;
+ char *str_start = SCM_PORT_STR(port);
+ int newstr_len = strlen(str);
+ int oldstr_len = 0;
+ int newsize = 0;
+ int curpos = 0;
+
+ /* set "newsize", "curpos" and "oldstr_len" */
+ if (str_start) {
+ oldstr_len = strlen(str_start);
+ newsize = newstr_len + oldstr_len;
+ curpos = SCM_PORT_STR_CURRENTPOS(port) - str_start;
+ } else {
+ newsize = newstr_len;
+ curpos = 0;
+ }
+
+ p = (char *)realloc(str_start, newsize + 1);
+ p[newsize] = '0';
+ snprintf(p + oldstr_len, newstr_len + 1, "%s", str);
+
+ SCM_PORT_SET_STR(port, p);
+ SCM_PORT_SET_STR_CURRENTPOS(port, p + curpos);
}
ScmObj Scm_NewContinuation(void)
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/debug.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -90,18 +90,6 @@
#define HASH_FIND 0
#endif /* SCM_USE_SRFI38 */
-/*
- * Port Handling macro for printing strings.
- *
- * FIXME: This macro cannot handle variadic functions
- * properly. I want to use this macro like follows.
- *
- * e.g. SCM_PORT_PRINT(port, "%s", string);
- *
- */
-#define SCM_PORT_PRINT(port, str) \
- (SCM_PORT_PRINT_FUNC(port)(port, str))
-
/*=======================================
Variable Declarations
=======================================*/
@@ -110,6 +98,9 @@
static write_ss_context *write_ss_ctx; /* misc info in priting shared structures */
#endif
+/* buffer for snprintf */
+char *scm_portbuffer;
+
/*=======================================
File Local Function Declarations
=======================================*/
@@ -188,34 +179,34 @@
void SigScm_WriteToPort(ScmObj port, ScmObj obj)
{
- if (FALSEP(port))
- return;
+ DECLARE_INTERNAL_FUNCTION("SigScm_WriteToPort");
- if (SCM_PORT_PORTTYPE(port) == PORT_FILE) {
- print_ScmObj_internal(port, obj, AS_WRITE);
+ ASSERT_PORTP(port);
+ if (SCM_PORT_PORTDIRECTION(port) != PORT_OUTPUT)
+ SigScm_Error("output port is required");
+
+ print_ScmObj_internal(port, obj, AS_WRITE);
+
#if SCM_VOLATILE_OUTPUT
- fflush(f);
+ if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
+ fflush(SCM_PORT_FILE(port));
#endif
- return;
- }
-
- SigScm_Error("SigScm_WriteToPort : support write only for file port.");
}
void SigScm_DisplayToPort(ScmObj port, ScmObj obj)
{
- if (FALSEP(port))
- return;
+ DECLARE_INTERNAL_FUNCTION("SigScm_DisplayToPort");
- if (SCM_PORT_PORTTYPE(port) == PORT_FILE) {
- print_ScmObj_internal(port, obj, AS_DISPLAY);
+ ASSERT_PORTP(port);
+ if (SCM_PORT_PORTDIRECTION(port) != PORT_OUTPUT)
+ SigScm_Error("output port is required");
+
+ print_ScmObj_internal(port, obj, AS_DISPLAY);
+
#if SCM_VOLATILE_OUTPUT
- fflush(f);
+ if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
+ fflush(SCM_PORT_FILE(port));
#endif
- return;
- }
-
- SigScm_Error("SigScm_DisplayToPort : support display only for file port.");
}
static void print_ScmObj_internal(ScmObj port, ScmObj obj, enum OutputType otype)
@@ -225,25 +216,28 @@
int index = get_shared_index(obj);
if (index > 0) {
/* defined datum */
- SCM_PORT_PRINT_FUNC(port)(port, "#%d#", index);
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "#%d#", index);
+ SCM_PORT_PRINT(port, scm_portbuffer);
return;
}
if (index < 0) {
/* defining datum, with the new index negated */
- SCM_PORT_PRINT_FUNC(port)(port, "#%d=", -index);
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "#%d=", -index);
+ SCM_PORT_PRINT(port, scm_portbuffer);
/* Print it; the next time it'll be defined. */
}
}
#endif
switch (SCM_TYPE(obj)) {
case ScmInt:
- SCM_PORT_PRINT_FUNC(port)(port, "%d", SCM_INT_VALUE(obj));
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "%d", SCM_INT_VALUE(obj));
+ SCM_PORT_PRINT(port, scm_portbuffer);
break;
case ScmCons:
print_list(port, obj, otype);
break;
case ScmSymbol:
- SCM_PORT_PRINT_FUNC(port)(port, "%s", SCM_SYMBOL_NAME(obj));
+ SCM_PORT_PRINT(port, SCM_SYMBOL_NAME(obj));
break;
case ScmChar:
print_char(port, obj, otype);
@@ -283,11 +277,13 @@
SigScm_Error("You cannot print ScmFreeCell, may be GC bug.");
break;
case ScmCPointer:
- SCM_PORT_PRINT_FUNC(port)(port, "#<c_pointer %p>", SCM_C_POINTER_VALUE(obj));
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "#<c_pointer %p>", SCM_C_POINTER_VALUE(obj));
+ SCM_PORT_PRINT(port, scm_portbuffer);
break;
case ScmCFuncPointer:
- SCM_PORT_PRINT_FUNC(port)(port, "#<c_func_pointer %p>",
- SCM_REINTERPRET_CAST(void *, SCM_C_FUNCPOINTER_VALUE(obj)));
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "#<c_func_pointer %p>",
+ SCM_REINTERPRET_CAST(void *, SCM_C_FUNCPOINTER_VALUE(obj)));
+ SCM_PORT_PRINT(port, scm_portbuffer);
break;
}
}
@@ -304,7 +300,8 @@
} else if(strcmp(SCM_CHAR_VALUE(obj), "\n") == 0) {
SCM_PORT_PRINT(port, "#\\newline");
} else {
- SCM_PORT_PRINT_FUNC(port)(port, "#\\%s", SCM_CHAR_VALUE(obj));
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "#\\%s", SCM_CHAR_VALUE(obj));
+ SCM_PORT_PRINT(port, scm_portbuffer);
}
break;
case AS_DISPLAY:
@@ -345,7 +342,9 @@
case '\t': SCM_PORT_PRINT(port, "\\t"); break;
case '\\': SCM_PORT_PRINT(port, "\\\\"); break;
default:
- SCM_PORT_PRINT_FUNC(port)(port, "%c", str[i]); break;
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "%c", str[i]);
+ SCM_PORT_PRINT(port, scm_portbuffer);
+ break;
}
}
SCM_PORT_PRINT(port, "\""); /* last doublequote */
@@ -391,12 +390,14 @@
index = get_shared_index(lst);
if (index > 0) {
/* defined datum */
- SCM_PORT_PRINT_FUNC(port)(port, ". #%d#", index);
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, ". #%d#", index);
+ SCM_PORT_PRINT(port, scm_portbuffer);
goto close_parens_and_return;
}
if (index < 0) {
/* defining datum, with the new index negated */
- SCM_PORT_PRINT_FUNC(port)(port, ". #%d=", -index);
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, ". #%d=", -index);
+ SCM_PORT_PRINT(port, scm_portbuffer);
necessary_close_parens++;
goto cheap_recursion;
}
@@ -450,11 +451,15 @@
SCM_PORT_PRINT(port, "port ");
/* file or string */
- if (SCM_PORT_PORTTYPE(obj) == PORT_FILE)
- SCM_PORT_PRINT_FUNC(port)(port, "file %s", SCM_PORT_FILENAME(obj));
- else if (SCM_PORT_PORTTYPE(obj) == PORT_STRING)
- SCM_PORT_PRINT_FUNC(port)(port, "string %s", SCM_PORT_STR(obj));
+ if (SCM_PORT_PORTTYPE(obj) == PORT_FILE) {
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "file %s", SCM_PORT_FILENAME(obj));
+ SCM_PORT_PRINT(port, scm_portbuffer);
+ } else if (SCM_PORT_PORTTYPE(obj) == PORT_STRING) {
+ snprintf(scm_portbuffer, PORTBUFFER_SIZE, "string %s", SCM_PORT_STR(obj));
+ SCM_PORT_PRINT(port, scm_portbuffer);
+ }
+
SCM_PORT_PRINT(port, ">");
}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/io.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -34,7 +34,6 @@
/*=======================================
System Include
=======================================*/
-#include <stdio.h>
/*=======================================
Local Include
@@ -250,7 +249,9 @@
ASSERT_PORTP(port);
- if (SCM_PORT_FILE(port))
+ if (SCM_PORT_PORTTYPE(port) == PORT_FILE
+ && SCM_PORT_PORTDIRECTION(port) == PORT_INPUT
+ && SCM_PORT_FILE(port))
fclose(SCM_PORT_FILE(port));
return SCM_UNDEF;
@@ -262,7 +263,9 @@
ASSERT_PORTP(port);
- if (SCM_PORT_FILE(port))
+ if (SCM_PORT_PORTTYPE(port) == PORT_FILE
+ && SCM_PORT_PORTDIRECTION(port) == PORT_OUTPUT
+ && SCM_PORT_FILE(port))
fclose(SCM_PORT_FILE(port));
return SCM_UNDEF;
@@ -293,8 +296,7 @@
if (!NULLP(args) && PORTP(CAR(args)))
port = CAR(args);
- /* TODO : implement this multibyte-char awareness */
- buf[0] = getc(SCM_PORT_FILE(port));
+ SCM_PORT_GETC(port, buf[0]);
buf[1] = '\0';
return Scm_NewChar(buf);
}
Added: branches/r5rs/sigscheme/operations-srfi6.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi6.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/operations-srfi6.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -0,0 +1,97 @@
+/*===========================================================================
+ * FileName : operations-srfi6.c
+ * About : Basic String Ports
+ *
+ * Copyright (C) 2005 by Kazuki Ohta (mover at hct.zaq.ne.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.
+===========================================================================*/
+
+/*=======================================
+ System Include
+=======================================*/
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void SigScm_Initialize_SRFI6(void)
+{
+ /*=======================================================================
+ SRFI-6 Procedures
+ =======================================================================*/
+ Scm_RegisterProcedureFixed1("open-input-string", ScmOp_SRFI6_open_input_string);
+ Scm_RegisterProcedureFixed0("open-output-string", ScmOp_SRFI6_open_output_string);
+ Scm_RegisterProcedureFixed1("get-output-string", ScmOp_SRFI6_get_output_string);
+}
+
+ScmObj ScmOp_SRFI6_open_input_string(ScmObj str)
+{
+ DECLARE_FUNCTION("open-input-string", ProcedureFixed1);
+
+ ASSERT_STRINGP(str);
+
+ return Scm_NewStringPort(SCM_STRING_STR(str), PORT_INPUT);
+}
+
+ScmObj ScmOp_SRFI6_open_output_string(void)
+{
+ DECLARE_FUNCTION("open-output-string", ProcedureFixed0);
+
+ return Scm_NewStringPort(NULL, PORT_OUTPUT);
+}
+
+ScmObj ScmOp_SRFI6_get_output_string(ScmObj port)
+{
+ DECLARE_FUNCTION("get-output-string", ProcedureFixed1);
+
+ ASSERT_PORTP(port);
+
+ return Scm_NewStringCopying(SCM_PORT_STR(port));
+}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/operations.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -1890,6 +1890,9 @@
#if SCM_USE_SRFI2
#include "operations-srfi2.c"
#endif
+#if SCM_USE_SRFI6
+#include "operations-srfi6.c"
+#endif
#if SCM_USE_SRFI8
#include "operations-srfi8.c"
#endif
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/read.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -68,12 +68,7 @@
/*=======================================
File Local Macro Declarations
=======================================*/
-#define SCM_PORT_GETC(port, c) \
- (c = SCM_PORT_GETC_FUNC(port)(port))
-#define SCM_PORT_UNGETC(port,c) \
- (SCM_PORT_SET_UNGOTTENCHAR(port, c))
-
/*=======================================
Variable Declarations
=======================================*/
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-10-06 23:57:16 UTC (rev 1829)
@@ -73,6 +73,9 @@
#if SCM_USE_SRFI2
{"srfi-2", SigScm_Initialize_SRFI2},
#endif
+#if SCM_USE_SRFI6
+ {"srfi-6", SigScm_Initialize_SRFI6},
+#endif
#if SCM_USE_SRFI8
{"srfi-8", SigScm_Initialize_SRFI8},
#endif
@@ -432,7 +435,7 @@
ScmObj str_port = SCM_NULL;
ScmObj ret = SCM_NULL;
- str_port = Scm_NewStringPort(exp);
+ str_port = Scm_NewStringPort(exp, PORT_INPUT);
ret = SigScm_Read(str_port);
ret = EVAL(ret, SCM_INTERACTION_ENV);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-10-06 23:57:16 UTC (rev 1829)
@@ -125,6 +125,18 @@
#endif /* SCM_GCC4_READY_GC */
+
+/*
+ * Port I/O Handling macros
+ */
+#define SCM_PORT_GETC(port, c) \
+ (c = SCM_PORT_GETC_FUNC(port)(port))
+#define SCM_PORT_UNGETC(port,c) \
+ (SCM_PORT_SET_UNGOTTENCHAR(port, c))
+#define SCM_PORT_PRINT(port, str) \
+ (SCM_PORT_PRINT_FUNC(port)(port, str))
+
+
/*=======================================
Struct Declarations
=======================================*/
@@ -329,7 +341,7 @@
ScmObj Scm_NewClosure(ScmObj exp, ScmObj env);
ScmObj Scm_NewVector(ScmObj *vec, int len);
ScmObj Scm_NewFilePort(FILE *file, const char *filename, enum ScmPortDirection pdireciton);
-ScmObj Scm_NewStringPort(const char *str); /* input only? */
+ScmObj Scm_NewStringPort(const char *str, enum ScmPortDirection pdirection);
ScmObj Scm_NewContinuation(void);
#if !SCM_USE_VALUECONS
ScmObj Scm_NewValuePacket(ScmObj values);
@@ -629,6 +641,13 @@
void SigScm_Initialize_SRFI2(void);
ScmObj ScmOp_SRFI2_and_let_star(ScmObj claws, ScmObj body, ScmEvalState *eval_state);
#endif
+#if SCM_USE_SRFI6
+/* operations-srfi6.c */
+void SigScm_Initialize_SRFI6(void);
+ScmObj ScmOp_SRFI6_open_input_string(ScmObj str);
+ScmObj ScmOp_SRFI6_open_output_string(void);
+ScmObj ScmOp_SRFI6_get_output_string(ScmObj port);
+#endif
#if SCM_USE_SRFI8
/* operations-srfi8.c */
void SigScm_Initialize_SRFI8(void);
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-10-06 23:57:16 UTC (rev 1829)
@@ -74,6 +74,10 @@
extern ScmObj SigScm_null_values;
#endif
+/* debug.c */
+#define PORTBUFFER_SIZE 1024
+extern char *scm_portbuffer;
+
/*=======================================
Macro Declarations
=======================================*/
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-10-06 23:57:16 UTC (rev 1829)
@@ -118,7 +118,7 @@
} info;
int (*getc_func) (ScmObj port);
- void (*print_func) (ScmObj port, const char* str, ...);
+ void (*print_func) (ScmObj port, const char* str);
int ungottenchar;
};
Added: branches/r5rs/sigscheme/test/test-srfi6.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi6.scm 2005-10-06 21:38:28 UTC (rev 1828)
+++ branches/r5rs/sigscheme/test/test-srfi6.scm 2005-10-06 23:57:16 UTC (rev 1829)
@@ -0,0 +1,53 @@
+;; FileName : test-exp.scm
+;; About : unit test for R5RS expressions
+;;
+;; Copyright (C) 2005 by Kazuki Ohta (mover at hct.zaq.ne.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.
+
+(load "./test/unittest.scm")
+
+(use srfi-6)
+
+
+; open-input-string
+(define p
+ (open-input-string "(a . (b . (c . ()))) 34"))
+
+(assert-true "open-input-string test 1" (input-port? p))
+(assert-equal? "open-input-string test 2" '(a b c) (read p))
+(assert-equal? "open-input-string test 3" 34 (read p))
+
+; open-output-string and get-output-string
+(assert-equal? "output string test 1" "a(b c)" (let ((q (open-output-string))
+ (x '(a b c)))
+ (write (car x) q)
+ (write (cdr x) q)
+ (get-output-string q)))
+
+(total-report)
More information about the uim-commit
mailing list