[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