/* srfi-13.c --- SRFI-13 procedures for Guile
*
- * Copyright (C) 2001, 2004 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2005 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
}
#endif
-SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
+SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
(SCM char_pred, SCM s, SCM start, SCM end),
- "Check if the predicate @var{pred} is true for any character in\n"
- "the string @var{s}.\n"
- "\n"
- "Calls to @var{pred} are made from left to right across @var{s}.\n"
- "When it returns true (ie.@: non-@code{#f}), that return value\n"
- "is the return from @code{string-any}.\n"
- "\n"
- "The SRFI-13 specification requires that the call to @var{pred}\n"
- "on the last character of @var{s} (assuming that point is\n"
- "reached) be a tail call, but currently in Guile this is not the\n"
- "case.")
+"Check if @var{char_pred} is true for any character in string @var{s}.\n"
+"\n"
+"@var{char_pred} can be a character to check for any equal to that, or\n"
+"a character set (@pxref{Character Sets}) to check for any in that set,\n"
+"or a predicate procedure to call.\n"
+"\n"
+"For a procedure, calls @code{(@var{char_pred} c)} are made\n"
+"successively on the characters from @var{start} to @var{end}. If\n"
+"@var{char_pred} returns true (ie.@: non-@code{#f}), @code{string-any}\n"
+"stops and that return value is the return from @code{string-any}. The\n"
+"call on the last character (ie.@: at @math{@var{end}-1}), if that\n"
+"point is reached, is a tail call.\n"
+"\n"
+"If there are no characters in @var{s} (ie.@: @var{start} equals\n"
+"@var{end}) then the return is @code{#f}.\n")
#define FUNC_NAME s_scm_string_any
{
const char *cstr;
}
else if (SCM_CHARSETP (char_pred))
{
- int i;
+ size_t i;
for (i = cstart; i < cend; i++)
if (SCM_CHARSET_GET (char_pred, cstr[i]))
{
#undef FUNC_NAME
-SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
+SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
(SCM char_pred, SCM s, SCM start, SCM end),
- "Check if the predicate @var{pred} is true for every character\n"
- "in the string @var{s}.\n"
- "\n"
- "Calls to @var{pred} are made from left to right across @var{s}.\n"
- "If the predicate is true for every character then the return\n"
- "value from the last @var{pred} call is the return from\n"
- "@code{string-every}.\n"
- "\n"
- "If there are no characters in @var{s} (ie.@: @var{start} equals\n"
- "@var{end}) then the return is @code{#t}.\n"
- "\n"
- "The SRFI-13 specification requires that the call to @var{pred}\n"
- "on the last character of @var{s} (assuming that point is\n"
- "reached) be a tail call, but currently in Guile this is not the\n"
- "case.")
+"Check if @var{char_pred} is true for every character in string\n"
+"@var{s}.\n"
+"\n"
+"@var{char_pred} can be a character to check for every character equal\n"
+"to that, or a character set (@pxref{Character Sets}) to check for\n"
+"every character being in that set, or a predicate procedure to call.\n"
+"\n"
+"For a procedure, calls @code{(@var{char_pred} c)} are made\n"
+"successively on the characters from @var{start} to @var{end}. If\n"
+"@var{char_pred} returns @code{#f}, @code{string-every} stops and\n"
+"returns @code{#f}. The call on the last character (ie.@: at\n"
+"@math{@var{end}-1}), if that point is reached, is a tail call and the\n"
+"return from that call is the return from @code{string-every}.\n"
+"\n"
+"If there are no characters in @var{s} (ie.@: @var{start} equals\n"
+"@var{end}) then the return is @code{#t}.\n")
#define FUNC_NAME s_scm_string_every
{
const char *cstr;
if (SCM_CHARP (char_pred))
{
char cchr = SCM_CHAR (char_pred);
- int i;
+ size_t i;
for (i = cstart; i < cend; i++)
if (cstr[i] != cchr)
{
}
else if (SCM_CHARSETP (char_pred))
{
- int i;
+ size_t i;
for (i = cstart; i < cend; i++)
if (!SCM_CHARSET_GET (char_pred, cstr[i]))
{
/* The RES string remains untouched since nobody knows about it
yet. No need to refetch P.
*/
- ch = scm_call_1 (proc, scm_from_int (i));
+ ch = scm_call_1 (proc, scm_from_size_t (i));
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
*p++ = SCM_CHAR (ch);
{
data += i;
- while (i > 0 && SCM_CONSP (chrs))
+ while (i > 0 && scm_is_pair (chrs))
{
SCM elt = SCM_CAR (chrs);
switch (gram)
{
case GRAM_INFIX:
- if (!SCM_NULLP (ls))
+ if (!scm_is_null (ls))
len = (strings > 0) ? ((strings - 1) * del_len) : 0;
break;
case GRAM_STRICT_INFIX:
}
tmp = ls;
- while (SCM_CONSP (tmp))
+ while (scm_is_pair (tmp))
{
len += scm_c_string_length (SCM_CAR (tmp));
tmp = SCM_CDR (tmp);
{
case GRAM_INFIX:
case GRAM_STRICT_INFIX:
- while (SCM_CONSP (tmp))
+ while (scm_is_pair (tmp))
{
append_string (&p, &len, SCM_CAR (tmp));
- if (!SCM_NULLP (SCM_CDR (tmp)) && del_len > 0)
+ if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
append_string (&p, &len, delimiter);
tmp = SCM_CDR (tmp);
}
break;
case GRAM_SUFFIX:
- while (SCM_CONSP (tmp))
+ while (scm_is_pair (tmp))
{
append_string (&p, &len, SCM_CAR (tmp));
if (del_len > 0)
}
break;
case GRAM_PREFIX:
- while (SCM_CONSP (tmp))
+ while (scm_is_pair (tmp))
{
if (del_len > 0)
append_string (&p, &len, delimiter);
#define FUNC_NAME s_scm_string_trim_right
{
const char *cstr;
- int cstart, cend;
+ size_t cstart, cend;
MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
3, start, cstart,
5, start2, cstart2,
6, end2, cend2);
len2 = cend2 - cstart2;
- while (cstart1 <= cend1 - len2)
- {
- i = cstart1;
- j = cstart2;
- while (i < cend1 && j < cend2 && cs1[i] == cs2[j])
- {
- i++;
- j++;
- }
- if (j == cend2)
- {
- scm_remember_upto_here_2 (s1, s2);
- return scm_from_size_t (cstart1);
- }
- cstart1++;
- }
+ if (cend1 - cstart1 >= len2)
+ while (cstart1 <= cend1 - len2)
+ {
+ i = cstart1;
+ j = cstart2;
+ while (i < cend1 && j < cend2 && cs1[i] == cs2[j])
+ {
+ i++;
+ j++;
+ }
+ if (j == cend2)
+ {
+ scm_remember_upto_here_2 (s1, s2);
+ return scm_from_size_t (cstart1);
+ }
+ cstart1++;
+ }
scm_remember_upto_here_2 (s1, s2);
return SCM_BOOL_F;
5, start2, cstart2,
6, end2, cend2);
len2 = cend2 - cstart2;
- while (cstart1 <= cend1 - len2)
- {
- i = cstart1;
- j = cstart2;
- while (i < cend1 && j < cend2 &&
- scm_c_downcase (cs1[i]) == scm_c_downcase (cs2[j]))
- {
- i++;
- j++;
- }
- if (j == cend2)
- {
- scm_remember_upto_here_2 (s1, s2);
- return scm_from_size_t (cstart1);
- }
- cstart1++;
- }
+ if (cend1 - cstart1 >= len2)
+ while (cstart1 <= cend1 - len2)
+ {
+ i = cstart1;
+ j = cstart2;
+ while (i < cend1 && j < cend2 &&
+ scm_c_downcase (cs1[i]) == scm_c_downcase (cs2[j]))
+ {
+ i++;
+ j++;
+ }
+ if (j == cend2)
+ {
+ scm_remember_upto_here_2 (s1, s2);
+ return scm_from_size_t (cstart1);
+ }
+ cstart1++;
+ }
scm_remember_upto_here_2 (s1, s2);
return SCM_BOOL_F;
/* Helper function for the string uppercase conversion functions.
* No argument checking is performed. */
static SCM
-string_upcase_x (SCM v, int start, int end)
+string_upcase_x (SCM v, size_t start, size_t end)
{
size_t k;
char *dst;
/* Helper function for the string lowercase conversion functions.
* No argument checking is performed. */
static SCM
-string_downcase_x (SCM v, int start, int end)
+string_downcase_x (SCM v, size_t start, size_t end)
{
size_t k;
char *dst;
/* Helper function for the string capitalization functions.
* No argument checking is performed. */
static SCM
-string_titlecase_x (SCM str, int start, int end)
+string_titlecase_x (SCM str, size_t start, size_t end)
{
unsigned char *sz;
size_t i;
int in_word = 0;
- sz = scm_i_string_writable_chars (str);
+ sz = (unsigned char *) scm_i_string_writable_chars (str);
for(i = start; i < end; i++)
{
if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
/* Reverse the portion of @var{str} between str[cstart] (including)
and str[cend] excluding. */
static void
-string_reverse_x (char * str, int cstart, int cend)
+string_reverse_x (char * str, size_t cstart, size_t cend)
{
char tmp;
- cend--;
- while (cstart < cend)
+ if (cend > 0)
{
- tmp = str[cstart];
- str[cstart] = str[cend];
- str[cend] = tmp;
- cstart++;
cend--;
+ while (cstart < cend)
+ {
+ tmp = str[cstart];
+ str[cstart] = str[cend];
+ str[cend] = tmp;
+ cstart++;
+ cend--;
+ }
}
}
"allocated string.")
#define FUNC_NAME s_scm_string_concatenate
{
+ SCM_VALIDATE_LIST (SCM_ARG1, ls);
return scm_string_append (ls);
}
#undef FUNC_NAME
"with the strings in the list @var{ls}.")
#define FUNC_NAME s_scm_string_concatenate_shared
{
+ SCM_VALIDATE_LIST (SCM_ARG1, ls);
return scm_string_append_shared (ls);
}
#undef FUNC_NAME
{
const char *cs;
char *p;
- size_t cstart, cend, cfrom, cto;
+ size_t cstart, cend;
+ int cfrom, cto;
SCM result;
MY_VALIDATE_SUBSTRING_SPEC (1, s,
4, start, cstart,
5, end, cend);
- cfrom = scm_to_size_t (from);
+ cfrom = scm_to_int (from);
if (SCM_UNBNDP (to))
cto = cfrom + (cend - cstart);
else
- cto = scm_to_size_t (to);
+ cto = scm_to_int (to);
if (cstart == cend && cfrom != cto)
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
cs = scm_i_string_chars (s);
while (cfrom < cto)
{
- int t = ((cfrom < 0) ? -cfrom : cfrom) % (cend - cstart);
+ size_t t = ((cfrom < 0) ? -cfrom : cfrom) % (cend - cstart);
if (cfrom < 0)
*p = cs[(cend - cstart) - t];
else
{
char *p;
const char *cs;
- size_t ctstart, csfrom, csto, cstart, cend;
+ size_t ctstart, cstart, cend;
+ int csfrom, csto;
SCM dummy = SCM_UNDEFINED;
- int cdummy;
+ size_t cdummy;
MY_VALIDATE_SUBSTRING_SPEC (1, target,
2, tstart, ctstart,
MY_VALIDATE_SUBSTRING_SPEC (3, s,
6, start, cstart,
7, end, cend);
- csfrom = scm_to_size_t (sfrom);
+ csfrom = scm_to_int (sfrom);
if (SCM_UNBNDP (sto))
csto = csfrom + (cend - cstart);
else
- csto = scm_to_size_t (sto);
+ csto = scm_to_int (sto);
if (cstart == cend && csfrom != csto)
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
SCM_ASSERT_RANGE (1, tstart,
cs = scm_i_string_chars (s);
while (csfrom < csto)
{
- int t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
+ size_t t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
if (csfrom < 0)
*p = cs[(cend - cstart) - t];
else
if (SCM_CHARSETP (token_set))
{
- int idx;
+ size_t idx;
while (cstart < cend)
{
HCoop / bpt / guile.git / blobdiff