mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
(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.
This commit is contained in:
Marius Vollmer
parent
3a5fb14dbc
commit
272632a67c
1 changed files with 49 additions and 36 deletions
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue