/* srfi-13.c --- SRFI-13 procedures for Guile
*
- * Copyright (C) 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2005, 2006, 2008, 2009, 2010, 2011, 2012 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 License
#include "libguile.h"
+#include <libguile/deprecation.h>
#include "libguile/srfi-13.h"
#include "libguile/srfi-14.h"
if (wide)
{
scm_t_wchar *wbuf = NULL;
- res = scm_i_make_wide_string (clen, &wbuf);
+ res = scm_i_make_wide_string (clen, &wbuf, 0);
memcpy (wbuf, buf, clen * sizeof (scm_t_wchar));
free (buf);
}
else
{
char *nbuf = NULL;
- res = scm_i_make_string (clen, &nbuf);
+ res = scm_i_make_string (clen, &nbuf, 0);
for (i = 0; i < clen; i ++)
nbuf[i] = (unsigned char) buf[i];
free (buf);
if (i < 0)
SCM_WRONG_TYPE_ARG (1, chrs);
- result = scm_i_make_string (i, &data);
+ result = scm_i_make_string (i, &data, 0);
{
SCM rest;
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"
+ "@var{delimiter} as a delimiter between the elements of @var{ls}.\n"
"@var{grammar} is a symbol which specifies how the delimiter is\n"
"placed between the strings, and defaults to the symbol\n"
"@code{infix}.\n"
SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
SCM_EOL);
- result = scm_i_make_string (0, NULL);
+ result = scm_i_make_string (0, NULL, 0);
tmp = ls;
switch (gram)
MY_VALIDATE_SUBSTRING_SPEC (3, s,
4, start, cstart,
5, end, cend);
- len = cend - cstart;
- SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
-
- target = scm_i_string_start_writing (target);
- for (i = 0; i < cend - cstart; i++)
+ if (cstart < cend)
{
- scm_i_string_set_x (target, ctstart + i,
- scm_i_string_ref (s, cstart + i));
+ len = cend - cstart;
+ SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
+
+ target = scm_i_string_start_writing (target);
+ for (i = 0; i < cend - cstart; i++)
+ {
+ scm_i_string_set_x (target, ctstart + i,
+ scm_i_string_ref (s, cstart + i));
+ }
+ scm_i_string_stop_writing ();
+ scm_remember_upto_here_1 (target);
}
- scm_i_string_stop_writing ();
- scm_remember_upto_here_1 (target);
return SCM_UNSPECIFIED;
}
MY_VALIDATE_SUBSTRING_SPEC (1, s,
3, start, cstart,
4, end, cend);
- if (SCM_UNBNDP (char_pred))
+ if (SCM_UNBNDP (char_pred)
+ || scm_is_eq (char_pred, scm_char_set_whitespace))
{
while (cstart < cend)
{
MY_VALIDATE_SUBSTRING_SPEC (1, s,
3, start, cstart,
4, end, cend);
- if (SCM_UNBNDP (char_pred))
+ if (SCM_UNBNDP (char_pred)
+ || scm_is_eq (char_pred, scm_char_set_whitespace))
{
while (cstart < cend)
{
MY_VALIDATE_SUBSTRING_SPEC (1, s,
3, start, cstart,
4, end, cend);
- if (SCM_UNBNDP (char_pred))
+ if (SCM_UNBNDP (char_pred)
+ || scm_is_eq (char_pred, scm_char_set_whitespace))
{
while (cstart < cend)
{
4, end, cend);
SCM_VALIDATE_CHAR (2, chr);
-
- str = scm_i_string_start_writing (str);
- for (k = cstart; k < cend; k++)
- scm_i_string_set_x (str, k, SCM_CHAR (chr));
- scm_i_string_stop_writing ();
+ if (cstart < cend)
+ {
+ str = scm_i_string_start_writing (str);
+ for (k = cstart; k < cend; k++)
+ scm_i_string_set_x (str, k, SCM_CHAR (chr));
+ scm_i_string_stop_writing ();
+ }
return SCM_UNSPECIFIED;
}
"value otherwise.")
#define FUNC_NAME s_scm_string_eq
{
+ if (SCM_LIKELY (scm_is_string (s1) && scm_is_string (s2) &&
+ scm_i_is_narrow_string (s1) == scm_i_is_narrow_string (s2)
+ && SCM_UNBNDP (start1) && SCM_UNBNDP (end1)
+ && SCM_UNBNDP (start2) && SCM_UNBNDP (end2)))
+ {
+ /* Fast path for this common case, which avoids the repeated calls to
+ `scm_i_string_ref'. */
+ size_t len1, len2;
+
+ len1 = scm_i_string_length (s1);
+ len2 = scm_i_string_length (s2);
+
+ if (len1 != len2)
+ return SCM_BOOL_F;
+ else
+ {
+ if (!scm_i_is_narrow_string (s1))
+ len1 *= 4;
+
+ return scm_from_bool (memcmp (scm_i_string_data (s1),
+ scm_i_string_data (s2),
+ len1) == 0);
+ }
+ }
+
return compare_strings (FUNC_NAME, 0,
s1, s2, start1, end1, start2, end2,
SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_T);
SCM_DEFINE (scm_substring_hash, "string-hash", 1, 3, 0,
(SCM s, SCM bound, SCM start, SCM end),
- "Compute a hash value for @var{S}. the optional argument "
+ "Compute a hash value for @var{s}. the optional argument "
"@var{bound} is a non-negative exact "
"integer specifying the range of the hash function. "
"A positive value restricts the return value to the "
SCM_DEFINE (scm_substring_hash_ci, "string-hash-ci", 1, 3, 0,
(SCM s, SCM bound, SCM start, SCM end),
- "Compute a hash value for @var{S}. the optional argument "
+ "Compute a hash value for @var{s}. the optional argument "
"@var{bound} is a non-negative exact "
"integer specifying the range of the hash function. "
"A positive value restricts the return value to the "
SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Search through the string @var{s} from left to right, returning\n"
- "the index of the first occurence of a character which\n"
+ "the index of the first occurrence of a character which\n"
"\n"
"@itemize @bullet\n"
"@item\n"
"equals @var{char_pred}, if it is character,\n"
"\n"
"@item\n"
- "satisifies the predicate @var{char_pred}, if it is a procedure,\n"
+ "satisfies the predicate @var{char_pred}, if it is a procedure,\n"
"\n"
"@item\n"
"is in the set @var{char_pred}, if it is a character set.\n"
- "@end itemize")
+ "@end itemize\n\n"
+ "Return @code{#f} if no match is found.")
#define FUNC_NAME s_scm_string_index
{
size_t cstart, cend;
SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Search through the string @var{s} from right to left, returning\n"
- "the index of the last occurence of a character which\n"
+ "the index of the last occurrence of a character which\n"
"\n"
"@itemize @bullet\n"
"@item\n"
"equals @var{char_pred}, if it is character,\n"
"\n"
"@item\n"
- "satisifies the predicate @var{char_pred}, if it is a procedure,\n"
+ "satisfies the predicate @var{char_pred}, if it is a procedure,\n"
"\n"
"@item\n"
"is in the set if @var{char_pred} is a character set.\n"
- "@end itemize")
+ "@end itemize\n\n"
+ "Return @code{#f} if no match is found.")
#define FUNC_NAME s_scm_string_index_right
{
size_t cstart, cend;
SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Search through the string @var{s} from right to left, returning\n"
- "the index of the last occurence of a character which\n"
+ "the index of the last occurrence of a character which\n"
"\n"
"@itemize @bullet\n"
"@item\n"
"equals @var{char_pred}, if it is character,\n"
"\n"
"@item\n"
- "satisifies the predicate @var{char_pred}, if it is a procedure,\n"
+ "satisfies the predicate @var{char_pred}, if it is a procedure,\n"
"\n"
"@item\n"
"is in the set if @var{char_pred} is a character set.\n"
- "@end itemize")
+ "@end itemize\n\n"
+ "Return @code{#f} if no match is found.")
#define FUNC_NAME s_scm_string_rindex
{
return scm_string_index_right (s, char_pred, start, end);
SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Search through the string @var{s} from left to right, returning\n"
- "the index of the first occurence of a character which\n"
+ "the index of the first occurrence of a character which\n"
"\n"
"@itemize @bullet\n"
"@item\n"
"does not equal @var{char_pred}, if it is character,\n"
"\n"
"@item\n"
- "does not satisify the predicate @var{char_pred}, if it is a\n"
+ "does not satisfy the predicate @var{char_pred}, if it is a\n"
"procedure,\n"
"\n"
"@item\n"
SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
(SCM s, SCM char_pred, SCM start, SCM end),
"Search through the string @var{s} from right to left, returning\n"
- "the index of the last occurence of a character which\n"
+ "the index of the last occurrence of a character which\n"
"\n"
"@itemize @bullet\n"
"@item\n"
"equals @var{char_pred}, if it is character,\n"
"\n"
"@item\n"
- "satisifies the predicate @var{char_pred}, if it is a procedure.\n"
+ "satisfies the predicate @var{char_pred}, if it is a procedure.\n"
"\n"
"@item\n"
"is in the set @var{char_pred}, if it is a character set.\n"
{
size_t k;
- v = scm_i_string_start_writing (v);
- for (k = start; k < end; ++k)
- scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
- scm_i_string_stop_writing ();
- scm_remember_upto_here_1 (v);
+ if (start < end)
+ {
+ v = scm_i_string_start_writing (v);
+ for (k = start; k < end; ++k)
+ scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
+ scm_i_string_stop_writing ();
+ scm_remember_upto_here_1 (v);
+ }
return v;
}
{
size_t k;
- v = scm_i_string_start_writing (v);
- for (k = start; k < end; ++k)
- scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
- scm_i_string_stop_writing ();
- scm_remember_upto_here_1 (v);
+ if (start < end)
+ {
+ v = scm_i_string_start_writing (v);
+ for (k = start; k < end; ++k)
+ scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
+ scm_i_string_stop_writing ();
+ scm_remember_upto_here_1 (v);
+ }
return v;
}
size_t i;
int in_word = 0;
- str = scm_i_string_start_writing (str);
- for(i = start; i < end; i++)
+ if (start < end)
{
- ch = SCM_MAKE_CHAR (scm_i_string_ref (str, i));
- if (scm_is_true (scm_char_alphabetic_p (ch)))
- {
- if (!in_word)
- {
- scm_i_string_set_x (str, i, uc_totitle (SCM_CHAR (ch)));
- in_word = 1;
- }
- else
- {
- scm_i_string_set_x (str, i, uc_tolower (SCM_CHAR (ch)));
- }
- }
- else
- in_word = 0;
+ str = scm_i_string_start_writing (str);
+ for(i = start; i < end; i++)
+ {
+ ch = SCM_MAKE_CHAR (scm_i_string_ref (str, i));
+ if (scm_is_true (scm_char_alphabetic_p (ch)))
+ {
+ if (!in_word)
+ {
+ scm_i_string_set_x (str, i, uc_totitle (SCM_CHAR (ch)));
+ in_word = 1;
+ }
+ else
+ {
+ scm_i_string_set_x (str, i, uc_tolower (SCM_CHAR (ch)));
+ }
+ }
+ else
+ in_word = 0;
+ }
+ scm_i_string_stop_writing ();
+ scm_remember_upto_here_1 (str);
}
- scm_i_string_stop_writing ();
- scm_remember_upto_here_1 (str);
return str;
}
static void
string_reverse_x (SCM str, size_t cstart, size_t cend)
{
- SCM tmp;
-
- str = scm_i_string_start_writing (str);
- if (cend > 0)
+ if (cstart < cend)
{
- cend--;
- while (cstart < cend)
- {
- tmp = SCM_MAKE_CHAR (scm_i_string_ref (str, cstart));
- scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend));
- scm_i_string_set_x (str, cend, SCM_CHAR (tmp));
- cstart++;
- cend--;
- }
+ str = scm_i_string_start_writing (str);
+ if (cend > 0)
+ {
+ SCM tmp;
+
+ cend--;
+ while (cstart < cend)
+ {
+ tmp = SCM_MAKE_CHAR (scm_i_string_ref (str, cstart));
+ scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend));
+ scm_i_string_set_x (str, cend, SCM_CHAR (tmp));
+ cstart++;
+ cend--;
+ }
+ }
+ scm_i_string_stop_writing ();
}
- scm_i_string_stop_writing ();
}
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.")
+ "share memory with the strings in the @var{ls} arguments.")
#define FUNC_NAME s_scm_string_concatenate_reverse_shared
{
/* Just call the non-sharing version. */
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
- result = scm_i_make_string (cend - cstart, NULL);
+ result = scm_i_make_string (cend - cstart, NULL, 0);
p = 0;
while (cstart < cend)
{
ans = base;
}
else
- ans = scm_i_make_string (0, NULL);
+ ans = scm_i_make_string (0, NULL, 0);
if (!SCM_UNBNDP (make_final))
SCM_VALIDATE_PROC (6, make_final);
SCM ch = scm_call_1 (f, seed);
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
- str = scm_i_make_string (1, NULL);
+ str = scm_i_make_string (1, NULL, 0);
str = scm_i_string_start_writing (str);
scm_i_string_set_x (str, i, SCM_CHAR (ch));
scm_i_string_stop_writing ();
ans = base;
}
else
- ans = scm_i_make_string (0, NULL);
+ ans = scm_i_make_string (0, NULL, 0);
if (!SCM_UNBNDP (make_final))
SCM_VALIDATE_PROC (6, make_final);
SCM ch = scm_call_1 (f, seed);
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
- str = scm_i_make_string (1, NULL);
+ str = scm_i_make_string (1, NULL, 0);
str = scm_i_string_start_writing (str);
scm_i_string_set_x (str, i, SCM_CHAR (ch));
scm_i_string_stop_writing ();
if (cstart == cend && cfrom != cto)
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
- result = scm_i_make_string (cto - cfrom, NULL);
+ result = scm_i_make_string (cto - cfrom, NULL, 0);
result = scm_i_string_start_writing (result);
p = 0;
csto = csfrom + (cend - cstart);
else
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,
- ctstart + (csto - csfrom) <= scm_i_string_length (target));
-
- p = 0;
- target = scm_i_string_start_writing (target);
- while (csfrom < csto)
+ if (csfrom < csto)
{
- size_t t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
- if (csfrom < 0)
- scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, (cend - cstart) - t));
- else
- scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, t));
- csfrom++;
- p++;
- }
- scm_i_string_stop_writing ();
+ if (cstart == cend)
+ SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
+ SCM_ASSERT_RANGE (1, tstart,
+ ctstart + (csto - csfrom) <= scm_i_string_length (target));
- scm_remember_upto_here_2 (target, s);
+ p = 0;
+ target = scm_i_string_start_writing (target);
+ while (csfrom < csto)
+ {
+ size_t t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
+ if (csfrom < 0)
+ scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, (cend - cstart) - t));
+ else
+ scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, t));
+ csfrom++;
+ p++;
+ }
+ scm_i_string_stop_writing ();
+
+ scm_remember_upto_here_2 (target, s);
+ }
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
(SCM str, SCM chr),
- "Split the string @var{str} into the a list of the substrings delimited\n"
+ "Split the string @var{str} into a list of the substrings delimited\n"
"by appearances of the character @var{chr}. Note that an empty substring\n"
"between separator characters will result in an empty string in the\n"
"result list.\n"
SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
- (SCM s, SCM char_pred, SCM start, SCM end),
+ (SCM char_pred, SCM s, SCM start, SCM end),
"Filter the string @var{s}, retaining only those characters\n"
"which satisfy @var{char_pred}.\n"
"\n"
SCM result;
size_t idx;
- MY_VALIDATE_SUBSTRING_SPEC (1, s,
+#if SCM_ENABLE_DEPRECATED == 1
+ if (scm_is_string (char_pred))
+ {
+ SCM tmp;
+
+ scm_c_issue_deprecation_warning
+ ("Guile used to use the wrong argument order for string-filter.\n"
+ "This call to string-filter had the arguments in the wrong order.\n"
+ "See SRFI-13 for more details. At some point we will remove this hack.");
+
+ tmp = char_pred;
+ char_pred = s;
+ s = tmp;
+ }
+#endif
+
+ MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
else
{
size_t dst = 0;
- result = scm_i_make_string (count, NULL);
+ result = scm_i_make_string (count, NULL, 0);
result = scm_i_string_start_writing (result);
/* decrement "count" in this loop as well as using idx, so that if
SCM ls = SCM_EOL;
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
- char_pred, SCM_ARG2, FUNC_NAME);
+ char_pred, SCM_ARG1, FUNC_NAME);
idx = cstart;
while (idx < cend)
{
SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
- (SCM s, SCM char_pred, SCM start, SCM end),
+ (SCM char_pred, SCM s, SCM start, SCM end),
"Delete characters satisfying @var{char_pred} from @var{s}.\n"
"\n"
"If @var{char_pred} is a procedure, it is applied to each\n"
SCM result;
size_t idx;
- MY_VALIDATE_SUBSTRING_SPEC (1, s,
+#if SCM_ENABLE_DEPRECATED == 1
+ if (scm_is_string (char_pred))
+ {
+ SCM tmp;
+
+ scm_c_issue_deprecation_warning
+ ("Guile used to use the wrong argument order for string-delete.\n"
+ "This call to string-filter had the arguments in the wrong order.\n"
+ "See SRFI-13 for more details. At some point we will remove this hack.");
+
+ tmp = char_pred;
+ char_pred = s;
+ s = tmp;
+ }
+#endif
+
+ MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
{
int i = 0;
/* new string for retained portion */
- result = scm_i_make_string (count, NULL);
+ result = scm_i_make_string (count, NULL, 0);
result = scm_i_string_start_writing (result);
/* decrement "count" in this loop as well as using idx, so that if
another thread is simultaneously changing "s" there's no chance
{
size_t i = 0;
/* new string for retained portion */
- result = scm_i_make_string (count, NULL);
+ result = scm_i_make_string (count, NULL, 0);
result = scm_i_string_start_writing (result);
/* decrement "count" in this loop as well as using idx, so that if
{
SCM ls = SCM_EOL;
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
- char_pred, SCM_ARG2, FUNC_NAME);
+ char_pred, SCM_ARG1, FUNC_NAME);
idx = cstart;
while (idx < cend)