diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-08-19 17:17:43 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-08-19 17:17:43 +0000 |
commit | 272632a67c4772ee439813b55c7b2f2dbeb77af3 (patch) | |
tree | 3d9484ff2a72b1c15d2e867b62e8afdf8a1f6d83 | |
parent | 3a5fb14dbcad7096d7e2f6d5daf18f6deef03c1d (diff) | |
download | guile-272632a67c4772ee439813b55c7b2f2dbeb77af3.tar.gz |
(scm_i_casei_streq): New, for counted strings.
* strings.h, strings.c: (scm_i_string_chars, scm_i_string_length,
scm_i_string_writable_chars, scm_i_string_stop_writing): New, to
replace SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH. Updated all
uses.
(scm_i_make_string, scm_c_make_string): New, to replace
scm_allocate_string. Updated all uses.
(SCM_STRINGP, SCM_STRING_CHARS, SCM_STRING_UCHARS,
SCM_STRING_LENGTH): Deprecated.
(scm_allocate_string, scm_take_str, scm_take0str, scm_mem2string,
scm_str2string, scm_makfrom0str, scm_makfrom0str_opt):
Discouraged. Replaced all uses with scm_from_locale_string or
similar, as appropriate.
(scm_c_string_length, scm_c_string_ref, scm_c_string_set_x,
scm_c_substring, scm_c_substring_shared, scm_c_substring_copy,
scm_substring_shared, scm_substring_copy): New.
* symbols.c, symbols.h (SCM_SYMBOLP, SCM_SYMBOL_FUNC,
SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS, SCM_SET_SYMBOL_PROPS,
SCM_SYMBOL_HASH, SCM_SYMBOL_INTERNED_P, scm_mem2symbol,
scm_str2symbol, scm_mem2uninterned_symbol): Discouraged.
(SCM_SYMBOL_LENGTH, SCM_SYMBOL_CHARS, scm_c_symbol2str):
Deprecated.
(SCM_MAKE_SYMBOL_TAG, SCM_SET_SYMBOL_LENGTH, SCM_SET_SYMBOL_CHARS,
SCM_PROP_SLOTS, SCM_SET_PROP_SLOTS): Removed.
(scm_is_symbol, scm_from_locale_symbol, scm_from_locale_symboln):
New, to replace scm_str2symbol and scm_mem2symbol, respectively.
Updated all uses.
(scm_gensym): Generate only the number suffix in the buffer, just
string-append the prefix.
-rw-r--r-- | libguile/read.c | 85 |
1 files changed, 49 insertions, 36 deletions
diff --git a/libguile/read.c b/libguile/read.c index fc973dcd2..c64651b72 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -86,16 +86,16 @@ scm_input_error (char const *function, SCM string_port = scm_open_output_string (); SCM string = SCM_EOL; scm_simple_format (string_port, - scm_makfrom0str ("~A:~S:~S: ~A"), + scm_from_locale_string ("~A:~S:~S: ~A"), scm_list_4 (fn, scm_from_int (SCM_LINUM (port) + 1), scm_from_int (SCM_COL (port) + 1), - scm_makfrom0str (message))); + scm_from_locale_string (message))); string = scm_get_output_string (string_port); scm_close_output_port (string_port); - scm_error_scm (scm_str2symbol ("read-error"), - scm_makfrom0str (function), + scm_error_scm (scm_from_locale_symbol ("read-error"), + scm_from_locale_string (function), string, arg, SCM_BOOL_F); @@ -141,7 +141,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0, return SCM_EOF_VAL; scm_ungetc (c, port); - tok_buf = scm_allocate_string (30); + tok_buf = scm_c_make_string (30, SCM_UNDEFINED); return scm_lreadr (&tok_buf, port, ©); } #undef FUNC_NAME @@ -151,15 +151,17 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0, char * scm_grow_tok_buf (SCM *tok_buf) { - size_t oldlen = SCM_I_STRING_LENGTH (*tok_buf); - SCM newstr = scm_allocate_string (2 * oldlen); + size_t oldlen = scm_i_string_length (*tok_buf); + const char *olddata = scm_i_string_chars (*tok_buf); + char *newdata; + SCM newstr = scm_i_make_string (2 * oldlen, &newdata); size_t i; for (i = 0; i != oldlen; ++i) - SCM_I_STRING_CHARS (newstr) [i] = SCM_I_STRING_CHARS (*tok_buf) [i]; + newdata[i] = olddata[i]; *tok_buf = newstr; - return SCM_I_STRING_CHARS (newstr); + return newdata; } @@ -218,6 +220,20 @@ scm_casei_streq (char *s1, char *s2) return !(*s1 || *s2); } +static int +scm_i_casei_streq (const char *s1, const char *s2, size_t len2) +{ + while (*s1 && len2 > 0) + if (scm_c_downcase((int)*s1) != scm_c_downcase((int)*s2)) + return 0; + else + { + ++s1; + ++s2; + --len2; + } + return !(*s1 || len2 > 0); +} /* recsexpr is used when recording expressions * constructed by read:sharp. @@ -437,7 +453,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) #if SCM_HAVE_ARRAYS case '*': j = scm_read_token (c, tok_buf, port, 0); - p = scm_istr2bve (SCM_I_STRING_CHARS (*tok_buf) + 1, (long) (j - 1)); + p = scm_istr2bve (scm_c_substring_shared (*tok_buf, 1, j-1)); if (scm_is_true (p)) return p; else @@ -446,7 +462,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '{': j = scm_read_token (c, tok_buf, port, 1); - return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); + return scm_string_to_symbol (scm_c_substring_copy (*tok_buf, 0, j)); case '\\': c = scm_getc (port); @@ -460,20 +476,22 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) * does only consist of octal digits. Finally, it should be * checked whether the resulting fixnum is in the range of * characters. */ - p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 8); + p = scm_i_mem2number (scm_i_string_chars (*tok_buf), j, 8); if (SCM_I_INUMP (p)) return SCM_MAKE_CHAR (SCM_I_INUM (p)); } for (c = 0; c < scm_n_charnames; c++) if (scm_charnames[c] - && (scm_casei_streq (scm_charnames[c], SCM_I_STRING_CHARS (*tok_buf)))) + && (scm_i_casei_streq (scm_charnames[c], + scm_i_string_chars (*tok_buf), j))) return SCM_MAKE_CHAR (scm_charnums[c]); - scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); + scm_input_error (FUNC_NAME, port, "unknown character name ~a", + scm_list_1 (scm_c_substring (*tok_buf, 0, j))); /* #:SYMBOL is a syntax for keywords supported in all contexts. */ case ':': j = scm_read_token ('-', tok_buf, port, 0); - p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); + p = scm_string_to_symbol (scm_c_substring_copy (*tok_buf, 0, j)); return scm_make_keyword_from_dash_symbol (p); default: @@ -509,7 +527,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (c == EOF) str_eof: scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL); - while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf)) + while (j + 2 >= scm_i_string_length (*tok_buf)) scm_grow_tok_buf (tok_buf); if (c == '\\') @@ -574,13 +592,12 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) "illegal character in escape sequence: ~S", scm_list_1 (SCM_MAKE_CHAR (c))); } - SCM_I_STRING_CHARS (*tok_buf)[j] = c; + scm_c_string_set_x (*tok_buf, j, SCM_MAKE_CHAR (c)); ++j; } if (j == 0) return scm_nullstr; - SCM_I_STRING_CHARS (*tok_buf)[j] = 0; - return scm_mem2string (SCM_I_STRING_CHARS (*tok_buf), j); + return scm_c_substring_copy (*tok_buf, 0, j); case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': @@ -593,7 +610,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) /* Shortcut: Detected symbol '+ or '- */ goto tok; - p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 10); + p = scm_i_mem2number (scm_i_string_chars (*tok_buf), j, 10); if (scm_is_true (p)) return p; if (c == '#') @@ -601,7 +618,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if ((j == 2) && (scm_getc (port) == '(')) { scm_ungetc ('(', port); - c = SCM_I_STRING_CHARS (*tok_buf)[1]; + c = scm_i_string_chars (*tok_buf)[1]; goto callshrp; } scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); @@ -612,7 +629,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix)) { j = scm_read_token ('-', tok_buf, port, 0); - p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); + p = scm_string_to_symbol (scm_c_substring (*tok_buf, 0, j)); return scm_make_keyword_from_dash_symbol (p); } /* fallthrough */ @@ -624,7 +641,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) /* fallthrough */ tok: - return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); + return scm_string_to_symbol (scm_c_substring (*tok_buf, 0, j)); } } #undef FUNC_NAME @@ -637,28 +654,26 @@ _Pragma ("noopt"); /* # pragma _CRI noopt */ size_t scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) { - register size_t j; - register int c; - register char *p; + size_t j; + int c; c = (SCM_CASE_INSENSITIVE_P ? scm_c_downcase(ic) : ic); - p = SCM_I_STRING_CHARS (*tok_buf); - + if (weird) j = 0; else { j = 0; - while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf)) - p = scm_grow_tok_buf (tok_buf); - p[j] = c; + while (j + 2 >= scm_i_string_length (*tok_buf)) + scm_grow_tok_buf (tok_buf); + scm_c_string_set_x (*tok_buf, j, SCM_MAKE_CHAR (c)); ++j; } while (1) { - while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf)) - p = scm_grow_tok_buf (tok_buf); + while (j + 2 >= scm_i_string_length (*tok_buf)) + scm_grow_tok_buf (tok_buf); c = scm_getc (port); switch (c) { @@ -682,7 +697,6 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) scm_ungetc (c, port); case EOF: eof_case: - p[j] = 0; return j; case '\\': if (!weird) @@ -702,7 +716,6 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) c = scm_getc (port); if (c == '#') { - p[j] = 0; return j; } else @@ -716,7 +729,7 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) default_case: { c = (SCM_CASE_INSENSITIVE_P ? scm_c_downcase(c) : c); - p[j] = c; + scm_c_string_set_x (*tok_buf, j, SCM_MAKE_CHAR (c)); ++j; } |