[uim-commit] r1828 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Thu Oct 6 14:38:42 PDT 2005
Author: kzk
Date: 2005-10-06 14:38:28 -0700 (Thu, 06 Oct 2005)
New Revision: 1828
Modified:
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigschemetype.h
Log:
* Port Handling Reorganization(2)
- ScmPortInfo has two function pointers for getc and print
- now SCM_PORT_GETC is a function call
- functions in debug.c is port based, instead of FILE*
FIXME:
- I want to use SCM_PORT_PRINT like this, but I cannot achieve
this. Is there any macro tric?
e.g. SCM_PORT_PRINT(port, "%s", string);
* sigscheme/read.c
- (SCM_PORT_GETC): call SCM_PORT_GETC_FUNC(port)
- (SCM_PORT_UNGETC): remove trailing ";"
* sigscheme/debug.c
- (print_ScmObj_internal,
print_char,
print_string,
print_list,
print_vector,
print_port,
print_constant): change args to use SCM_PORT_PRINT instead
of using fprintf
* sigscheme/datas.c
- (fileport_getc,
fileport_print,
stringport_getc,
stringport_print): new func
- (Scm_NewFilePort, Scm_NewStringPort): set GETC_FUNC and
PRINT_FUNC for port object
* sigscheme/sigschemetype.h
- (getc_func, print_func): new member
- (SCM_PORT_GETC_FUNC,
SCM_PORT_SET_GETC_FUNC,
SCM_PORT_PRINT_FUNC,
SCM_PORT_SET_PRINT_FUNC): removed
x
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-10-06 21:17:09 UTC (rev 1827)
+++ branches/r5rs/sigscheme/datas.c 2005-10-06 21:38:28 UTC (rev 1828)
@@ -223,6 +223,12 @@
static void enter_dynamic_extent(ScmObj dest);
static void exit_dynamic_extent(ScmObj dest);
+/* port */
+static int fileport_getc(ScmObj port);
+static void fileport_print(ScmObj port, const char *str, ...);
+static int stringport_getc(ScmObj port);
+static void stringport_print(ScmObj port, const char *str, ...);
+
/* continuation */
static void initialize_continuation_env(void);
static void finalize_continuation_env(void);
@@ -818,11 +824,35 @@
SCM_PORT_SET_FILE(obj, file);
SCM_PORT_SET_FILENAME(obj, strdup(filename));
SCM_PORT_SET_LINE(obj, 0);
+ SCM_PORT_SET_GETC_FUNC(obj, fileport_getc);
+ SCM_PORT_SET_PRINT_FUNC(obj, fileport_print);
SCM_PORT_SET_UNGOTTENCHAR(obj, 0);
return obj;
}
+static int fileport_getc(ScmObj port)
+{
+ int c = SCM_PORT_UNGOTTENCHAR(port);
+ if (!c) {
+ c = fgetc(SCM_PORT_FILE(port));
+ if (c == '\n')
+ SCM_PORT_LINE(port)++;
+ }
+
+ SCM_PORT_SET_UNGOTTENCHAR(port, 0);
+ return c;
+}
+
+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);
+}
+
ScmObj Scm_NewStringPort(const char *str)
{
ScmObj obj = SCM_FALSE;
@@ -837,11 +867,31 @@
SCM_PORT_SET_PORTTYPE(obj, PORT_STRING);
SCM_PORT_SET_STR(obj, strdup(str));
SCM_PORT_SET_STR_CURRENTPOS(obj, SCM_PORT_STR(obj));
+ SCM_PORT_SET_GETC_FUNC(obj, stringport_getc);
SCM_PORT_SET_UNGOTTENCHAR(obj, 0);
return obj;
}
+static int stringport_getc(ScmObj port)
+{
+ int c = SCM_PORT_UNGOTTENCHAR(port);
+ if (!c) {
+ c = (*SCM_PORT_STR_CURRENTPOS(port));
+ if (c == '\0')
+ c = EOF;
+ SCM_PORT_STR_CURRENTPOS(port)++;
+ }
+
+ SCM_PORT_SET_UNGOTTENCHAR(port, 0);
+ return c;
+}
+
+static void stringport_print(ScmObj port, const char *str, ...)
+{
+ /* not implemented yet */
+}
+
ScmObj Scm_NewContinuation(void)
{
ScmObj obj = SCM_FALSE;
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-10-06 21:17:09 UTC (rev 1827)
+++ branches/r5rs/sigscheme/debug.c 2005-10-06 21:38:28 UTC (rev 1828)
@@ -90,6 +90,18 @@
#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
=======================================*/
@@ -101,13 +113,13 @@
/*=======================================
File Local Function Declarations
=======================================*/
-static void print_ScmObj_internal(FILE *f, ScmObj obj, enum OutputType otype);
-static void print_char(FILE *f, ScmObj obj, enum OutputType otype);
-static void print_string(FILE *f, ScmObj obj, enum OutputType otype);
-static void print_list(FILE *f, ScmObj lst, enum OutputType otype);
-static void print_vector(FILE *f, ScmObj vec, enum OutputType otype);
-static void print_port(FILE *f, ScmObj port, enum OutputType otype);
-static void print_constant(FILE *f, ScmObj obj, enum OutputType otype);
+static void print_ScmObj_internal(ScmObj port, ScmObj obj, enum OutputType otype);
+static void print_char(ScmObj port, ScmObj obj, enum OutputType otype);
+static void print_string(ScmObj port, ScmObj obj, enum OutputType otype);
+static void print_list(ScmObj port, ScmObj lst, enum OutputType otype);
+static void print_vector(ScmObj port, ScmObj vec, enum OutputType otype);
+static void print_port(ScmObj port, ScmObj obj, enum OutputType otype);
+static void print_constant(ScmObj port, ScmObj obj, enum OutputType otype);
#if SCM_USE_SRFI38
static void hash_grow(hash_table *tab);
@@ -176,14 +188,11 @@
void SigScm_WriteToPort(ScmObj port, ScmObj obj)
{
- FILE *f = NULL;
-
if (FALSEP(port))
return;
if (SCM_PORT_PORTTYPE(port) == PORT_FILE) {
- f = SCM_PORT_FILE(port);
- print_ScmObj_internal(f, obj, AS_WRITE);
+ print_ScmObj_internal(port, obj, AS_WRITE);
#if SCM_VOLATILE_OUTPUT
fflush(f);
#endif
@@ -195,14 +204,11 @@
void SigScm_DisplayToPort(ScmObj port, ScmObj obj)
{
- FILE *f = NULL;
-
if (FALSEP(port))
return;
if (SCM_PORT_PORTTYPE(port) == PORT_FILE) {
- f = SCM_PORT_FILE(port);
- print_ScmObj_internal(f, obj, AS_DISPLAY);
+ print_ScmObj_internal(port, obj, AS_DISPLAY);
#if SCM_VOLATILE_OUTPUT
fflush(f);
#endif
@@ -212,81 +218,81 @@
SigScm_Error("SigScm_DisplayToPort : support display only for file port.");
}
-static void print_ScmObj_internal(FILE *f, ScmObj obj, enum OutputType otype)
+static void print_ScmObj_internal(ScmObj port, ScmObj obj, enum OutputType otype)
{
#if SCM_USE_SRFI38
if (INTERESTINGP(obj)) {
int index = get_shared_index(obj);
if (index > 0) {
/* defined datum */
- fprintf(f, "#%d#", index);
+ SCM_PORT_PRINT_FUNC(port)(port, "#%d#", index);
return;
}
if (index < 0) {
/* defining datum, with the new index negated */
- fprintf(f, "#%d=", -index);
+ SCM_PORT_PRINT_FUNC(port)(port, "#%d=", -index);
/* Print it; the next time it'll be defined. */
}
}
#endif
switch (SCM_TYPE(obj)) {
case ScmInt:
- fprintf(f, "%d", SCM_INT_VALUE(obj));
+ SCM_PORT_PRINT_FUNC(port)(port, "%d", SCM_INT_VALUE(obj));
break;
case ScmCons:
- print_list(f, obj, otype);
+ print_list(port, obj, otype);
break;
case ScmSymbol:
- fprintf(f, "%s", SCM_SYMBOL_NAME(obj));
+ SCM_PORT_PRINT_FUNC(port)(port, "%s", SCM_SYMBOL_NAME(obj));
break;
case ScmChar:
- print_char(f, obj, otype);
+ print_char(port, obj, otype);
break;
case ScmString:
- print_string(f, obj, otype);
+ print_string(port, obj, otype);
break;
case ScmFunc:
- fprintf(f, "#<subr>");
+ SCM_PORT_PRINT(port, "#<subr>");
break;
case ScmClosure:
- fprintf(f, "#<closure:");
- print_ScmObj_internal(f, SCM_CLOSURE_EXP(obj), otype);
- fprintf(f, ">");
+ SCM_PORT_PRINT(port, "#<closure:");
+ print_ScmObj_internal(port, SCM_CLOSURE_EXP(obj), otype);
+ SCM_PORT_PRINT(port, ">");
break;
case ScmVector:
- print_vector(f, obj, otype);
+ print_vector(port, obj, otype);
break;
case ScmPort:
- print_port(f, obj, otype);
+ print_port(port, obj, otype);
break;
case ScmContinuation:
- fprintf(f, "#<subr continuation>");
+ SCM_PORT_PRINT(port, "#<subr continuation>");
break;
case ScmValuePacket:
- fputs("#<values ", f);
+ SCM_PORT_PRINT(port, "#<values");
if (NULLP (SCM_VALUEPACKET_VALUES(obj)))
- fputs("()", f);
+ SCM_PORT_PRINT(port, "()");
else
- print_list(f, SCM_VALUEPACKET_VALUES(obj), otype);
- putc('>', f);
+ print_list(port, SCM_VALUEPACKET_VALUES(obj), otype);
+ SCM_PORT_PRINT(port, ">");
break;
case ScmConstant:
- print_constant(f, obj, otype);
+ print_constant(port, obj, otype);
break;
case ScmFreeCell:
SigScm_Error("You cannot print ScmFreeCell, may be GC bug.");
break;
case ScmCPointer:
- fprintf(f, "#<c_pointer %p>", SCM_C_POINTER_VALUE(obj));
+ SCM_PORT_PRINT_FUNC(port)(port, "#<c_pointer %p>", SCM_C_POINTER_VALUE(obj));
break;
case ScmCFuncPointer:
- fprintf(f, "#<c_func_pointer %p>",
- SCM_REINTERPRET_CAST(void *, SCM_C_FUNCPOINTER_VALUE(obj)));
+ SCM_PORT_PRINT_FUNC(port)(port, "#<c_func_pointer %p>",
+ SCM_REINTERPRET_CAST(void *, SCM_C_FUNCPOINTER_VALUE(obj)));
break;
}
}
-static void print_char(FILE *f, ScmObj obj, enum OutputType otype)
+static void print_char(ScmObj port, ScmObj obj, enum OutputType otype)
{
switch (otype) {
case AS_WRITE:
@@ -294,11 +300,11 @@
* in write, character objects are written using the #\ notation.
*/
if (strcmp(SCM_CHAR_VALUE(obj), " ") == 0) {
- fprintf(f, "#\\space");
+ SCM_PORT_PRINT(port, "#\\space");
} else if(strcmp(SCM_CHAR_VALUE(obj), "\n") == 0) {
- fprintf(f, "#\\newline");
+ SCM_PORT_PRINT(port, "#\\newline");
} else {
- fprintf(f, "#\\%s", SCM_CHAR_VALUE(obj));
+ SCM_PORT_PRINT_FUNC(port)(port, "#\\%s", SCM_CHAR_VALUE(obj));
}
break;
case AS_DISPLAY:
@@ -306,7 +312,7 @@
* in display, character objects appear in the reqpresentation as
* if writen by write-char instead of by write.
*/
- fprintf(f, "%s", SCM_CHAR_VALUE(obj));
+ SCM_PORT_PRINT(port, SCM_CHAR_VALUE(obj));
break;
default:
SigScm_Error("print_char : unknown output type");
@@ -314,7 +320,7 @@
}
}
-static void print_string(FILE *f, ScmObj obj, enum OutputType otype)
+static void print_string(ScmObj port, ScmObj obj, enum OutputType otype)
{
const char *str = SCM_STRING_STR(obj);
int size = strlen(str);
@@ -328,24 +334,24 @@
* enclosed in doublequotes, and within those strings backslash and
* doublequote characters are escaped by backslashes.
*/
- fprintf(f, "\""); /* first doublequote */
+ SCM_PORT_PRINT(port, "\""); /* first doublequote */
for (i = 0; i < size; i++) {
c = str[i];
switch (c) {
- case '\"': fprintf(f, "\\\""); break;
- case '\n': fprintf(f, "\\n"); break;
- case '\r': fprintf(f, "\\r"); break;
- case '\f': fprintf(f, "\\f"); break;
- case '\t': fprintf(f, "\\t"); break;
- case '\\': fprintf(f, "\\\\"); break;
+ case '\"': SCM_PORT_PRINT(port, "\\\""); break;
+ case '\n': SCM_PORT_PRINT(port, "\\n"); break;
+ case '\r': SCM_PORT_PRINT(port, "\\r"); break;
+ case '\f': SCM_PORT_PRINT(port, "\\f"); break;
+ case '\t': SCM_PORT_PRINT(port, "\\t"); break;
+ case '\\': SCM_PORT_PRINT(port, "\\\\"); break;
default:
- fprintf(f, "%c", str[i]); break;
+ SCM_PORT_PRINT_FUNC(port)(port, "%c", str[i]); break;
}
}
- fprintf(f, "\""); /* last doublequote */
+ SCM_PORT_PRINT(port, "\""); /* last doublequote */
break;
case AS_DISPLAY:
- fprintf(f, "%s", SCM_STRING_STR(obj));
+ SCM_PORT_PRINT(port, SCM_STRING_STR(obj));
break;
default:
SigScm_Error("print_string : unknown output type");
@@ -353,7 +359,7 @@
}
}
-static void print_list(FILE *f, ScmObj lst, enum OutputType otype)
+static void print_list(ScmObj port, ScmObj lst, enum OutputType otype)
{
ScmObj car = SCM_NULL;
#if SCM_USE_SRFI38
@@ -363,20 +369,20 @@
#endif
/* print left parenthesis */
- fprintf(f, "(");
+ SCM_PORT_PRINT(port, "(");
if (NULLP(lst)) {
- fprintf(f, ")");
+ SCM_PORT_PRINT(port, ")");
return;
}
for (;;) {
car = CAR(lst);
- print_ScmObj_internal(f, car, otype);
+ print_ScmObj_internal(port, car, otype);
lst = CDR(lst);
if (!CONSP(lst))
break;
- fputs(" ", f);
+ SCM_PORT_PRINT(port, " ");
#if SCM_USE_SRFI38
/* See if the next pair is shared. Note that the case
@@ -385,12 +391,12 @@
index = get_shared_index(lst);
if (index > 0) {
/* defined datum */
- fprintf(f, ". #%d#", index);
+ SCM_PORT_PRINT_FUNC(port)(port, ". #%d#", index);
goto close_parens_and_return;
}
if (index < 0) {
/* defining datum, with the new index negated */
- fprintf(f, ". #%d=", -index);
+ SCM_PORT_PRINT_FUNC(port)(port, ". #%d=", -index);
necessary_close_parens++;
goto cheap_recursion;
}
@@ -399,73 +405,73 @@
/* last item */
if (!NULLP(lst)) {
- fputs(" . ", f);
+ SCM_PORT_PRINT(port, " . ");
/* Callee takes care of shared data. */
- print_ScmObj_internal(f, lst, otype);
+ print_ScmObj_internal(port, lst, otype);
}
#if SCM_USE_SRFI38
close_parens_and_return:
while (necessary_close_parens--)
#endif
- fputc(')', f);
+ SCM_PORT_PRINT(port, ")");
}
-static void print_vector(FILE *f, ScmObj vec, enum OutputType otype)
+static void print_vector(ScmObj port, ScmObj vec, enum OutputType otype)
{
ScmObj *v = SCM_VECTOR_VEC(vec);
int c_len = SCM_VECTOR_LEN(vec);
int i = 0;
/* print left parenthesis with '#' */
- fprintf(f, "#(");
+ SCM_PORT_PRINT(port, "#(");
/* print each element */
for (i = 0; i < c_len; i++) {
- print_ScmObj_internal(f, v[i], otype);
+ print_ScmObj_internal(port, v[i], otype);
if (i != c_len - 1)
- fprintf(f, " ");
+ SCM_PORT_PRINT(port, " ");
}
- fprintf(f, ")");
+ SCM_PORT_PRINT(port, ")");
}
-static void print_port(FILE *f, ScmObj port, enum OutputType otype)
+static void print_port(ScmObj port, ScmObj obj, enum OutputType otype)
{
- fprintf(f, "#<");
+ SCM_PORT_PRINT(port, "#<");
/* input or output */
- if (SCM_PORT_PORTDIRECTION(port) == PORT_INPUT)
- fprintf(f, "i");
+ if (SCM_PORT_PORTDIRECTION(obj) == PORT_INPUT)
+ SCM_PORT_PRINT(port, "i");
else
- fprintf(f, "o");
+ SCM_PORT_PRINT(port, "o");
- fprintf(f, "port ");
+ SCM_PORT_PRINT(port, "port ");
/* file or string */
- if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
- fprintf(f, "file %s", SCM_PORT_FILENAME(port));
- else if (SCM_PORT_PORTTYPE(port) == PORT_STRING)
- fprintf(f, "string %s", SCM_PORT_STR(port));
+ 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));
- fprintf(f, ">");
+ SCM_PORT_PRINT(port, ">");
}
-static void print_constant(FILE *f, ScmObj obj, enum OutputType otype)
+static void print_constant(ScmObj port, ScmObj obj, enum OutputType otype)
{
if (EQ(obj, SCM_NULL))
- fprintf(f, "()");
+ SCM_PORT_PRINT(port, "()");
else if (EQ(obj, SCM_TRUE))
- fprintf(f, "#t");
+ SCM_PORT_PRINT(port, "#t");
else if (EQ(obj, SCM_FALSE))
- fprintf(f, "#f");
+ SCM_PORT_PRINT(port, "#f");
else if (EQ(obj, SCM_EOF))
- fprintf(f, "#<eof>");
+ SCM_PORT_PRINT(port, "#<eof>");
else if (EQ(obj, SCM_UNBOUND))
- fprintf(f, "#<unbound>");
+ SCM_PORT_PRINT(port, "#<unbound>");
else if (EQ(obj, SCM_UNDEF))
- fprintf(f, "#<undef>");
+ SCM_PORT_PRINT(port, "#<undef>");
}
#if SCM_USE_SRFI38
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-10-06 21:17:09 UTC (rev 1827)
+++ branches/r5rs/sigscheme/read.c 2005-10-06 21:38:28 UTC (rev 1828)
@@ -68,29 +68,11 @@
/*=======================================
File Local Macro Declarations
=======================================*/
-#define SCM_PORT_GETC(port, c) \
- do { \
- if (SCM_PORT_UNGOTTENCHAR(port)) { \
- c = SCM_PORT_UNGOTTENCHAR(port); \
- SCM_PORT_SET_UNGOTTENCHAR(port, 0); \
- } else { \
- switch (SCM_PORT_PORTTYPE(port)) { \
- case PORT_FILE: \
- c = getc(SCM_PORT_FILE(port)); \
- if (c == '\n') SCM_PORT_LINE(port)++; \
- break; \
- case PORT_STRING: \
- c = (*SCM_PORT_STR_CURRENTPOS(port)); \
- if (c == '\0') c = EOF; \
- SCM_PORT_STR_CURRENTPOS(port)++; \
- break; \
- } \
- SCM_PORT_SET_UNGOTTENCHAR(port, 0); \
- } \
- } while (0);
+#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);
+ (SCM_PORT_SET_UNGOTTENCHAR(port, c))
/*=======================================
Variable Declarations
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-10-06 21:17:09 UTC (rev 1827)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-10-06 21:38:28 UTC (rev 1828)
@@ -116,7 +116,9 @@
const char *str_currentpos;
} str_port;
} info;
-
+
+ int (*getc_func) (ScmObj port);
+ void (*print_func) (ScmObj port, const char* str, ...);
int ungottenchar;
};
@@ -352,6 +354,11 @@
#define SCM_PORT_SET_PORTTYPE(a, type) (SCM_PORT_PORTTYPE(a) = type)
#define SCM_PORT_UNGOTTENCHAR(a) (SCM_PORT_PORTINFO(a)->ungottenchar)
#define SCM_PORT_SET_UNGOTTENCHAR(a, ch) (SCM_PORT_UNGOTTENCHAR(a) = ch)
+#define SCM_PORT_GETC_FUNC(a) (SCM_PORT_PORTINFO(a)->getc_func)
+#define SCM_PORT_SET_GETC_FUNC(a, func) (SCM_PORT_GETC_FUNC(a) = func)
+#define SCM_PORT_PRINT_FUNC(a) (SCM_PORT_PORTINFO(a)->print_func)
+#define SCM_PORT_SET_PRINT_FUNC(a, func) (SCM_PORT_PRINT_FUNC(a) = func)
+
/* File Port */
#define SCM_PORT_FILE(a) (SCM_PORT_PORTINFO(a)->info.file_port.file)
#define SCM_PORT_SET_FILE(a, file) (SCM_PORT_FILE(a) = file)
More information about the uim-commit
mailing list