Jun Inoue
jun.l****@gmail*****
2005年 8月 26日 (金) 17:53:25 JST
On Fri, 26 Aug 2005 12:53:51 +0900 Kazuki Ohta <mover****@hct*****> wrote: > > ります。文字列長を int で管理して COW にすると、string-set! が無い限り最 > > 初の文字列を切り取り次第に使いまわせます。 > なるほど、いいですね。是非実装したいです。ただし、SigSchemeの機能拡張自 > 体はスケジュール的にもう少し後かなぁと思っています。 ただ、小さい(≦数十 bytes) string オブジェクトをたくさん扱うときや、C string に変換←→戻す、をしまくる場合は逆にメモリ使用量が増えたり、オー バーヘッドがバカにならなかったりする可能性があります。実装するときにはこ のへんをしっかり詰めましょう。 > * SIOD compatible で uim を動かす > * 速度&メモリ使用量最適化 > * not SIOD compatible で uim を動かす > * SigSchemeの機能拡張(GC, string等) > > 一応10月に中間報告会なるものが有るので、少なくとも安定版と同程度の動作 > を確保しておきたいという事が有ります。 なるほど。そういうスケジュールで動いてたんですね。じゃあ私も port 周りを 弄ってたんですがそれを一旦置いて uim への組み込みに注力しますね。 今までの作業中のとりあえずの成果物を添付しておきます。 * sigscheme/eval.c - (ScmOp_eval) 事実に即さなくなっているコメントを削除 - (ScmExp_cond) (() expr) という clause をエラーにしてたのをフィックス。 siod 互換モードでは、どのみち正しくない動作なのであんまり意味なし。 * sigscheme/operations.c - (ScmOp_make_vector) (make-vector n ()) が通るようにした - (ScmOp_force) 無駄な中間生成物排除。 * sigscheme/read.c - 括弧の内側の謎スペース削除×2 - (read_sexpression) merge duplicated code - 進数表現に対応 (#xff とか) - .で始まる symbol を扱うコードの省力化 最後の二つは peek_char を実装すればもっとエレガントに書けそうです。(とい うかそれが port を弄ってた理由) -- Jun Inoue jun.l****@gmail***** -------------- next part -------------- diff -ur sigscheme/eval.c ../.r5rs/sigscheme/eval.c --- sigscheme/eval.c 2005-08-25 22:03:28.000000000 -0700 +++ ../.r5rs/sigscheme/eval.c 2005-08-26 00:02:24.000000000 -0700 @@ -260,7 +260,6 @@ tmp = ScmOp_eval(tmp, env); break; case ScmEtc: - /* QUOTE case */ break; default: SigScm_ErrorObj("eval : invalid operation ", obj); @@ -1038,12 +1037,13 @@ /* looping in each clause */ for (; !NULLP(arg); arg = CDR(arg)) { clause = CAR(arg); + + if (!CONSP(clause)) + SigScm_ErrorObj("cond : bad clause: ", clause); + test = CAR(clause); exps = CDR(clause); - if (NULLP(clause) || NULLP(test)) - SigScm_Error("cond : syntax error\n"); - /* evaluate test */ test = ScmOp_eval(test, env); diff -ur sigscheme/operations.c ../.r5rs/sigscheme/operations.c --- sigscheme/operations.c 2005-08-25 22:03:28.000000000 -0700 +++ ../.r5rs/sigscheme/operations.c 2005-08-25 22:30:56.000000000 -0700 @@ -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) diff -ur sigscheme/read.c ../.r5rs/sigscheme/read.c --- sigscheme/read.c 2005-08-25 22:03:28.000000000 -0700 +++ ../.r5rs/sigscheme/read.c 2005-08-26 00:23:20.000000000 -0700 @@ -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"); @@ -272,11 +273,10 @@ */ 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 = (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,30 @@ 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 a # */ +static ScmObj parse_number(const char *str) +{ + int radix = 0; + int number = 0; + char *first_nondigit = NULL; + const char *p = str; + + switch (str[0]) { + case 'b': radix = 2; p++; break; + case 'o': radix = 8; p++; break; + case 'd': radix = 10; p++; break; + case 'x': radix = 16; p++; break; + default: + SigScm_Error("ill-formatted number: #%s\n", str); + } + + number = (int)strtol(p, &first_nondigit, radix); + + if (*first_nondigit) + SigScm_Error("ill-formatted number: #%s\n", str); + + return Scm_NewInt(number); } diff -ur sigscheme/test/io.scm ../.r5rs/sigscheme/test/io.scm --- sigscheme/test/io.scm 2005-08-21 04:48:30.000000000 -0700 +++ ../.r5rs/sigscheme/test/io.scm 2005-08-25 22:41:31.000000000 -0700 @@ -1,2 +1,2 @@ -(display "type an sexp:") +(display "type a char:") (print (read-char)) diff -ur sigscheme/test/test-num.scm ../.r5rs/sigscheme/test/test-num.scm --- sigscheme/test/test-num.scm 2005-08-22 13:04:10.000000000 -0700 +++ ../.r5rs/sigscheme/test/test-num.scm 2005-08-26 00:18:58.000000000 -0700 @@ -59,4 +59,14 @@ (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 "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)
