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:
parent
5e5ea911f1
commit
8753a993c1
1 changed files with 121 additions and 50 deletions
|
@ -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
|
||||
{
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue