[uim-commit] r1333 - in branches/r5rs/sigscheme: . test
kzk at freedesktop.org
kzk at freedesktop.org
Fri Aug 26 04:56:13 PDT 2005
Author: kzk
Date: 2005-08-26 04:56:08 -0700 (Fri, 26 Aug 2005)
New Revision: 1333
Modified:
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/test/bigloo-bchar.scm
branches/r5rs/sigscheme/test/io.scm
branches/r5rs/sigscheme/test/test-num.scm
Log:
* Apply patch from Jun Inoue<jun.lambda at gmail.com>. Thank you!!
* sigscheme/read.c
- (parse_number): new function for parsing "#b100" like
representation of number
- (read_sexpression):
- call parse_number() if 'b''o''d''x' appear right after '#'
- remove unnecessary code
- (read_list): use realloc instead of using malloc
- (read_string): now can use "\\"
- (read_number_or_string): simplify code by using strtol
- (read_quote): use SCM_LIST_2
* sigscheme/operations.c
- (ScmOp_make_vector): allow (make-vector n '())
- (ScmOp_force): not to create unnecessary cons-cell
* sigscheme/eval.c
- (ScmOp_eval): remove invalid comment
- (ScmExp_cond): allow (() expr) clause
* sigscheme/test/test-num.scm
- add test cases for parse_number
* sigscheme/test/io.scm
- change message
* sigscheme/test/bigloo-bchar.scm
- comment out unsupported feature "char->integer" and
"integer->char"
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-26 11:41:32 UTC (rev 1332)
+++ branches/r5rs/sigscheme/eval.c 2005-08-26 11:56:08 UTC (rev 1333)
@@ -260,7 +260,6 @@
tmp = ScmOp_eval(tmp, env);
break;
case ScmEtc:
- /* QUOTE case */
break;
default:
SigScm_ErrorObj("eval : invalid operation ", obj);
@@ -1038,11 +1037,11 @@
/* looping in each clause */
for (; !NULLP(arg); arg = CDR(arg)) {
clause = CAR(arg);
- test = CAR(clause);
- exps = CDR(clause);
+ if (!CONSP(clause))
+ SigScm_ErrorObj("cond : bad clause: ", clause);
- if (NULLP(clause) || NULLP(test))
- SigScm_Error("cond : syntax error\n");
+ test = CAR(clause);
+ exps = CDR(clause);
/* evaluate test */
test = ScmOp_eval(test, env);
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-26 11:41:32 UTC (rev 1332)
+++ branches/r5rs/sigscheme/operations.c 2005-08-26 11:56:08 UTC (rev 1333)
@@ -1738,7 +1738,7 @@
/* fill vector */
fill = SCM_UNDEF;
- if (!NULLP(CDR(arg)) && !NULLP(CAR(CDR(arg))))
+ if (!NULLP(CDR(arg)))
fill = CAR(CDR(arg));
for (i = 0; i < c_k; i++) {
@@ -1954,8 +1954,8 @@
if (!CLOSUREP(CAR(arg)))
SigScm_Error("force : not proper delayed object\n");
- /* evaluated exp = ( CAR(arg) ) */
- return ScmOp_eval(Scm_NewCons(CAR(arg), SCM_NULL), env);
+ /* the caller's already wrapped arg in a list for us */
+ return ScmOp_eval(arg, env);
}
ScmObj ScmOp_call_with_current_continuation(ScmObj arg, ScmObj env)
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-08-26 11:41:32 UTC (rev 1332)
+++ branches/r5rs/sigscheme/read.c 2005-08-26 11:56:08 UTC (rev 1333)
@@ -73,7 +73,7 @@
} \
} while (0);
-#define SCM_PORT_UNGETC(port,c ) \
+#define SCM_PORT_UNGETC(port,c) \
SCM_PORTINFO_UNGOTTENCHAR(port) = c;
/*=======================================
@@ -92,6 +92,7 @@
static ScmObj read_char(ScmObj port);
static ScmObj read_string(ScmObj port);
static ScmObj read_symbol(ScmObj port);
+static ScmObj parse_number(const char *str);
static ScmObj read_number_or_symbol(ScmObj port);
static ScmObj read_quote(ScmObj port, ScmObj quoter);
@@ -131,7 +132,7 @@
if (c == '\n') {
break;
}
- if (c == EOF ) return c;
+ if (c == EOF) return c;
}
continue;
} else if(isspace(c)) {
@@ -165,8 +166,6 @@
return read_string(port);
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- SCM_PORT_UNGETC(port, c);
- return read_number_or_symbol(port);
case '+': case '-':
SCM_PORT_UNGETC(port, c);
return read_number_or_symbol(port);
@@ -196,6 +195,9 @@
return ScmOp_list2vector(read_list(port, ')'));
case '\\':
return read_char(port);
+ case 'b': case 'o': case 'd': case 'x':
+ SCM_PORT_UNGETC(port, c1);
+ return parse_number(read_word(port));
case EOF:
SigScm_Error("end in #\n");
default:
@@ -225,7 +227,6 @@
int c = 0;
int c2 = 0;
char *token = NULL;
- char *dotsym = NULL;
#if DEBUG_PARSER
printf("read_list\n");
@@ -271,12 +272,11 @@
* Gauche behave).
*/
SCM_PORT_UNGETC(port, c2);
- token = read_word(port);
- dotsym = (char*)malloc(sizeof(char) * (strlen(token) + 1 + 1));
- memmove (dotsym + 1, token, strlen(token)+1);
- dotsym[0] = '.';
- item = Scm_Intern(dotsym);
- free(dotsym);
+ token = read_word(port);
+ token = (char*)realloc(token, strlen(token) + 1 + 1);
+ memmove(token + 1, token, strlen(token)+1);
+ token[0] = '.';
+ item = Scm_Intern(token);
free(token);
} else {
SCM_PORT_UNGETC(port, c);
@@ -358,6 +358,7 @@
case 'r': stringbuf[stringlen] = '\r'; break;
case 'f': stringbuf[stringlen] = '\f'; break;
case 't': stringbuf[stringlen] = '\t'; break;
+ case '\\': stringbuf[stringlen] = '\\'; break;
default:
stringbuf[stringlen] = '\\';
stringbuf[++stringlen] = c;
@@ -389,11 +390,10 @@
static ScmObj read_number_or_symbol(ScmObj port)
{
- int i = 0;
- int is_str = 0;
+ int number = 0;
int str_len = 0;
char *str = NULL;
- ScmObj obj = SCM_NULL;
+ char *first_nondigit = NULL;
#if DEBUG_PARSER
printf("read_number_or_symbol\n");
@@ -403,44 +403,13 @@
str = read_word(port);
str_len = strlen(str);
- if (strlen(str) == 1
- && (strcmp(str, "+") == 0 || strcmp(str, "-") == 0))
- {
-#if DEBUG_PARSER
- printf("determined as symbol : %s\n", str);
-#endif
+ /* see if it's a decimal integer */
+ number = (int)strtol(str, &first_nondigit, 10);
- obj = Scm_Intern(str);
- free(str);
- return obj;
- }
+ if (*first_nondigit)
+ return Scm_Intern(str);
- /* check whether each char is the digit */
- for (i = 0; i < str_len; i++) {
- if (i == 0 && (str[i] == '+' || str[i] == '-'))
- continue;
-
- if (!isdigit(str[i])) {
- is_str = 1;
- break;
- }
- }
-
- /* if symbol, then intern it. if number, return new int obj */
- if (is_str) {
-#if DEBUG_PARSER
- printf("determined as symbol : %s\n", str);
-#endif
- obj = Scm_Intern(str);
- } else {
-#if DEBUG_PARSER
- printf("determined as num : %s\n", str);
-#endif
- obj = Scm_NewInt((int)atof(str));
- }
- free(str);
-
- return obj;
+ return Scm_NewInt(number);
}
@@ -518,5 +487,29 @@
static ScmObj read_quote(ScmObj port, ScmObj quoter)
{
- return Scm_NewCons(quoter, Scm_NewCons(read_sexpression(port), SCM_NULL));
+ return SCM_LIST_2(quoter, read_sexpression(port));
}
+
+/* str should be what appeared right after '#' (eg. #b123) */
+static ScmObj parse_number(const char *str)
+{
+ int radix = 0;
+ int number = 0;
+ char *first_nondigit = NULL;
+
+ switch (str[0]) {
+ case 'b': radix = 2; break;
+ case 'o': radix = 8; break;
+ case 'd': radix = 10; break;
+ case 'x': radix = 16; break;
+ default:
+ SigScm_Error("ill-formatted number: #%s\n", str);
+ }
+
+ number = (int)strtol(str+1, &first_nondigit, radix);
+
+ if (*first_nondigit)
+ SigScm_Error("ill-formatted number: #%s\n", str);
+
+ return Scm_NewInt(number);
+}
Modified: branches/r5rs/sigscheme/test/bigloo-bchar.scm
===================================================================
--- branches/r5rs/sigscheme/test/bigloo-bchar.scm 2005-08-26 11:41:32 UTC (rev 1332)
+++ branches/r5rs/sigscheme/test/bigloo-bchar.scm 2005-08-26 11:56:08 UTC (rev 1333)
@@ -47,7 +47,8 @@
(test "char-upcase" (char-upcase #\A) #\A)
(test "char-downcase" (char-downcase #\a) #\a)
(test "char-downcase" (char-downcase #\A) #\a)
- (test "unsigned char" (char->integer (integer->char 128)) 128))
+; (test "unsigned char" (char->integer (integer->char 128)) 128)
+ )
(test-char)
Modified: branches/r5rs/sigscheme/test/io.scm
===================================================================
--- branches/r5rs/sigscheme/test/io.scm 2005-08-26 11:41:32 UTC (rev 1332)
+++ branches/r5rs/sigscheme/test/io.scm 2005-08-26 11:56:08 UTC (rev 1333)
@@ -1,2 +1,2 @@
-(display "type an sexp:")
+(display "type a char:")
(print (read-char))
Modified: branches/r5rs/sigscheme/test/test-num.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-num.scm 2005-08-26 11:41:32 UTC (rev 1332)
+++ branches/r5rs/sigscheme/test/test-num.scm 2005-08-26 11:56:08 UTC (rev 1333)
@@ -59,4 +59,18 @@
(assert-equal? "string->number test2" 10 (string->number "10"))
(assert-equal? "string->number test2" 100 (string->number "100"))
+; numbers in various radices
+(assert-true "binary number test1" (= #b1111 15))
+(assert-true "binary number test2" (= #b010 2))
+(assert-true "binary number test3" (= #b0 0))
+(assert-true "binary number test4" (= #b-1 -1))
+(assert-true "binary number test5" (= #b-10 -2))
+(assert-true "binary number test6" (= #b-010 -2))
+(assert-true "octal number test1" (= #o077 63))
+(assert-true "octal number test2" (= #o361 241))
+(assert-true "decimal number test1" (= #d3900 3900))
+(assert-true "decimal number test2" (= #d18782 18782))
+(assert-true "hexadecimal test1" (= #xffff 65535))
+(assert-true "hexadecimal test2" (= #x0A7b 2683))
+
(total-report)
More information about the uim-commit
mailing list