Author: kzk
Date: Fri Aug 12 08:02:10 2005
New Revision: 1189
Modified:
branches/r5rs/sigscheme/encoding.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/test/test-char.scm
branches/r5rs/sigscheme/test/test-string.scm
branches/r5rs/sigscheme/test/unittest.scm
Log:
* sigscheme/eval.c
- (ScmExp_let_star): handle SCM_NIL binding correctly
* sigscheme/encoding.c
- (eucj_str_startpos): return current pos when len < k
* sigscheme/operations.c
- (ScmOp_make_string): handle len == 0
- (ScmOp_string_substring): handle start == end
- (ScmOp_string_append): handle arg is SCM_NIL
* sigscheme/read.c
- (read_word): new func
- (read_char, read_char_sequence): handle #\(, #\), #\Space
* sigscheme/test/test-char.scm
- add test case for #\( and #\)
* sigscheme/test/test-string.scm
- fix wrong substring test case
* sigscheme/test/unittest.scm
- remove unnecessary \n
Modified: branches/r5rs/sigscheme/encoding.c
==============================================================================
--- branches/r5rs/sigscheme/encoding.c (original)
+++ branches/r5rs/sigscheme/encoding.c Fri Aug 12 08:02:10 2005
@@ -117,8 +117,7 @@
len++;
}
- SigScm_Error("eucjp_str_startpos : unreachable point\n");
- return NULL;
+ return (const char*)cur;
}
static const char* eucjp_str_endpos(const char *str, int k)
Modified: branches/r5rs/sigscheme/eval.c
==============================================================================
--- branches/r5rs/sigscheme/eval.c (original)
+++ branches/r5rs/sigscheme/eval.c Fri Aug 12 08:02:10 2005
@@ -1095,7 +1095,7 @@
(<variable2> <init2>)
...)
========================================================================*/
- if (SCM_CONSP(bindings) || SCM_NULLP(bindings)) {
+ if (SCM_CONSP(bindings)) {
for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
binding = SCM_CAR(bindings);
vars = Scm_NewCons(SCM_CAR(binding), SCM_NIL);
@@ -1104,10 +1104,19 @@
/* add env to each time!*/
env = extend_environment(vars, vals, env);
}
+ /* set new env */
+ *envp = env;
+ /* evaluate */
+ return ScmExp_begin(body, &env, tail_flag);
+ } else if (SCM_NULLP(bindings)) {
+ /* extend null environment */
+ env = extend_environment(Scm_NewCons(SCM_NIL, SCM_NIL),
+ Scm_NewCons(SCM_NIL, SCM_NIL),
+ env);
/* set new env */
*envp = env;
-
+ /* evaluate */
return ScmExp_begin(body, &env, tail_flag);
}
Modified: branches/r5rs/sigscheme/operations.c
==============================================================================
--- branches/r5rs/sigscheme/operations.c (original)
+++ branches/r5rs/sigscheme/operations.c Fri Aug 12 08:02:10 2005
@@ -1337,9 +1337,10 @@
SigScm_ErrorObj("make-string : character required but got ",
SCM_CAR(SCM_CDR(arg)));
len = SCM_INT_VALUE(SCM_CAR(arg));
- if (argc == 1) {
+ if (len == 0)
+ return Scm_NewStringCopying("");
+ if (argc == 1)
return Scm_NewString_With_StrLen(NULL, len);
- }
str = Scm_NewString_With_StrLen(NULL, len);
ch = SCM_CAR(SCM_CDR(arg));
@@ -1462,9 +1463,15 @@
/* get start_ptr and end_ptr */
c_start_index = SCM_INT_VALUE(start);
c_end_index = SCM_INT_VALUE(end);
+
+ /* sanity check */
+ if (c_start_index == c_end_index)
+ return Scm_NewStringCopying("");
+
+ /* get str */
string_str = SCM_STRING_STR(str);
ch_start_ptr = SigScm_default_encoding_str_startpos(string_str,
c_start_index);
- ch_end_ptr = SigScm_default_encoding_str_endpos(string_str,
c_end_index);
+ ch_end_ptr = SigScm_default_encoding_str_startpos(string_str,
c_end_index);
/* copy from start_ptr to end_ptr */
new_str = (char*)malloc(sizeof(char) * (ch_end_ptr - ch_start_ptr) + 1);
@@ -1483,6 +1490,10 @@
char *new_str = NULL;
char *p = NULL;
+ /* sanity check */
+ if (SCM_NULLP(arg))
+ return Scm_NewStringCopying("");
+
/* count total size of the new string */
for (strings = arg; !SCM_NULLP(strings); strings = SCM_CDR(strings)) {
obj = SCM_CAR(strings);
@@ -1558,6 +1569,9 @@
if (EQ(ScmOp_listp(list), SCM_FALSE))
SigScm_ErrorObj("list->string : list required but got ", list);
+
+ if (SCM_NULLP(list))
+ return Scm_NewStringCopying("");
/* count total size of the string */
for (chars = list; !SCM_NULLP(chars); chars = SCM_CDR(chars)) {
Modified: branches/r5rs/sigscheme/read.c
==============================================================================
--- branches/r5rs/sigscheme/read.c (original)
+++ branches/r5rs/sigscheme/read.c Fri Aug 12 08:02:10 2005
@@ -81,6 +81,7 @@
File Local Function Declarations
=======================================*/
static int skip_comment_and_space(ScmObj port);
+static char* read_word(ScmObj port);
static char* read_char_sequence(ScmObj port);
static ScmObj read_sexpression(ScmObj port);
@@ -280,7 +281,7 @@
* Gauche behave).
*/
SCM_PORT_UNGETC(port, c2);
- token = read_char_sequence(port);
+ token = read_word(port);
dotsym = (char*)malloc(sizeof(char) * (strlen(token) + 1 + 1));
memmove (dotsym + 1, token, strlen(token)+1);
dotsym[0] = '.';
@@ -306,7 +307,7 @@
}
static ScmObj read_char(ScmObj port)
-{
+{
char *ch = read_char_sequence(port);
#if DEBUG_PARSER
@@ -317,6 +318,9 @@
if (strcmp(ch, "space") == 0) {
ch[0] = ' ';
ch[1] = '\0';
+ } else if (strcmp(ch, "Space") == 0) {
+ ch[0] = ' ';
+ ch[1] = '\0';
} else if (strcmp(ch, "newline") == 0) {
ch[0] = '\n';
ch[1] = '\0';
@@ -368,7 +372,7 @@
default:
stringbuf[stringlen] = '\\';
stringbuf[++stringlen] = c;
- break;
+ break;
}
stringlen++;
@@ -387,7 +391,7 @@
static ScmObj read_symbol(ScmObj port)
{
- char *sym_name = read_char_sequence(port);
+ char *sym_name = read_word(port);
ScmObj sym = Scm_Intern(sym_name);
free(sym_name);
@@ -411,7 +415,7 @@
#endif
/* read char sequence */
- str = read_char_sequence(port);
+ str = read_word(port);
str_len = strlen(str);
if (strlen(str) == 1
@@ -455,7 +459,7 @@
}
-static char *read_char_sequence(ScmObj port)
+static char *read_word(ScmObj port)
{
char stringbuf[1024];
int stringlen = 0;
@@ -475,14 +479,50 @@
break;
case ' ':
- /* pass through the first ' ' for handling space (#\ ) */
+ case '(': case ')': case ';':
+ case '\n': case '\t': case '\"': case '\'':
+ SCM_PORT_UNGETC(port, c);
+ stringbuf[stringlen] = '\0';
+ dst = (char *)malloc(strlen(stringbuf) + 1);
+ strcpy(dst, stringbuf);
+ return dst;
+
+ default:
+ stringbuf[stringlen] = (char)c;
+ stringlen++;
+ break;
+ }
+ }
+}
+
+static char *read_char_sequence(ScmObj port)
+{
+ char stringbuf[1024];
+ int stringlen = 0;
+ int c = 0;
+ char *dst = NULL;
+
+ while (1) {
+ SCM_PORT_GETC(port, c);
+
+#if DEBUG_PARSER
+ printf("c = %c\n", c);
+#endif
+
+ switch (c) {
+ case EOF:
+ SigScm_Error("EOF in the char sequence.\n");
+ break;
+
+ /* pass through first char */
+ case ' ': case '\"': case '\'':
+ case '(': case ')': case ';':
if (stringlen == 0) {
stringbuf[stringlen] = (char)c;
stringlen++;
break;
}
- case '(': case ')': case ';':
- case '\n': case '\t': case '\"': case '\'':
+ case '\n': case '\t':
SCM_PORT_UNGETC(port, c);
stringbuf[stringlen] = '\0';
dst = (char *)malloc(strlen(stringbuf) + 1);
Modified: branches/r5rs/sigscheme/test/test-char.scm
==============================================================================
--- branches/r5rs/sigscheme/test/test-char.scm (original)
+++ branches/r5rs/sigscheme/test/test-char.scm Fri Aug 12 08:02:10 2005
@@ -6,5 +6,7 @@
(assert "space 2" (char? #\ ))
(assert "newline" (char? #\newline))
(assert "hiragana char" (char? #\ ))
+(assert "( char" (char? #\())
+(assert ") char" (char? #\)))
(total-report)
Modified: branches/r5rs/sigscheme/test/test-string.scm
==============================================================================
--- branches/r5rs/sigscheme/test/test-string.scm (original)
+++ branches/r5rs/sigscheme/test/test-string.scm Fri Aug 12 08:02:10 2005
@@ -1,4 +1,4 @@
-(load "test/unittest.scm")
+(load "./test/unittest.scm")
;; check string?
(assert "string? check" (string? "aiueo"))
@@ -43,9 +43,9 @@
;; substring check
-(assert "alphabet substring check" (string=? "iue" (substring "aiueo" 1 3)))
-(assert "hiragana substring check" (string=? " " (substring " "
1 3)))
-(assert "mixed substring check" (string=? " u " (substring "a u o" 1
3)))
+(assert "alphabet substring check" (string=? "iu" (substring "aiueo" 1 3)))
+(assert "hiragana substring check" (string=? " " (substring " " 1
3)))
+(assert "mixed substring check" (string=? " u" (substring "a u o" 1 3)))
;; string-append check
Modified: branches/r5rs/sigscheme/test/unittest.scm
==============================================================================
--- branches/r5rs/sigscheme/test/unittest.scm (original)
+++ branches/r5rs/sigscheme/test/unittest.scm Fri Aug 12 08:02:10 2005
@@ -8,7 +8,7 @@
; (print "total")
; (print total-test-num)
(if (= total-err-num 0)
- (print "OK\n")
+ (print "OK")
(begin
(print "[ ERROR NUM ]\n")
(print total-err-num)
