[uim-commit] r1080 - in branches/r5rs/sigscheme: . test
kzk at freedesktop.org
kzk at freedesktop.org
Sun Jul 31 15:59:51 EST 2005
Author: kzk
Date: 2005-07-30 22:59:49 -0700 (Sat, 30 Jul 2005)
New Revision: 1080
Modified:
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemetype.h
branches/r5rs/sigscheme/test/test-define.scm
Log:
* This commit aims to...
- move "port_type" to struct ScmPortInfo
- implement "write" and "display" distinction as defined
in R5RS.
- add "print" procedure for convinience
* sigscheme/io.c
- (ScmOp_write): use SigScm_WriteToPort instead of
SigScm_DisplayToPort.
- (ScmOp_print): new func
* sigscheme/sigscheme.c
- (SigScm_Initialize): export "print"
* sigscheme/read.c
- (SCM_PORT_GETC, skip_comment_and_space, read_list)
: use SCM_PORTINFO_PORTTYPE instead of SCM_PORT_PORTTYPE
- (read_string): add support for "\r", "\f"
* sigscheme/sigscheme.h
- (ScmOp_print, ScmOp_WriteToPort): new func
* sigscheme/sigschemetype.h
- move port_type to struct ScmPortInfo
* sigscheme/debug.c (THIS FILE IS LARGELY REWRITTEN BY THIS COMMIT)
- (enum OutputType): new enumeration
- (print_char, print_string, print_port, print_etc): new func
- (SigScm_Display): change args of print_ScmObj_internal
- (SigScm_WriteToPort): new func
- (SigScm_DisplayToPort): check port type and change args of
print_ScmObj_internal
- (print_ScmObj_internal): change args and rewrite "switch" based
- (print_list, print_vector): change args
* sigscheme/datas.c
- (gc_mark_protected_obj): initialize "item" variable
- (Scm_NewFilePort, Scm_NewStringPort): apply structure's change
of port_type
* sigscheme/test/test-define
- add testcase for internal define
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/datas.c 2005-07-31 05:59:49 UTC (rev 1080)
@@ -360,7 +360,7 @@
static void gc_mark_protected_obj(void)
{
- gc_protected_obj *item;
+ gc_protected_obj *item = NULL;
for (item = protected_obj_list; item; item = item->next_obj) {
mark_obj(item->obj);
}
@@ -659,7 +659,7 @@
SCM_SETPORT(obj);
SCM_SETPORT_PORTDIRECTION(obj, pdirection);
- SCM_SETPORT_PORTTYPE(obj, PORT_FILE);
+ pinfo->port_type = PORT_FILE;
pinfo->info.file_port.file = file;
pinfo->info.file_port.filename = (char*)malloc(sizeof(char) * strlen(filename) + 1);
strcpy(pinfo->info.file_port.filename, filename);
@@ -679,7 +679,7 @@
SCM_SETPORT(obj);
SCM_SETPORT_PORTDIRECTION(obj, PORT_INPUT);
- SCM_SETPORT_PORTTYPE(obj, PORT_STRING);
+ pinfo->port_type = PORT_STRING;
pinfo->info.str_port.port_str = (char *)malloc(strlen(str) + 1);
strcpy(pinfo->info.str_port.port_str, str);
pinfo->info.str_port.str_current = pinfo->info.str_port.port_str;
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/debug.c 2005-07-31 05:59:49 UTC (rev 1080)
@@ -44,6 +44,11 @@
/*=======================================
File Local Struct Declarations
=======================================*/
+enum OutputType {
+ AS_WRITE, /* string is enclosed by ", char is written using #\ notation. */
+ AS_DISPLAY, /* string and char is written as-is */
+ UNKNOWN
+};
/*=======================================
File Local Macro Declarations
@@ -56,98 +61,165 @@
/*=======================================
File Local Function Declarations
=======================================*/
-static void print_ScmObj_internal(FILE *f, ScmObj obj);
-static void print_list(FILE *f, ScmObj list);
-static void print_vector(FILE *f, ScmObj vec);
+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 list, 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_etc(FILE *f, ScmObj obj, enum OutputType otype);
/*=======================================
Function Implementations
=======================================*/
void SigScm_Display(ScmObj obj)
{
- print_ScmObj_internal(SCM_PORTINFO_FILE(current_output_port), obj);
+ print_ScmObj_internal(SCM_PORTINFO_FILE(current_output_port), obj, AS_WRITE);
fprintf(SCM_PORTINFO_FILE(current_output_port), "\n");
}
+void SigScm_WriteToPort(ScmObj port, ScmObj obj)
+{
+ FILE *f = NULL;
+
+ if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
+ f = SCM_PORTINFO_FILE(port);
+ print_ScmObj_internal(f, obj, AS_WRITE);
+ return;
+ }
+
+ SigScm_Error("SigScm_WriteToPort : support write only for file port.");
+}
+
void SigScm_DisplayToPort(ScmObj port, ScmObj obj)
{
- FILE *f = SCM_PORTINFO_FILE(port);
- print_ScmObj_internal(f, obj);
+ FILE *f = NULL;
+
+ if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
+ f = SCM_PORTINFO_FILE(port);
+ print_ScmObj_internal(f, obj, AS_DISPLAY);
+ return;
+ }
+
+ SigScm_Error("SigScm_DisplayToPort : support display only for file port.");
}
-static void print_ScmObj_internal(FILE *f, ScmObj obj)
+static void print_ScmObj_internal(FILE *f, ScmObj obj, enum OutputType otype)
{
- if (SCM_CONSP(obj)) {
- print_list(f, obj);
- } else if (SCM_INTP(obj)) {
- fprintf(f, "%d", SCM_INT_VALUE(obj));
- } else if (SCM_SYMBOLP(obj)) {
- fprintf(f, "%s", SCM_SYMBOL_NAME(obj));
- } else if (SCM_CHARP(obj)) {
- if (strcmp(SCM_CHAR_CH(obj), " ") == 0)
- fprintf(f, "#\\space");
- else if(strcmp(SCM_CHAR_CH(obj), "\n") == 0)
- fprintf(f, "#\\newline");
- else
- fprintf(f, "#\\%s", SCM_CHAR_CH(obj));
- } else if (SCM_STRINGP(obj)) {
- fprintf(f, "%s", SCM_STRING_STR(obj));
- } else if (SCM_FUNCP(obj)) {
- fprintf(f, "[ Func ]");
- } else if (SCM_CLOSUREP(obj)) {
- fprintf(f, "#<closure:");
- print_ScmObj_internal(f, SCM_CLOSURE_EXP(obj));
- fprintf(f, ">");
- } else if (SCM_VECTORP(obj)) {
- print_vector(f, obj);
- } else if (SCM_FREECELLP(obj)) {
- fprintf(f, "[ FreeCell ] \n");
- } else if (SCM_PORTP(obj)) {
- fprintf(f, "#<");
- /* input or output */
- if (SCM_PORT_PORTDIRECTION(obj) == PORT_INPUT)
- fprintf(f, "i");
- else
- fprintf(f, "o");
- fprintf(f, "port ");
- /* file or string */
- if (SCM_PORT_PORTTYPE(obj) == PORT_FILE) {
- fprintf(f, "file %s", SCM_PORTINFO_FILENAME(obj));
- } else if (SCM_PORT_PORTTYPE(obj) == PORT_STRING) {
- fprintf(f, "string");
- }
- fprintf(f, ">");
- } else if (SCM_CONTINUATIONP(obj)) {
- fprintf(f, "(continuation)");
- } else {
- if (EQ(obj, SCM_NIL)) {
- fprintf(f, "()");
- } else if (EQ(obj, SCM_TRUE)) {
- fprintf(f, "#t");
- } else if (EQ(obj, SCM_FALSE)) {
- fprintf(f, "#f");
- } else if (EQ(obj, SCM_EOF)) {
- fprintf(f, "EOF");
- } else if (EQ(obj, SCM_QUOTE)) {
- fprintf(f, "QUOTE");
- } else if (EQ(obj, SCM_QUASIQUOTE)) {
- fprintf(f, "QUASIQUOTE");
- } else if (EQ(obj, SCM_UNQUOTE)) {
- fprintf(f, "UNQUOTE");
- } else if (EQ(obj, SCM_UNQUOTE_SPLICING)) {
- fprintf(f, "UNQUOTE_SPLICING");
- } else if (EQ(obj, SCM_UNBOUND)) {
- fprintf(f, "UNBOUND");
- } else if (EQ(obj, SCM_UNSPECIFIED)) {
- fprintf(f, "UNSPECIFIED");
- } else if (EQ(obj, SCM_UNDEF)) {
- fprintf(f, "UNDEF");
- }
+ switch (SCM_GETTYPE(obj)) {
+ case ScmInt:
+ fprintf(f, "%d", SCM_INT_VALUE(obj));
+ break;
+ case ScmCons:
+ print_list(f, obj, otype);
+ break;
+ case ScmSymbol:
+ fprintf(f, "%s", SCM_SYMBOL_NAME(obj));
+ break;
+ case ScmChar:
+ print_char(f, obj, otype);
+ break;
+ case ScmString:
+ print_string(f, obj, otype);
+ break;
+ case ScmFunc:
+ fprintf(f, "#<subr>");
+ break;
+ case ScmClosure:
+ fprintf(f, "#<closure:");
+ print_ScmObj_internal(f, SCM_CLOSURE_EXP(obj), otype);
+ fprintf(f, ">");
+ break;
+ case ScmVector:
+ print_vector(f, obj, otype);
+ break;
+ case ScmPort:
+ print_port(f, obj, otype);
+ break;
+ case ScmContinuation:
+ fprintf(f, "#<subr continuation>");
+ break;
+ case ScmEtc:
+ print_etc(f, obj, otype);
+ break;
+ case ScmCPointer:
+ fprintf(f, "#<c_pointer %p>", SCM_C_POINTER_DATA(obj));
+ break;
+ case ScmCFuncPointer:
+ fprintf(f, "#<c_func_pointer %p>", (void*)SCM_C_FUNCPOINTER_FUNC(obj));
+ break;
+ case ScmFreeCell:
+ SigScm_Error("You cannot print ScmFreeCell, may be GC bug.\n");
+ break;
+ }
+}
+
+static void print_char(FILE *f, ScmObj obj, enum OutputType otype)
+{
+ switch (otype) {
+ case AS_WRITE:
+ /*
+ * in write, character objects are written using the #\ notation.
+ */
+ if (strcmp(SCM_CHAR_CH(obj), " ") == 0) {
+ fprintf(f, "#\\space");
+ } else if(strcmp(SCM_CHAR_CH(obj), "\n") == 0) {
+ fprintf(f, "#\\newline");
+ } else {
+ fprintf(f, "#\\%s", SCM_CHAR_CH(obj));
+ }
+ break;
+ case AS_DISPLAY:
+ /*
+ * in display, character objects appear in the reqpresentation as
+ * if writen by write-char instead of by write.
+ */
+ fprintf(f, "%s", SCM_CHAR_CH(obj));
+ break;
+ default:
+ SigScm_Error("print_char : unknown output type\n");
}
}
-static void print_list(FILE *f, ScmObj list)
+static void print_string(FILE *f, ScmObj obj, enum OutputType otype)
{
+ const char *str = SCM_STRING_STR(obj);
+ int size = strlen(str);
+ int i = 0;
+ char c = 0;
+
+ switch (otype) {
+ case AS_WRITE:
+ /*
+ * in write, strings that appear in the written representation are
+ * enclosed in doublequotes, and within those strings backslash and
+ * doublequote characters are escaped by backslashes.
+ */
+ fprintf(f, "\""); /* 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;
+ default:
+ fprintf(f, "%c", str[i]); break;
+ }
+ }
+ fprintf(f, "\""); /* last doublequote */
+ break;
+ case AS_DISPLAY:
+ fprintf(f, "%s", SCM_STRING_STR(obj));
+ break;
+ default:
+ SigScm_Error("print_string : unknown output type\n");
+ }
+}
+
+static void print_list(FILE *f, ScmObj list, enum OutputType otype)
+{
ScmObj car = SCM_NIL;
ScmObj cdr = SCM_NIL;
ScmObj tmp = SCM_NIL;
@@ -160,14 +232,14 @@
cdr = SCM_CDR(list);
/* print car */
- print_ScmObj_internal(f, car);
+ print_ScmObj_internal(f, car, otype);
if (!SCM_NULLP(cdr))
fprintf(f, " ");
/* print else for-each */
for (tmp = cdr; ; tmp = SCM_CDR(tmp)) {
if (SCM_CONSP(tmp)) {
- print_ScmObj_internal(f, SCM_CAR(tmp));
+ print_ScmObj_internal(f, SCM_CAR(tmp), otype);
if (SCM_NULLP(SCM_CDR(tmp))) {
fprintf(f, ")");
return;
@@ -178,7 +250,7 @@
} else {
if (!SCM_NULLP(tmp)) {
fprintf(f, ". ");
- print_ScmObj_internal(f, tmp);
+ print_ScmObj_internal(f, tmp, otype);
}
fprintf(f, ")");
@@ -187,7 +259,7 @@
}
}
-static void print_vector(FILE *f, ScmObj vec)
+static void print_vector(FILE *f, ScmObj vec, enum OutputType otype)
{
ScmObj *v = SCM_VECTOR_VEC(vec);
int c_len = SCM_VECTOR_LEN(vec);
@@ -198,7 +270,7 @@
/* print each element */
for (i = 0; i < c_len; i++) {
- print_ScmObj_internal(f, v[i]);
+ print_ScmObj_internal(f, v[i], otype);
if (i != c_len - 1)
fprintf(f, " ");
@@ -206,3 +278,53 @@
fprintf(f, ")");
}
+
+static void print_port(FILE *f, ScmObj port, enum OutputType otype)
+{
+ fprintf(f, "#<");
+
+ /* input or output */
+ if (SCM_PORT_PORTDIRECTION(port) == PORT_INPUT) {
+ fprintf(f, "i");
+ } else {
+ fprintf(f, "o");
+ }
+
+ fprintf(f, "port ");
+
+ /* file or string */
+ if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
+ fprintf(f, "file %s", SCM_PORTINFO_FILENAME(port));
+ } else if (SCM_PORTINFO_PORTTYPE(port) == PORT_STRING) {
+ fprintf(f, "string");
+ }
+
+ fprintf(f, ">");
+}
+
+static void print_etc(FILE *f, ScmObj obj, enum OutputType otype)
+{
+ if (EQ(obj, SCM_NIL)) {
+ fprintf(f, "()");
+ } else if (EQ(obj, SCM_TRUE)) {
+ fprintf(f, "#t");
+ } else if (EQ(obj, SCM_FALSE)) {
+ fprintf(f, "#f");
+ } else if (EQ(obj, SCM_EOF)) {
+ fprintf(f, "#<eof>");
+ } else if (EQ(obj, SCM_QUOTE)) {
+ fprintf(f, "#<quote>");
+ } else if (EQ(obj, SCM_QUASIQUOTE)) {
+ fprintf(f, "#<quasiquote>");
+ } else if (EQ(obj, SCM_UNQUOTE)) {
+ fprintf(f, "#<unquote>");
+ } else if (EQ(obj, SCM_UNQUOTE_SPLICING)) {
+ fprintf(f, "#<unquote_splicing>");
+ } else if (EQ(obj, SCM_UNBOUND)) {
+ fprintf(f, "#<unbound>");
+ } else if (EQ(obj, SCM_UNSPECIFIED)) {
+ fprintf(f, "#<unspecified>");
+ } else if (EQ(obj, SCM_UNDEF)) {
+ fprintf(f, "#<undef>");
+ }
+}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/io.c 2005-07-31 05:59:49 UTC (rev 1080)
@@ -317,10 +317,6 @@
/*===========================================================================
R5RS : 6.6 Input and Output : 6.6.3 Output
===========================================================================*/
-
-/*
- * TODO : implement this properly!!!
- */
ScmObj ScmOp_write(ScmObj arg, ScmObj env)
{
ScmObj obj = SCM_NIL;
@@ -338,13 +334,10 @@
if (!SCM_NULLP(arg) && !SCM_NULLP(SCM_CAR(arg)) && SCM_PORTP(SCM_CAR(arg)))
port = SCM_CAR(arg);
- SigScm_DisplayToPort(port, obj);
+ SigScm_WriteToPort(port, obj);
return SCM_UNDEF;
}
-/*
- * TODO : implement this properly!!!
- */
ScmObj ScmOp_display(ScmObj arg, ScmObj env)
{
ScmObj obj = SCM_NIL;
@@ -368,6 +361,31 @@
return SCM_UNDEF;
}
+ScmObj ScmOp_print(ScmObj arg, ScmObj env)
+{
+ ScmObj obj = SCM_NIL;
+ ScmObj port = SCM_NIL;
+
+ if CHECK_1_ARG(arg)
+ SigScm_Error("print : invalid parameter\n");
+
+ /* get obj */
+ obj = SCM_CAR(arg);
+ arg = SCM_CDR(arg);
+
+ /* get port */
+ port = current_output_port;
+
+ /* (display obj port) */
+ if (!SCM_NULLP(arg) && SCM_PORTP(SCM_CAR(arg)))
+ port = SCM_CAR(arg);
+
+ SigScm_DisplayToPort(port, obj);
+ SigScm_DisplayToPort(port, Scm_NewStringCopying("\n"));
+ return SCM_UNDEF;
+
+}
+
ScmObj ScmOp_newline(ScmObj arg, ScmObj env)
{
/* get port */
@@ -422,8 +440,7 @@
/* open port */
port = ScmOp_open_input_file(Scm_NewStringCopying(c_filename));
s_expression = SCM_NIL;
-
-
+
/* read & eval cycle */
for (s_expression = SigScm_Read(port);
!EQ(s_expression, SCM_EOF);
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/read.c 2005-07-31 05:59:49 UTC (rev 1080)
@@ -57,7 +57,7 @@
c = SCM_PORTINFO_UNGOTTENCHAR(port); \
SCM_PORTINFO_UNGOTTENCHAR(port) = 0; \
} else { \
- switch (SCM_PORT_PORTTYPE(port)) { \
+ switch (SCM_PORTINFO_PORTTYPE(port)) { \
case PORT_FILE: \
c = getc(SCM_PORTINFO_FILE(port)); \
break; \
@@ -125,7 +125,7 @@
while (1) {
SCM_PORT_GETC(port, c);
if (c == '\n') {
- if (SCM_PORT_PORTTYPE(port) == PORT_FILE) {
+ if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
SCM_PORTINFO_LINE(port)++;
}
break;
@@ -134,7 +134,7 @@
}
continue;
} else if(c == '\n') {
- if (SCM_PORT_PORTTYPE(port) == PORT_FILE) {
+ if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
SCM_PORTINFO_LINE(port)++;
}
continue;
@@ -243,7 +243,7 @@
#endif
if (c == EOF) {
- if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
+ if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE)
SigScm_Error("EOF inside list. (starting from line %d)\n", line + 1);
else
SigScm_Error("EOF inside list.\n");
@@ -344,15 +344,11 @@
*/
SCM_PORT_GETC(port, c);
switch (c) {
- case '\"':
- stringbuf[stringlen] = c;
- break;
- case 'n':
- stringbuf[stringlen] = '\n';
- break;
- case 't':
- stringbuf[stringlen] = '\t';
- break;
+ case '\"': stringbuf[stringlen] = c; break;
+ case 'n': stringbuf[stringlen] = '\n'; break;
+ case 'r': stringbuf[stringlen] = '\r'; break;
+ case 'f': stringbuf[stringlen] = '\f'; break;
+ case 't': stringbuf[stringlen] = '\t'; break;
default:
stringbuf[stringlen] = '\\';
stringbuf[++stringlen] = c;
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-07-31 05:59:49 UTC (rev 1080)
@@ -253,7 +253,7 @@
Scm_InitSubr1("eof-object?" , ScmOp_eof_objectp);
Scm_InitSubrL("write" , ScmOp_write);
Scm_InitSubrL("display" , ScmOp_display);
- Scm_InitSubrL("print" , ScmOp_display);
+ Scm_InitSubrL("print" , ScmOp_print);
Scm_InitSubrL("newline" , ScmOp_newline);
Scm_InitSubrL("write-char" , ScmOp_write_char);
Scm_InitSubr1("load" , ScmOp_load);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-07-31 05:59:49 UTC (rev 1080)
@@ -306,6 +306,7 @@
ScmObj ScmOp_char_readyp(ScmObj arg, ScmObj env);
ScmObj ScmOp_write(ScmObj arg, ScmObj env);
ScmObj ScmOp_display(ScmObj arg, ScmObj env);
+ScmObj ScmOp_print(ScmObj arg, ScmObj env);
ScmObj ScmOp_newline(ScmObj arg, ScmObj env);
ScmObj ScmOp_write_char(ScmObj arg, ScmObj env);
@@ -330,6 +331,7 @@
/* debug.c */
void SigScm_Display(ScmObj obj);
+void SigScm_WriteToPort(ScmObj port, ScmObj obj);
void SigScm_DisplayToPort(ScmObj port, ScmObj obj);
#if USE_SRFI1
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-07-31 05:59:49 UTC (rev 1080)
@@ -101,6 +101,8 @@
/* ScmPort Info */
typedef struct _ScmPortInfo ScmPortInfo;
struct _ScmPortInfo {
+ enum ScmPortType port_type; /* (PORT_FILE | PORT_STRING) */
+
union {
struct {
FILE *file;
@@ -201,7 +203,6 @@
struct ScmPort {
enum ScmPortDirection port_direction; /* (PORT_INPUT | PORT_OUTPUT) */
- enum ScmPortType port_type; /* (PORT_FILE | PORT_STRING) */
ScmPortInfo *port_info;
} port;
@@ -317,12 +318,11 @@
#define SCM_PORTP(a) (SCM_GETTYPE(a) == ScmPort)
#define SCM_PORT(a) (sigassert(SCM_PORTP(a)), a)
#define SCM_PORT_PORTDIRECTION(a) (SCM_PORT(a)->obj.port.port_direction)
-#define SCM_PORT_PORTTYPE(a) (SCM_PORT(a)->obj.port.port_type)
#define SCM_PORT_PORTINFO(a) (SCM_PORT(a)->obj.port.port_info)
#define SCM_SETPORT(a) (SCM_SETTYPE(a, ScmPort))
#define SCM_SETPORT_PORTDIRECTION(a, pdirection) (SCM_PORT_PORTDIRECTION(a) = pdirection)
-#define SCM_SETPORT_PORTTYPE(a, ptype) (SCM_PORT_PORTTYPE(a) = ptype)
#define SCM_SETPORT_PORTINFO(a, pinfo) (SCM_PORT_PORTINFO(a) = pinfo)
+#define SCM_PORTINFO_PORTTYPE(a) (SCM_PORT_PORTINFO(a)->port_type)
#define SCM_PORTINFO_FILE(a) (SCM_PORT_PORTINFO(a)->info.file_port.file)
#define SCM_PORTINFO_FILENAME(a) (SCM_PORT_PORTINFO(a)->info.file_port.filename)
#define SCM_PORTINFO_LINE(a) (SCM_PORT_PORTINFO(a)->info.file_port.line)
Modified: branches/r5rs/sigscheme/test/test-define.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-define.scm 2005-07-31 05:12:55 UTC (rev 1079)
+++ branches/r5rs/sigscheme/test/test-define.scm 2005-07-31 05:59:49 UTC (rev 1080)
@@ -56,6 +56,15 @@
(+ c 3))
(idefine-i a))
-(assert-eq? "internal define" 5 (idefine-o 2))
+(assert-eq? "internal define1" 5 (idefine-o 2))
+(define (idefine0 a)
+ (define (idefine1 . args)
+ (apply + args))
+ (define (idefine2 c)
+ (+ c 2))
+ (+ (idefine1 1 2 3 4 5) (idefine2 a)))
+
+(assert-eq? "internal define2" 17 (idefine0 0))
+
(total-report)
More information about the uim-commit
mailing list