summaryrefslogtreecommitdiff
path: root/srfi/srfi-13.c
diff options
context:
space:
mode:
authorThien-Thi Nguyen <ttn@gnuvola.org>2001-08-24 21:59:50 +0000
committerThien-Thi Nguyen <ttn@gnuvola.org>2001-08-24 21:59:50 +0000
commit0f21643339d47afa6bdf47a5ad2fab420a4c9e03 (patch)
tree8a6110a330571edc08acae10ff9f71bd67ac7292 /srfi/srfi-13.c
parent8c67d05cefcecd8e8bf9e47255abc9ee19d035df (diff)
downloadguile-0f21643339d47afa6bdf47a5ad2fab420a4c9e03.tar.gz
(scm_string_for_each): Reverse order of first 2 args.
(scm_string_for_each_index): New func. Thanks to Alex Shinn.
Diffstat (limited to 'srfi/srfi-13.c')
-rw-r--r--srfi/srfi-13.c154
1 files changed, 88 insertions, 66 deletions
diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c
index a54dfbc1a..231e2adaa 100644
--- a/srfi/srfi-13.c
+++ b/srfi/srfi-13.c
@@ -1,17 +1,17 @@
/* srfi-13.c --- SRFI-13 procedures for Guile
*
* Copyright (C) 2001 Free Software Foundation, Inc.
- *
+ *
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License as
* published by the Free Software Foundation; either version 2, or (at
* your option) any later version.
- *
+ *
* This program is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
@@ -52,7 +52,7 @@
#include "srfi-13.h"
#include "srfi-14.h"
-SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
+SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
(SCM pred, SCM s, SCM start, SCM end),
"Check if the predicate @var{pred} is true for any character in\n"
"the string @var{s}, proceeding from left (index @var{start}) to\n"
@@ -83,7 +83,7 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
+SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
(SCM pred, SCM s, SCM start, SCM end),
"Check if the predicate @var{pred} is true for every character\n"
"in the string @var{s}, proceeding from left (index @var{start})\n"
@@ -115,7 +115,7 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
+SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
(SCM proc, SCM len),
"@var{proc} is an integer->char procedure. Construct a string\n"
"of size @var{len} by applying @var{proc} to each index to\n"
@@ -169,7 +169,7 @@ SCM_DEFINE (scm_string_to_listS, "string->list", 1, 2, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0,
+SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0,
(SCM chrs),
"An efficient implementation of @code{(compose string->list\n"
"reverse)}:\n"
@@ -181,7 +181,7 @@ SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0,
{
SCM result;
long i = scm_ilength (chrs);
-
+
if (i < 0)
SCM_WRONG_TYPE_ARG (1, chrs);
result = scm_allocate_string (i);
@@ -209,7 +209,7 @@ SCM_SYMBOL (scm_sym_strict_infix, "strict-infix");
SCM_SYMBOL (scm_sym_suffix, "suffix");
SCM_SYMBOL (scm_sym_prefix, "prefix");
-SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
+SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
(SCM ls, SCM delimiter, SCM grammar),
"Append the string in the string list @var{ls}, using the string\n"
"@var{delim} as a delimiter between the elements of @var{ls}.\n"
@@ -358,10 +358,10 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
break;
}
return result;
-#undef GRAM_INFIX
-#undef GRAM_STRICT_INFIX
-#undef GRAM_SUFFIX
-#undef GRAM_PREFIX
+#undef GRAM_INFIX
+#undef GRAM_STRICT_INFIX
+#undef GRAM_SUFFIX
+#undef GRAM_PREFIX
}
#undef FUNC_NAME
@@ -380,12 +380,12 @@ SCM_DEFINE (scm_string_copyS, "string-copy", 1, 2, 0,
2, start, cstart,
3, end, cend);
return scm_mem2string (cstr + cstart, cend - cstart);
-
+
}
#undef FUNC_NAME
-SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0,
+SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0,
(SCM str, SCM start, SCM end),
"Like @code{substring}, but the result may share memory with the\n"
"argument @var{str}.")
@@ -405,7 +405,7 @@ SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
+SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
(SCM target, SCM tstart, SCM s, SCM start, SCM end),
"Copy the sequence of characters from index range [@var{start},\n"
"@var{end}) in string @var{s} to string @var{target}, beginning\n"
@@ -438,7 +438,7 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_take, "string-take", 2, 0, 0,
+SCM_DEFINE (scm_string_take, "string-take", 2, 0, 0,
(SCM s, SCM n),
"Return the @var{n} first characters of @var{s}.")
#define FUNC_NAME s_scm_string_take
@@ -449,13 +449,13 @@ SCM_DEFINE (scm_string_take, "string-take", 2, 0, 0,
SCM_VALIDATE_STRING_COPY (1, s, cstr);
SCM_VALIDATE_INUM_COPY (2, n, cn);
SCM_ASSERT_RANGE (2, n, cn >= 0 && cn <= SCM_STRING_LENGTH (s));
-
+
return scm_mem2string (cstr, cn);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_string_drop, "string-drop", 2, 0, 0,
+SCM_DEFINE (scm_string_drop, "string-drop", 2, 0, 0,
(SCM s, SCM n),
"Return all but the first @var{n} characters of @var{s}.")
#define FUNC_NAME s_scm_string_drop
@@ -466,13 +466,13 @@ SCM_DEFINE (scm_string_drop, "string-drop", 2, 0, 0,
SCM_VALIDATE_STRING_COPY (1, s, cstr);
SCM_VALIDATE_INUM_COPY (2, n, cn);
SCM_ASSERT_RANGE (2, n, cn >= 0 && cn <= SCM_STRING_LENGTH (s));
-
+
return scm_mem2string (cstr + cn, SCM_STRING_LENGTH (s) - cn);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_string_take_right, "string-take-right", 2, 0, 0,
+SCM_DEFINE (scm_string_take_right, "string-take-right", 2, 0, 0,
(SCM s, SCM n),
"Return the @var{n} last characters of @var{s}.")
#define FUNC_NAME s_scm_string_take_right
@@ -483,13 +483,13 @@ SCM_DEFINE (scm_string_take_right, "string-take-right", 2, 0, 0,
SCM_VALIDATE_STRING_COPY (1, s, cstr);
SCM_VALIDATE_INUM_COPY (2, n, cn);
SCM_ASSERT_RANGE (2, n, cn >= 0 && cn <= SCM_STRING_LENGTH (s));
-
+
return scm_mem2string (cstr + SCM_STRING_LENGTH (s) - cn, cn);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_string_drop_right, "string-drop-right", 2, 0, 0,
+SCM_DEFINE (scm_string_drop_right, "string-drop-right", 2, 0, 0,
(SCM s, SCM n),
"Return all but the last @var{n} characters of @var{s}.")
#define FUNC_NAME s_scm_string_drop_right
@@ -500,7 +500,7 @@ SCM_DEFINE (scm_string_drop_right, "string-drop-right", 2, 0, 0,
SCM_VALIDATE_STRING_COPY (1, s, cstr);
SCM_VALIDATE_INUM_COPY (2, n, cn);
SCM_ASSERT_RANGE (2, n, cn >= 0 && cn <= SCM_STRING_LENGTH (s));
-
+
return scm_mem2string (cstr, SCM_STRING_LENGTH (s) - cn);
}
#undef FUNC_NAME
@@ -882,7 +882,7 @@ SCM_DEFINE (scm_string_compare, "string-compare", 5, 4, 0,
SCM_VALIDATE_PROC (3, proc_lt);
SCM_VALIDATE_PROC (4, proc_eq);
SCM_VALIDATE_PROC (5, proc_gt);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -925,7 +925,7 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 5, 4, 0,
SCM_VALIDATE_PROC (3, proc_lt);
SCM_VALIDATE_PROC (4, proc_eq);
SCM_VALIDATE_PROC (5, proc_gt);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -960,7 +960,7 @@ SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -995,7 +995,7 @@ SCM_DEFINE (scm_string_neq, "string<>", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -1030,7 +1030,7 @@ SCM_DEFINE (scm_string_lt, "string<", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -1065,7 +1065,7 @@ SCM_DEFINE (scm_string_gt, "string>", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -1100,7 +1100,7 @@ SCM_DEFINE (scm_string_le, "string<=", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -1135,7 +1135,7 @@ SCM_DEFINE (scm_string_ge, "string>=", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (cstr1[cstart1] < cstr2[cstart2])
@@ -1171,7 +1171,7 @@ SCM_DEFINE (scm_string_ci_eq, "string-ci=", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -1207,7 +1207,7 @@ SCM_DEFINE (scm_string_ci_neq, "string-ci<>", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -1243,7 +1243,7 @@ SCM_DEFINE (scm_string_ci_lt, "string-ci<", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -1279,7 +1279,7 @@ SCM_DEFINE (scm_string_ci_gt, "string-ci>", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -1315,7 +1315,7 @@ SCM_DEFINE (scm_string_ci_le, "string-ci<=", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -1351,7 +1351,7 @@ SCM_DEFINE (scm_string_ci_ge, "string-ci>=", 2, 4, 0,
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
5, start2, cstart2,
6, end2, cend2);
-
+
while (cstart1 < cend1 && cstart2 < cend2)
{
if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2]))
@@ -1718,7 +1718,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
return SCM_MAKINUM (cend);
}
}
- return SCM_BOOL_F;
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -1838,7 +1838,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
return SCM_MAKINUM (cend);
}
}
- return SCM_BOOL_F;
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -1985,7 +1985,7 @@ SCM_DEFINE (scm_string_contains_ci, "string-contains-ci", 2, 4, 0,
#undef FUNC_NAME
-/* Helper function for the string uppercase conversion functions.
+/* Helper function for the string uppercase conversion functions.
* No argument checking is performed. */
static SCM
string_upcase_x (SCM v, int start, int end)
@@ -2001,7 +2001,7 @@ string_upcase_x (SCM v, int start, int end)
/* FIXME::martin: The `S' is to avoid a name clash with the procedure
in the core, which does not accept start/end indices */
-SCM_DEFINE (scm_string_upcase_xS, "string-upcase!", 1, 2, 0,
+SCM_DEFINE (scm_string_upcase_xS, "string-upcase!", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Destructively upcase every character in @code{str}.\n"
"\n"
@@ -2026,7 +2026,7 @@ SCM_DEFINE (scm_string_upcase_xS, "string-upcase!", 1, 2, 0,
/* FIXME::martin: The `S' is to avoid a name clash with the procedure
in the core, which does not accept start/end indices */
-SCM_DEFINE (scm_string_upcaseS, "string-upcase", 1, 2, 0,
+SCM_DEFINE (scm_string_upcaseS, "string-upcase", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Upcase every character in @code{str}.")
#define FUNC_NAME s_scm_string_upcaseS
@@ -2042,7 +2042,7 @@ SCM_DEFINE (scm_string_upcaseS, "string-upcase", 1, 2, 0,
#undef FUNC_NAME
-/* Helper function for the string lowercase conversion functions.
+/* Helper function for the string lowercase conversion functions.
* No argument checking is performed. */
static SCM
string_downcase_x (SCM v, int start, int end)
@@ -2058,7 +2058,7 @@ string_downcase_x (SCM v, int start, int end)
/* FIXME::martin: The `S' is to avoid a name clash with the procedure
in the core, which does not accept start/end indices */
-SCM_DEFINE (scm_string_downcase_xS, "string-downcase!", 1, 2, 0,
+SCM_DEFINE (scm_string_downcase_xS, "string-downcase!", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Destructively downcase every character in @var{str}.\n"
"\n"
@@ -2085,7 +2085,7 @@ SCM_DEFINE (scm_string_downcase_xS, "string-downcase!", 1, 2, 0,
/* FIXME::martin: The `S' is to avoid a name clash with the procedure
in the core, which does not accept start/end indices */
-SCM_DEFINE (scm_string_downcaseS, "string-downcase", 1, 2, 0,
+SCM_DEFINE (scm_string_downcaseS, "string-downcase", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Downcase every character in @var{str}.")
#define FUNC_NAME s_scm_string_downcaseS
@@ -2101,7 +2101,7 @@ SCM_DEFINE (scm_string_downcaseS, "string-downcase", 1, 2, 0,
#undef FUNC_NAME
-/* Helper function for the string capitalization functions.
+/* Helper function for the string capitalization functions.
* No argument checking is performed. */
static SCM
string_titlecase_x (SCM str, int start, int end)
@@ -2131,7 +2131,7 @@ string_titlecase_x (SCM str, int start, int end)
}
-SCM_DEFINE (scm_string_titlecase_x, "string-titlecase!", 1, 2, 0,
+SCM_DEFINE (scm_string_titlecase_x, "string-titlecase!", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Destructively titlecase every first character in a word in\n"
"@var{str}.")
@@ -2148,7 +2148,7 @@ SCM_DEFINE (scm_string_titlecase_x, "string-titlecase!", 1, 2, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_titlecase, "string-titlecase", 1, 2, 0,
+SCM_DEFINE (scm_string_titlecase, "string-titlecase", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Titlecase every first character in a word in @var{str}.")
#define FUNC_NAME s_scm_string_titlecase
@@ -2183,7 +2183,7 @@ string_reverse_x (char * str, int cstart, int cend)
}
-SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 0,
+SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Reverse the string @var{str}. The optional arguments\n"
"@var{start} and @var{end} delimit the region of @var{str} to\n"
@@ -2205,7 +2205,7 @@ SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_reverse_x, "string-reverse!", 1, 2, 0,
+SCM_DEFINE (scm_string_reverse_x, "string-reverse!", 1, 2, 0,
(SCM str, SCM start, SCM end),
"Reverse the string @var{str} in-place. The optional arguments\n"
"@var{start} and @var{end} delimit the region of @var{str} to\n"
@@ -2225,7 +2225,7 @@ SCM_DEFINE (scm_string_reverse_x, "string-reverse!", 1, 2, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_append_shared, "string-append/shared", 0, 0, 1,
+SCM_DEFINE (scm_string_append_shared, "string-append/shared", 0, 0, 1,
(SCM ls),
"Like @code{string-append}, but the result may share memory\n"
"with the argument strings.")
@@ -2245,7 +2245,7 @@ SCM_DEFINE (scm_string_append_shared, "string-append/shared", 0, 0, 1,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_concatenate, "string-concatenate", 1, 0, 0,
+SCM_DEFINE (scm_string_concatenate, "string-concatenate", 1, 0, 0,
(SCM ls),
"Append the elements of @var{ls} (which must be strings)\n"
"together into a single string. Guaranteed to return a freshly\n"
@@ -2288,7 +2288,7 @@ SCM_DEFINE (scm_string_concatenate, "string-concatenate", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_concatenate_reverse, "string-concatenate-reverse", 1, 2, 0,
+SCM_DEFINE (scm_string_concatenate_reverse, "string-concatenate-reverse", 1, 2, 0,
(SCM ls, SCM final_string, SCM end),
"Without optional arguments, this procedure is equivalent to\n"
"\n"
@@ -2319,7 +2319,7 @@ SCM_DEFINE (scm_string_concatenate_reverse, "string-concatenate-reverse", 1, 2,
if (!SCM_UNBNDP (end))
{
SCM_VALIDATE_INUM_COPY (3, end, cend);
- SCM_ASSERT_RANGE (3, end,
+ SCM_ASSERT_RANGE (3, end,
(cend >= 0) &&
(cend <= SCM_STRING_LENGTH (final_string)));
}
@@ -2369,7 +2369,7 @@ SCM_DEFINE (scm_string_concatenate_reverse, "string-concatenate-reverse", 1, 2,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_concatenate_shared, "string-concatenate/shared", 1, 0, 0,
+SCM_DEFINE (scm_string_concatenate_shared, "string-concatenate/shared", 1, 0, 0,
(SCM ls),
"Like @code{string-concatenate}, but the result may share memory\n"
"with the strings in the list @var{ls}.")
@@ -2387,7 +2387,7 @@ SCM_DEFINE (scm_string_concatenate_shared, "string-concatenate/shared", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_string_concatenate_reverse_shared, "string-concatenate-reverse/shared", 1, 2, 0,
+SCM_DEFINE (scm_string_concatenate_reverse_shared, "string-concatenate-reverse/shared", 1, 2, 0,
(SCM ls, SCM final_string, SCM end),
"Like @code{string-concatenate-reverse}, but the result may\n"
"share memory with the the strings in the @var{ls} arguments.")
@@ -2637,7 +2637,7 @@ SCM_DEFINE (scm_string_unfold_right, "string-unfold-right", 4, 2, 0,
SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
- (SCM s, SCM proc, SCM start, SCM end),
+ (SCM proc, SCM s, SCM start, SCM end),
"@var{proc} is mapped over @var{s} in left-to-right order. The\n"
"return value is not specified.")
#define FUNC_NAME s_scm_string_for_each
@@ -2645,10 +2645,10 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
char * cstr;
int cstart, cend;
- SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
+ SCM_VALIDATE_PROC (1, proc);
+ SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart,
4, end, cend);
- SCM_VALIDATE_PROC (2, proc);
while (cstart < cend)
{
scm_call_1 (proc, SCM_MAKE_CHAR (cstr[cstart]));
@@ -2658,6 +2658,28 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_string_for_each_index, "string-for-each-index", 2, 2, 0,
+ (SCM proc, SCM s, SCM start, SCM end),
+ "@var{proc} is mapped over @var{s} in left-to-right order. The\n"
+ "return value is not specified.")
+#define FUNC_NAME s_scm_string_for_each
+{
+ char * cstr;
+ int cstart, cend;
+
+ SCM_VALIDATE_PROC (1, proc);
+ SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
+ 3, start, cstart,
+ 4, end, cend);
+ while (cstart < cend)
+ {
+ scm_call_1 (proc, SCM_MAKINUM (cstart));
+ cstart++;
+ }
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
(SCM s, SCM from, SCM to, SCM start, SCM end),
"This is the @emph{extended substring} procedure that implements\n"
@@ -2683,9 +2705,9 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
SCM_VALIDATE_INUM_DEF_COPY (3, to, cfrom + (cend - cstart), cto);
if (cstart == cend && cfrom != cto)
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
-
+
result = scm_allocate_string (cto - cfrom);
-
+
p = SCM_STRING_CHARS (result);
while (cfrom < cto)
{
@@ -2894,7 +2916,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
{
SCM ls = SCM_EOL;
char chr;
-
+
chr = SCM_CHAR (char_pred);
idx = cstart;
while (idx < cend)
@@ -2908,7 +2930,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
else if (SCM_CHARSETP (char_pred))
{
SCM ls = SCM_EOL;
-
+
idx = cstart;
while (idx < cend)
{
@@ -2960,7 +2982,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
{
SCM ls = SCM_EOL;
char chr;
-
+
chr = SCM_CHAR (char_pred);
idx = cstart;
while (idx < cend)
@@ -2974,7 +2996,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
else if (SCM_CHARSETP (char_pred))
{
SCM ls = SCM_EOL;
-
+
idx = cstart;
while (idx < cend)
{