1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00

* strop.c (scm_string_capitalize_x, scm_string_capitalize): new

functions; capitalize the first letter of each word in the
	argument string, and downcase the rest.
	(scm_string_ci_to_symbol): string->symbol, such that the same
	symbol is returned for any argument where the only difference
	between strings is in capitalization.
	(scm_string_upcase, scm_string_downcase): non-destructive
	versions.
	* strop.c (scm_substring_move_left_x, scm_substring_move_right_x):
	changed to use memmove.
	* strop.c (scm_i_index): removed the pos arguments (it's only
	called twice, and each time it's SCM_ARG1, SCM_ARG2, SCM_ARG3,
	SCM_ARG4).
	* strop.h: fixed prototypes.
*	* strop.c (scm_substring_move_left_x, scm_substring_move_right_x):
	changed to have 5 required args, rather than 2 required, and 3 required
	rest args. Also modified to allow str1 & str2 to overlap.
	(scm_substring_fill_x): changed to 4 args, rather than 2 args and
	2 required rest args.
This commit is contained in:
Jim Blandy 1999-05-09 08:22:11 +00:00
parent 9c792b5df0
commit 99a9952d78
2 changed files with 156 additions and 113 deletions

View file

@ -24,25 +24,18 @@ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
#include "chars.h"
#include "strop.h"
#include "read.h" /*For SCM_CASE_INSENSITIVE_P*/
static int scm_i_index SCM_P ((SCM * str, SCM chr, int direction, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, const char * why));
static int scm_i_index (SCM * str, SCM chr, int direction,
SCM sub_start, SCM sub_end, const char * why);
/* implements index if direction > 0 otherwise rindex. */
static int
scm_i_index (str, chr, direction, sub_start, sub_end, pos, pos2, pos3, pos4,
why)
SCM * str;
SCM chr;
int direction;
SCM sub_start;
SCM sub_end;
int pos;
int pos2;
int pos3;
int pos4;
const char * why;
scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
SCM sub_end, const char *why)
{
unsigned char * p;
int x;
@ -50,13 +43,13 @@ scm_i_index (str, chr, direction, sub_start, sub_end, pos, pos2, pos3, pos4,
int upper;
int ch;
SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, pos, why);
SCM_ASSERT (SCM_ICHRP (chr), chr, pos2, why);
SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, SCM_ARG1, why);
SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG2, why);
if (sub_start == SCM_BOOL_F)
sub_start = SCM_MAKINUM (0);
SCM_ASSERT (SCM_INUMP (sub_start), sub_start, pos3, why);
SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why);
lower = SCM_INUM (sub_start);
if (lower < 0
|| lower > SCM_ROLENGTH (*str))
@ -65,7 +58,7 @@ scm_i_index (str, chr, direction, sub_start, sub_end, pos, pos2, pos3, pos4,
if (sub_end == SCM_BOOL_F)
sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
SCM_ASSERT (SCM_INUMP (sub_end), sub_end, pos4, why);
SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why);
upper = SCM_INUM (sub_end);
if (upper < SCM_INUM (sub_start)
|| upper > SCM_ROLENGTH (*str))
@ -95,11 +88,7 @@ scm_i_index (str, chr, direction, sub_start, sub_end, pos, pos2, pos3, pos4,
SCM_PROC(s_string_index, "string-index", 2, 2, 0, scm_string_index);
SCM
scm_string_index (str, chr, frm, to)
SCM str;
SCM chr;
SCM frm;
SCM to;
scm_string_index (SCM str, SCM chr, SCM frm, SCM to)
{
int pos;
@ -107,7 +96,7 @@ scm_string_index (str, chr, frm, to)
frm = SCM_BOOL_F;
if (to == SCM_UNDEFINED)
to = SCM_BOOL_F;
pos = scm_i_index (&str, chr, 1, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
pos = scm_i_index (&str, chr, 1, frm, to, s_string_index);
return (pos < 0
? SCM_BOOL_F
: SCM_MAKINUM (pos));
@ -116,11 +105,7 @@ scm_string_index (str, chr, frm, to)
SCM_PROC(s_string_rindex, "string-rindex", 2, 2, 0, scm_string_rindex);
SCM
scm_string_rindex (str, chr, frm, to)
SCM str;
SCM chr;
SCM frm;
SCM to;
scm_string_rindex (SCM str, SCM chr, SCM frm, SCM to)
{
int pos;
@ -128,106 +113,100 @@ scm_string_rindex (str, chr, frm, to)
frm = SCM_BOOL_F;
if (to == SCM_UNDEFINED)
to = SCM_BOOL_F;
pos = scm_i_index (&str, chr, -1, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_rindex);
pos = scm_i_index (&str, chr, -1, frm, to, s_string_rindex);
return (pos < 0
? SCM_BOOL_F
: SCM_MAKINUM (pos));
}
/* What is the purpose of these strange assertions in the following
`substring' functions?
SCM_ASSERT (3==scm_ilength (args), scm_makfrom0str (s_substring_move_left_x),
SCM_WNA, NULL);
Why bother to make args a `rest argument' if we are merely going to
force it to include exactly three arguments? Why not merely make
them all required arguments instead? This makes me suspicious that
the functions haven't been fully implemented. If anyone can
clarify what's going on here, please do so. -twp */
SCM_PROC(s_substring_move_left_x, "substring-move-left!", 2, 0, 1, scm_substring_move_left_x);
SCM_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_left_x);
SCM
scm_substring_move_left_x (str1, start1, args)
SCM str1;
SCM start1;
SCM args;
scm_substring_move_left_x (SCM str1, SCM start1, SCM end1,
SCM str2, SCM start2)
{
SCM end1, str2, start2;
long i, j, e;
SCM_ASSERT (3==scm_ilength (args), scm_makfrom0str (s_substring_move_left_x),
SCM_WNA, NULL);
end1 = SCM_CAR (args); args = SCM_CDR (args);
str2 = SCM_CAR (args); args = SCM_CDR (args);
start2 = SCM_CAR (args);
SCM_ASSERT (SCM_NIMP (str1) && SCM_STRINGP (str1), str1, SCM_ARG1, s_substring_move_left_x);
long s1, s2, e, len;
SCM_ASSERT (SCM_NIMP (str1) && SCM_STRINGP (str1), str1,
SCM_ARG1, s_substring_move_left_x);
SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_substring_move_left_x);
SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_substring_move_left_x);
SCM_ASSERT (SCM_NIMP (str2) && SCM_STRINGP (str2), str2, SCM_ARG4, s_substring_move_left_x);
SCM_ASSERT (SCM_NIMP (str2) && SCM_STRINGP (str2), str2,
SCM_ARG4, s_substring_move_left_x);
SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_substring_move_left_x);
i = SCM_INUM (start1), j = SCM_INUM (start2), e = SCM_INUM (end1);
SCM_ASSERT (i <= SCM_LENGTH (str1) && i >= 0, start1, SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_ASSERT (j <= SCM_LENGTH (str2) && j >= 0, start2, SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_ASSERT (e <= SCM_LENGTH (str1) && e >= 0, end1, SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_ASSERT (e-i+j <= SCM_LENGTH (str2), start2, SCM_OUTOFRANGE, s_substring_move_left_x);
while (i<e) SCM_CHARS (str2)[j++] = SCM_CHARS (str1)[i++];
return SCM_UNSPECIFIED;
s1 = SCM_INUM (start1), s2 = SCM_INUM (start2), e = SCM_INUM (end1);
len = e - s1;
SCM_ASSERT (s1 <= SCM_LENGTH (str1) && s1 >= 0, start1,
SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_ASSERT (s2 <= SCM_LENGTH (str2) && s2 >= 0, start2,
SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_ASSERT (e <= SCM_LENGTH (str1) && e >= 0, end1,
SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_ASSERT (len+s2 <= SCM_LENGTH (str2), start2,
SCM_OUTOFRANGE, s_substring_move_left_x);
SCM_SYSCALL(memmove((void *)(&(SCM_CHARS(str2)[s2])),
(void *)(&(SCM_CHARS(str1)[s1])),
len));
return scm_return_first(SCM_UNSPECIFIED, str1, str2);
}
SCM_PROC(s_substring_move_right_x, "substring-move-right!", 2, 0, 1, scm_substring_move_right_x);
SCM_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_right_x);
SCM
scm_substring_move_right_x (str1, start1, args)
SCM str1;
SCM start1;
SCM args;
scm_substring_move_right_x (SCM str1, SCM start1, SCM end1,
SCM str2, SCM start2)
{
SCM end1, str2, start2;
long i, j, e;
SCM_ASSERT (3==scm_ilength (args),
scm_makfrom0str (s_substring_move_right_x), SCM_WNA, NULL);
end1 = SCM_CAR (args); args = SCM_CDR (args);
str2 = SCM_CAR (args); args = SCM_CDR (args);
start2 = SCM_CAR (args);
SCM_ASSERT (SCM_NIMP (str1) && SCM_STRINGP (str1), str1, SCM_ARG1, s_substring_move_right_x);
long s1, s2, e, len;
SCM_ASSERT (SCM_NIMP (str1) && SCM_STRINGP (str1), str1,
SCM_ARG1, s_substring_move_right_x);
SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_substring_move_right_x);
SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_substring_move_right_x);
SCM_ASSERT (SCM_NIMP (str2) && SCM_STRINGP (str2), str2, SCM_ARG4, s_substring_move_right_x);
SCM_ASSERT (SCM_NIMP (str2) && SCM_STRINGP (str2), str2,
SCM_ARG4, s_substring_move_right_x);
SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_substring_move_right_x);
i = SCM_INUM (start1), j = SCM_INUM (start2), e = SCM_INUM (end1);
SCM_ASSERT (i <= SCM_LENGTH (str1) && i >= 0, start1, SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_ASSERT (j <= SCM_LENGTH (str2) && j >= 0, start2, SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_ASSERT (e <= SCM_LENGTH (str1) && e >= 0, end1, SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_ASSERT ((j = e-i+j) <= SCM_LENGTH (str2), start2, SCM_OUTOFRANGE, s_substring_move_right_x);
while (i<e) SCM_CHARS (str2)[--j] = SCM_CHARS (str1)[--e];
s1 = SCM_INUM (start1), s2 = SCM_INUM (start2), e = SCM_INUM (end1);
len = e-s1;
SCM_ASSERT (s1 <= SCM_LENGTH (str1) && s1 >= 0, start1,
SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_ASSERT (s2 <= SCM_LENGTH (str2) && s2 >= 0, start2,
SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_ASSERT (e <= SCM_LENGTH (str1) && e >= 0, end1,
SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_ASSERT (len+s2 <= SCM_LENGTH (str2), start2,
SCM_OUTOFRANGE, s_substring_move_right_x);
SCM_SYSCALL(memmove((void *)(&(SCM_CHARS(str2)[s2])),
(void *)(&(SCM_CHARS(str1)[s1])),
len));
return SCM_UNSPECIFIED;
}
SCM_PROC(s_substring_fill_x, "substring-fill!", 2, 0, 1, scm_substring_fill_x);
SCM_PROC(s_substring_fill_x, "substring-fill!", 4, 0, 0, scm_substring_fill_x);
SCM
scm_substring_fill_x (str, start, args)
SCM str;
SCM start;
SCM args;
scm_substring_fill_x (SCM str, SCM start, SCM end, SCM fill)
{
SCM end, fill;
long i, e;
char c;
SCM_ASSERT (2==scm_ilength (args), scm_makfrom0str (s_substring_fill_x),
SCM_WNA, NULL);
end = SCM_CAR (args); args = SCM_CDR (args);
fill = SCM_CAR (args);
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_substring_fill_x);
SCM_ASSERT (SCM_INUMP (start), start, SCM_ARG2, s_substring_fill_x);
SCM_ASSERT (SCM_INUMP (end), end, SCM_ARG3, s_substring_fill_x);
SCM_ASSERT (SCM_ICHRP (fill), fill, SCM_ARG4, s_substring_fill_x);
i = SCM_INUM (start), e = SCM_INUM (end);c = SCM_ICHR (fill);
SCM_ASSERT (i <= SCM_LENGTH (str) && i >= 0, start, SCM_OUTOFRANGE, s_substring_fill_x);
SCM_ASSERT (e <= SCM_LENGTH (str) && e >= 0, end, SCM_OUTOFRANGE, s_substring_fill_x);
SCM_ASSERT (i <= SCM_LENGTH (str) && i >= 0, start,
SCM_OUTOFRANGE, s_substring_fill_x);
SCM_ASSERT (e <= SCM_LENGTH (str) && e >= 0, end,
SCM_OUTOFRANGE, s_substring_fill_x);
while (i<e) SCM_CHARS (str)[i++] = c;
return SCM_UNSPECIFIED;
}
@ -316,6 +295,14 @@ scm_string_upcase_x (v)
return v;
}
SCM_PROC(s_string_upcase, "string-upcase", 1, 0, 0, scm_string_upcase);
SCM
scm_string_upcase(SCM str)
{
return scm_string_upcase_x(scm_string_copy(str));
}
SCM_PROC(s_string_downcase_x, "string-downcase!", 1, 0, 0, scm_string_downcase_x);
SCM
@ -326,20 +313,70 @@ scm_string_downcase_x (v)
register unsigned char *cs;
SCM_ASRTGO (SCM_NIMP (v), badarg1);
k = SCM_LENGTH (v);
switch SCM_TYP7
(v)
switch (SCM_TYP7(v))
{
case scm_tc7_string:
cs = SCM_UCHARS (v);
while (k--)
cs[k] = scm_downcase(cs[k]);
break;
default:
case scm_tc7_string:
cs = SCM_UCHARS (v);
while (k--)
cs[k] = scm_downcase(cs[k]);
break;
default:
badarg1:scm_wta (v, (char *) SCM_ARG1, s_string_downcase_x);
}
return v;
}
SCM_PROC(s_string_downcase, "string-downcase", 1, 0, 0, scm_string_downcase);
SCM
scm_string_downcase(SCM str)
{
SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, SCM_ARG1, s_string_downcase);
return scm_string_downcase_x(scm_string_copy(str));
}
SCM_PROC(s_string_capitalize_x, "string-capitalize!", 1, 0, 0, scm_string_capitalize_x);
SCM
scm_string_capitalize_x (SCM s)
{
char *str;
int i, len, in_word=0;
SCM_ASSERT(SCM_NIMP(s) && SCM_STRINGP(s), str, SCM_ARG1, s_string_capitalize_x);
len = SCM_LENGTH(s);
str = SCM_CHARS(s);
for(i=0; i<len; i++) {
if(SCM_NFALSEP(scm_char_alphabetic_p(SCM_MAKICHR(str[i])))) {
if(!in_word) {
str[i] = scm_upcase(str[i]);
in_word = 1;
} else {
str[i] = scm_downcase(str[i]);
}
}
else in_word = 0;
}
return s;
}
SCM_PROC(s_string_capitalize, "string-capitalize", 1, 0, 0, scm_string_capitalize);
SCM
scm_string_capitalize(SCM s)
{
SCM_ASSERT((SCM_NIMP(s)) && (SCM_STRINGP(s)), s, SCM_ARG1, s_string_capitalize);
return scm_string_capitalize_x(scm_string_copy(s));
}
SCM_PROC(s_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, scm_string_ci_to_symbol);
SCM
scm_string_ci_to_symbol(SCM str)
{
return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P
? scm_string_downcase(str)
: str);
}
void
scm_init_strop ()

View file

@ -49,17 +49,23 @@
extern SCM scm_string_index SCM_P ((SCM str, SCM chr, SCM frm, SCM to));
extern SCM scm_string_rindex SCM_P ((SCM str, SCM chr, SCM frm, SCM to));
extern SCM scm_substring_move_left_x SCM_P ((SCM str1, SCM start1, SCM args));
extern SCM scm_substring_move_right_x SCM_P ((SCM str1, SCM start1, SCM args));
extern SCM scm_substring_fill_x SCM_P ((SCM str, SCM start, SCM args));
extern SCM scm_string_null_p SCM_P ((SCM str));
extern SCM scm_string_to_list SCM_P ((SCM str));
extern SCM scm_string_copy SCM_P ((SCM str));
extern SCM scm_string_fill_x SCM_P ((SCM str, SCM chr));
extern void scm_init_strop SCM_P ((void));
extern SCM scm_string_upcase_x SCM_P ((SCM v));
extern SCM scm_string_downcase_x SCM_P ((SCM v));
extern SCM scm_string_index (SCM str, SCM chr, SCM frm, SCM to);
extern SCM scm_string_rindex (SCM str, SCM chr, SCM frm, SCM to);
extern SCM scm_substring_move_left_x (SCM str1, SCM start1, SCM end1,
SCM str2, SCM start2);
extern SCM scm_substring_move_right_x (SCM str1, SCM start1, SCM end1,
SCM str2, SCM start2);
extern SCM scm_substring_fill_x (SCM str, SCM start, SCM end, SCM fill);
extern SCM scm_string_null_p (SCM str);
extern SCM scm_string_to_list (SCM str);
extern SCM scm_string_copy (SCM str);
extern SCM scm_string_fill_x (SCM str, SCM chr);
extern void scm_init_strop (void);
extern SCM scm_string_upcase_x (SCM v);
extern SCM scm_string_upcase (SCM v);
extern SCM scm_string_downcase_x (SCM v);
extern SCM scm_string_downcase (SCM v);
extern SCM scm_string_capitalize_x (SCM v);
extern SCM scm_string_ci_to_symbol (SCM v);
#endif /* STROPH */