[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/srfi srfi-13.c
|
From: |
Thien-Thi Nguyen |
|
Subject: |
guile/guile-core/srfi srfi-13.c |
|
Date: |
Fri, 24 Aug 2001 15:12:46 -0700 |
CVSROOT: /cvs
Module name: guile
Branch: branch_release-1-6
Changes by: Thien-Thi Nguyen <address@hidden> 01/08/24 15:12:45
Modified files:
guile-core/srfi: srfi-13.c
Log message:
(scm_string_for_each): Reverse order of first 2 args.
(scm_string_for_each_index): New func.
Thanks to Alex Shinn.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/srfi-13.c.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.11.2.1&tr2=1.11.2.2&r1=text&r2=text
Patches:
Index: guile/guile-core/srfi/srfi-13.c
diff -u guile/guile-core/srfi/srfi-13.c:1.12
guile/guile-core/srfi/srfi-13.c:1.13
--- guile/guile-core/srfi/srfi-13.c:1.12 Wed Aug 22 04:58:25 2001
+++ guile/guile-core/srfi/srfi-13.c Fri Aug 24 14:59:50 2001
@@ -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 @@
#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 @@
#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 @@
}
#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 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_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 @@
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 @@
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 @@
#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 address@hidden,\n"
"@var{end}) in string @var{s} to string @var{target}, beginning\n"
@@ -438,7 +438,7 @@
#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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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 @@
return SCM_MAKINUM (cend);
}
}
- return SCM_BOOL_F;
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -1838,7 +1838,7 @@
return SCM_MAKINUM (cend);
}
}
- return SCM_BOOL_F;
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -1985,7 +1985,7 @@
#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 @@
/* 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 @@
/* 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 @@
#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 @@
/* 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 @@
/* 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 @@
#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 @@
}
-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 @@
#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 @@
}
-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 @@
#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 @@
#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 @@
#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 @@
#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 @@
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 @@
#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 @@
#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_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 @@
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 @@
}
#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_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 ls = SCM_EOL;
char chr;
-
+
chr = SCM_CHAR (char_pred);
idx = cstart;
while (idx < cend)
@@ -2908,7 +2930,7 @@
else if (SCM_CHARSETP (char_pred))
{
SCM ls = SCM_EOL;
-
+
idx = cstart;
while (idx < cend)
{
@@ -2960,7 +2982,7 @@
{
SCM ls = SCM_EOL;
char chr;
-
+
chr = SCM_CHAR (char_pred);
idx = cstart;
while (idx < cend)
@@ -2974,7 +2996,7 @@
else if (SCM_CHARSETP (char_pred))
{
SCM ls = SCM_EOL;
-
+
idx = cstart;
while (idx < cend)
{