1 /* classes: src_files */
3 /* Copyright (C) 1994 Free Software Foundation, Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this software; see the file COPYING. If not, write to
17 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
30 scm_i_index (SCM
* str
, SCM chr
, SCM sub_start
, SCM sub_end
, int pos
, int pos2
, int pos3
, int pos4
, char * why
)
33 scm_i_index (str
, chr
, sub_start
, sub_end
, pos
, pos2
, pos3
, pos4
, why
)
50 SCM_ASSERT (SCM_NIMP (*str
) && SCM_ROSTRINGP (*str
), *str
, pos
, why
);
51 SCM_ASSERT (SCM_ICHRP (chr
), chr
, pos2
, why
);
53 if (sub_start
== SCM_BOOL_F
)
54 sub_start
= SCM_MAKINUM (0);
56 SCM_ASSERT ( SCM_INUMP (sub_start
)
57 && (0 <= SCM_INUM (sub_start
))
58 && (SCM_INUM (sub_start
) <= SCM_ROLENGTH (*str
)),
59 sub_start
, pos3
, why
);
61 if (sub_end
== SCM_BOOL_F
)
62 sub_end
= SCM_MAKINUM (SCM_ROLENGTH (*str
));
64 SCM_ASSERT ( SCM_INUMP (sub_end
)
65 && (SCM_INUM (sub_start
) <= SCM_INUM (sub_end
))
66 && (SCM_INUM (sub_end
) <= SCM_ROLENGTH (*str
)),
69 p
= (unsigned char *)SCM_ROCHARS (*str
) + SCM_INUM (sub_start
);
70 bound
= SCM_INUM (sub_end
);
73 for (x
= SCM_INUM (sub_start
); x
< bound
; ++x
, ++p
)
82 scm_i_rindex (SCM
* str
, SCM chr
, SCM sub_start
, SCM sub_end
, int pos
, int pos2
, int pos3
, int pos4
, char * why
)
85 scm_i_rindex (str
, chr
, sub_start
, sub_end
, pos
, pos2
, pos3
, pos4
, why
)
103 SCM_ASSERT (SCM_NIMP (*str
) && SCM_ROSTRINGP (*str
), *str
, pos
, why
);
104 SCM_ASSERT (SCM_ICHRP (chr
), chr
, pos2
, why
);
106 if (sub_start
== SCM_BOOL_F
)
107 sub_start
= SCM_MAKINUM (0);
109 SCM_ASSERT ( SCM_INUMP (sub_start
)
110 && (0 <= SCM_INUM (sub_start
))
111 && (SCM_INUM (sub_start
) <= SCM_ROLENGTH (*str
)),
112 sub_start
, pos3
, why
);
114 if (sub_end
== SCM_BOOL_F
)
115 sub_end
= SCM_MAKINUM (SCM_ROLENGTH (*str
));
117 SCM_ASSERT ( SCM_INUMP (sub_end
)
118 && (SCM_INUM (sub_start
) <= SCM_INUM (sub_end
))
119 && (SCM_INUM (sub_end
) <= SCM_ROLENGTH (*str
)),
122 upper_bound
= SCM_INUM (sub_end
);
123 lower_bound
= SCM_INUM (sub_start
);
124 p
= upper_bound
- 1 + (unsigned char *)SCM_ROCHARS (*str
);
126 for (x
= upper_bound
- 1; x
>= lower_bound
; --x
, --p
)
134 SCM_PROC(s_string_index
, "string-index", 2, 2, 0, scm_string_index
);
137 scm_string_index (SCM str
, SCM chr
, SCM frm
, SCM to
)
140 scm_string_index (str
, chr
, frm
, to
)
149 if (frm
== SCM_UNDEFINED
)
151 if (to
== SCM_UNDEFINED
)
153 pos
= scm_i_index (&str
, chr
, frm
, to
, SCM_ARG1
, SCM_ARG2
, SCM_ARG3
, SCM_ARG4
, s_string_index
);
156 : SCM_MAKINUM (pos
));
159 SCM_PROC(s_string_rindex
, "string-rindex", 2, 2, 0, scm_string_rindex
);
162 scm_string_rindex (SCM str
, SCM chr
, SCM frm
, SCM to
)
165 scm_string_rindex (str
, chr
, frm
, to
)
174 if (frm
== SCM_UNDEFINED
)
176 if (to
== SCM_UNDEFINED
)
178 pos
= scm_i_rindex (&str
, chr
, frm
, to
, SCM_ARG1
, SCM_ARG2
, SCM_ARG3
, SCM_ARG4
, s_string_index
);
181 : SCM_MAKINUM (pos
));
189 SCM_PROC(s_substring_move_left_x
, "substring-move-left!", 2, 0, 1, scm_substring_move_left_x
);
192 scm_substring_move_left_x (SCM str1
, SCM start1
, SCM args
)
195 scm_substring_move_left_x (str1
, start1
, args
)
201 SCM end1
, str2
, start2
;
203 SCM_ASSERT (3==scm_ilength (args
), args
, SCM_WNA
, s_substring_move_left_x
);
204 end1
= SCM_CAR (args
); args
= SCM_CDR (args
);
205 str2
= SCM_CAR (args
); args
= SCM_CDR (args
);
206 start2
= SCM_CAR (args
);
207 SCM_ASSERT (SCM_NIMP (str1
) && SCM_STRINGP (str1
), str1
, SCM_ARG1
, s_substring_move_left_x
);
208 SCM_ASSERT (SCM_INUMP (start1
), start1
, SCM_ARG2
, s_substring_move_left_x
);
209 SCM_ASSERT (SCM_INUMP (end1
), end1
, SCM_ARG3
, s_substring_move_left_x
);
210 SCM_ASSERT (SCM_NIMP (str2
) && SCM_STRINGP (str2
), str2
, SCM_ARG4
, s_substring_move_left_x
);
211 SCM_ASSERT (SCM_INUMP (start2
), start2
, SCM_ARG5
, s_substring_move_left_x
);
212 i
= SCM_INUM (start1
), j
= SCM_INUM (start2
), e
= SCM_INUM (end1
);
213 SCM_ASSERT (i
<= SCM_LENGTH (str1
) && i
>= 0, start1
, SCM_OUTOFRANGE
, s_substring_move_left_x
);
214 SCM_ASSERT (j
<= SCM_LENGTH (str2
) && j
>= 0, start2
, SCM_OUTOFRANGE
, s_substring_move_left_x
);
215 SCM_ASSERT (e
<= SCM_LENGTH (str1
) && e
>= 0, end1
, SCM_OUTOFRANGE
, s_substring_move_left_x
);
216 SCM_ASSERT (e
-i
+j
<= SCM_LENGTH (str2
), start2
, SCM_OUTOFRANGE
, s_substring_move_left_x
);
217 while (i
<e
) SCM_CHARS (str2
)[j
++] = SCM_CHARS (str1
)[i
++];
218 return SCM_UNSPECIFIED
;
222 SCM_PROC(s_substring_move_right_x
, "substring-move-right!", 2, 0, 1, scm_substring_move_right_x
);
225 scm_substring_move_right_x (SCM str1
, SCM start1
, SCM args
)
228 scm_substring_move_right_x (str1
, start1
, args
)
234 SCM end1
, str2
, start2
;
236 SCM_ASSERT (3==scm_ilength (args
), args
, SCM_WNA
, s_substring_move_right_x
);
237 end1
= SCM_CAR (args
); args
= SCM_CDR (args
);
238 str2
= SCM_CAR (args
); args
= SCM_CDR (args
);
239 start2
= SCM_CAR (args
);
240 SCM_ASSERT (SCM_NIMP (str1
) && SCM_STRINGP (str1
), str1
, SCM_ARG1
, s_substring_move_right_x
);
241 SCM_ASSERT (SCM_INUMP (start1
), start1
, SCM_ARG2
, s_substring_move_right_x
);
242 SCM_ASSERT (SCM_INUMP (end1
), end1
, SCM_ARG3
, s_substring_move_right_x
);
243 SCM_ASSERT (SCM_NIMP (str2
) && SCM_STRINGP (str2
), str2
, SCM_ARG4
, s_substring_move_right_x
);
244 SCM_ASSERT (SCM_INUMP (start2
), start2
, SCM_ARG5
, s_substring_move_right_x
);
245 i
= SCM_INUM (start1
), j
= SCM_INUM (start2
), e
= SCM_INUM (end1
);
246 SCM_ASSERT (i
<= SCM_LENGTH (str1
) && i
>= 0, start1
, SCM_OUTOFRANGE
, s_substring_move_right_x
);
247 SCM_ASSERT (j
<= SCM_LENGTH (str2
) && j
>= 0, start2
, SCM_OUTOFRANGE
, s_substring_move_right_x
);
248 SCM_ASSERT (e
<= SCM_LENGTH (str1
) && e
>= 0, end1
, SCM_OUTOFRANGE
, s_substring_move_right_x
);
249 SCM_ASSERT ((j
= e
-i
+j
) <= SCM_LENGTH (str2
), start2
, SCM_OUTOFRANGE
, s_substring_move_right_x
);
250 while (i
<e
) SCM_CHARS (str2
)[--j
] = SCM_CHARS (str1
)[--e
];
251 return SCM_UNSPECIFIED
;
255 SCM_PROC(s_substring_fill_x
, "substring-fill!", 2, 0, 1, scm_substring_fill_x
);
258 scm_substring_fill_x (SCM str
, SCM start
, SCM args
)
261 scm_substring_fill_x (str
, start
, args
)
270 SCM_ASSERT (2==scm_ilength (args
), args
, SCM_WNA
, s_substring_fill_x
);
271 end
= SCM_CAR (args
); args
= SCM_CDR (args
);
272 fill
= SCM_CAR (args
);
273 SCM_ASSERT (SCM_NIMP (str
) && SCM_STRINGP (str
), str
, SCM_ARG1
, s_substring_fill_x
);
274 SCM_ASSERT (SCM_INUMP (start
), start
, SCM_ARG2
, s_substring_fill_x
);
275 SCM_ASSERT (SCM_INUMP (end
), end
, SCM_ARG3
, s_substring_fill_x
);
276 SCM_ASSERT (SCM_ICHRP (fill
), fill
, SCM_ARG4
, s_substring_fill_x
);
277 i
= SCM_INUM (start
), e
= SCM_INUM (end
);c
= SCM_ICHR (fill
);
278 SCM_ASSERT (i
<= SCM_LENGTH (str
) && i
>= 0, start
, SCM_OUTOFRANGE
, s_substring_fill_x
);
279 SCM_ASSERT (e
<= SCM_LENGTH (str
) && e
>= 0, end
, SCM_OUTOFRANGE
, s_substring_fill_x
);
280 while (i
<e
) SCM_CHARS (str
)[i
++] = c
;
281 return SCM_UNSPECIFIED
;
285 SCM_PROC(s_string_null_p
, "string-null?", 1, 0, 0, scm_string_null_p
);
288 scm_string_null_p (SCM str
)
291 scm_string_null_p (str
)
295 SCM_ASSERT (SCM_NIMP (str
) && SCM_ROSTRINGP (str
), str
, SCM_ARG1
, s_string_null_p
);
296 return (SCM_ROLENGTH (str
)
302 SCM_PROC(s_string_to_list
, "string->list", 1, 0, 0, scm_string_to_list
);
305 scm_string_to_list (SCM str
)
308 scm_string_to_list (str
)
315 SCM_ASSERT (SCM_NIMP (str
) && SCM_ROSTRINGP (str
), str
, SCM_ARG1
, s_string_to_list
);
316 src
= SCM_ROUCHARS (str
);
317 for (i
= SCM_ROLENGTH (str
)-1;i
>= 0;i
--) res
= scm_cons ((SCM
)SCM_MAKICHR (src
[i
]), res
);
323 SCM_PROC(s_string_copy
, "string-copy", 1, 0, 0, scm_string_copy
);
326 scm_string_copy (SCM str
)
329 scm_string_copy (str
)
333 SCM_ASSERT (SCM_NIMP (str
) && SCM_STRINGP (str
), str
, SCM_ARG1
, s_string_copy
);
334 return scm_makfromstr (SCM_CHARS (str
), (scm_sizet
)SCM_LENGTH (str
), 0);
338 SCM_PROC(s_string_fill_x
, "string-fill!", 2, 0, 0, scm_string_fill_x
);
341 scm_string_fill_x (SCM str
, SCM chr
)
344 scm_string_fill_x (str
, chr
)
349 register char *dst
, c
;
351 SCM_ASSERT (SCM_NIMP (str
) && SCM_STRINGP (str
), str
, SCM_ARG1
, s_string_fill_x
);
352 SCM_ASSERT (SCM_ICHRP (chr
), chr
, SCM_ARG2
, s_string_fill_x
);
354 dst
= SCM_CHARS (str
);
355 for (k
= SCM_LENGTH (str
)-1;k
>= 0;k
--) dst
[k
] = c
;
356 return SCM_UNSPECIFIED
;
362 scm_init_strop (void)