1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00

(scm_string_filter, scm_string_delete): For char and

charset cases, count chars kept and build a string in a second pass,
rather than using a cons cell for every char kept.  Use a shared
substring when nothing removed (such sharing is allowed by the srfi).
This commit is contained in:
Kevin Ryde 2005-06-10 22:34:59 +00:00
parent 5e5ea911f1
commit 8753a993c1

View file

@ -3253,11 +3253,14 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Filter the string @var{s}, retaining only those characters that\n"
"satisfy the @var{char_pred} argument. If the argument is a\n"
"procedure, it is applied to each character as a predicate, if\n"
"it is a character, it is tested for equality and if it is a\n"
"character set, it is tested for membership.")
"Filter the string @var{s}, retaining only those characters\n"
"which satisfy @var{char_pred}. The result may share storage\n"
"with @var{s}.\n"
"\n"
"If @var{char_pred} is a procedure, it is applied to each\n"
"character as a predicate, if it is a character, it is tested\n"
"for equality and if it is a character set, it is tested for\n"
"membership.")
#define FUNC_NAME s_scm_string_filter
{
const char *cstr;
@ -3270,33 +3273,55 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
4, end, cend);
if (SCM_CHARP (char_pred))
{
SCM ls = SCM_EOL;
size_t count;
char chr;
/* count chars to keep */
chr = SCM_CHAR (char_pred);
idx = cstart;
while (idx < cend)
{
if (cstr[idx] == chr)
ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls);
cstr = scm_i_string_chars (s);
idx++;
}
result = scm_reverse_list_to_string (ls);
count = 0;
for (idx = cstart; idx < cend; idx++)
if (cstr[idx] == chr)
count++;
/* if whole of start to end kept then return substring, including
possibly s itself */
if (count == cend - cstart)
result = scm_i_substring_shared (s, cstart, cend);
else
result = scm_c_make_string (count, char_pred);
}
else if (SCM_CHARSETP (char_pred))
{
SCM ls = SCM_EOL;
size_t count;
idx = cstart;
while (idx < cend)
{
if (SCM_CHARSET_GET (char_pred, cstr[idx]))
ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls);
cstr = scm_i_string_chars (s);
idx++;
}
result = scm_reverse_list_to_string (ls);
/* count chars to be kept */
count = 0;
for (idx = cstart; idx < cend; idx++)
if (SCM_CHARSET_GET (char_pred, cstr[idx]))
count++;
/* if whole of start to end kept then return substring, including
possibly s itself */
if (count == cend - cstart)
result = scm_i_substring_shared (s, cstart, cend);
else
{
char *dst;
result = scm_i_make_string (count, &dst);
cstr = scm_i_string_chars (s);
/* decrement "count" in this loop as well as using idx, so that if
another thread is simultaneously changing "s" there's no chance
it'll make us copy more than count characters */
for (idx = cstart; idx < cend && count != 0; idx++)
{
if (SCM_CHARSET_GET (char_pred, cstr[idx]))
{
*dst++ = cstr[idx];
count--;
}
}
}
}
else
{
@ -3325,11 +3350,13 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Filter the string @var{s}, retaining only those characters that\n"
"do not satisfy the @var{char_pred} argument. If the argument\n"
"is a procedure, it is applied to each character as a predicate,\n"
"if it is a character, it is tested for equality and if it is a\n"
"character set, it is tested for membership.")
"Delete characters satisfying @var{char_pred} from @var{s}. The\n"
"result may share storage with @var{s}.\n"
"\n"
"If @var{char_pred} is a procedure, it is applied to each\n"
"character as a predicate, if it is a character, it is tested\n"
"for equality and if it is a character set, it is tested for\n"
"membership.")
#define FUNC_NAME s_scm_string_delete
{
const char *cstr;
@ -3342,33 +3369,77 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
4, end, cend);
if (SCM_CHARP (char_pred))
{
SCM ls = SCM_EOL;
size_t count;
char chr;
chr = SCM_CHAR (char_pred);
idx = cstart;
while (idx < cend)
{
if (cstr[idx] != chr)
ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls);
cstr = scm_i_string_chars (s);
idx++;
}
result = scm_reverse_list_to_string (ls);
/* count chars to be kept */
count = 0;
for (idx = cstart; idx < cend; idx++)
if (cstr[idx] != chr)
count++;
/* if whole of start to end kept then return substring, including
possibly s itself */
if (count == cend - cstart)
{
result_substring:
result = scm_i_substring_shared (s, cstart, cend);
}
else
{
/* new string for retained portion */
char *dst;
result = scm_i_make_string (count, &dst);
cstr = scm_i_string_chars (s);
/* decrement "count" in this loop as well as using idx, so that if
another thread is simultaneously changing "s" there's no chance
it'll make us copy more than count characters */
for (idx = cstart; idx < cend && count != 0; idx++)
{
if (cstr[idx] != chr)
{
*dst++ = cstr[idx];
count--;
}
}
}
}
else if (SCM_CHARSETP (char_pred))
{
SCM ls = SCM_EOL;
size_t count;
idx = cstart;
while (idx < cend)
{
if (!SCM_CHARSET_GET (char_pred, cstr[idx]))
ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls);
cstr = scm_i_string_chars (s);
idx++;
}
result = scm_reverse_list_to_string (ls);
/* count chars to be kept */
count = 0;
for (idx = cstart; idx < cend; idx++)
if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
count++;
/* if whole of start to end kept then return substring, including
possibly s itself */
if (count == cend - cstart)
goto result_substring;
else
{
/* new string for retained portion */
char *dst;
result = scm_i_make_string (count, &dst);
cstr = scm_i_string_chars (s);
/* decrement "count" in this loop as well as using idx, so that if
another thread is simultaneously changing "s" there's no chance
it'll make us copy more than count characters */
for (idx = cstart; idx < cend && count != 0; idx++)
{
if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
{
*dst++ = cstr[idx];
count--;
}
}
}
}
else
{