1 /* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23 #include "libguile/_scm.h"
24 #include "libguile/chars.h"
25 #include "libguile/root.h"
26 #include "libguile/strings.h"
27 #include "libguile/deprecation.h"
28 #include "libguile/validate.h"
35 SCM_DEFINE (scm_string_p
, "string?", 1, 0, 0,
37 "Return @code{#t} if @var{obj} is a string, else @code{#f}.")
38 #define FUNC_NAME s_scm_string_p
40 return SCM_BOOL (SCM_STRINGP (obj
));
45 SCM_REGISTER_PROC (s_scm_list_to_string
, "list->string", 1, 0, 0, scm_string
);
47 SCM_DEFINE (scm_string
, "string", 0, 0, 1,
49 "@deffnx {Scheme Procedure} list->string chrs\n"
50 "Return a newly allocated string composed of the arguments,\n"
52 #define FUNC_NAME s_scm_string
57 long i
= scm_ilength (chrs
);
59 SCM_ASSERT (i
>= 0, chrs
, SCM_ARG1
, FUNC_NAME
);
60 result
= scm_allocate_string (i
);
64 unsigned char *data
= SCM_STRING_UCHARS (result
);
66 while (!SCM_NULLP (chrs
))
68 SCM elt
= SCM_CAR (chrs
);
70 SCM_VALIDATE_CHAR (SCM_ARGn
, elt
);
71 *data
++ = SCM_CHAR (elt
);
72 chrs
= SCM_CDR (chrs
);
80 /* converts C scm_array of strings to SCM scm_list of strings. */
81 /* If argc < 0, a null terminated scm_array is assumed. */
83 scm_makfromstrs (int argc
, char **argv
)
88 for (i
= 0; argv
[i
]; i
++);
90 lst
= scm_cons (scm_mem2string (argv
[i
], strlen (argv
[i
])), lst
);
95 /* This function must only be applied to memory obtained via malloc,
96 since the GC is going to apply `free' to it when the string is
99 Also, s[len] must be `\0', since we promise that strings are
100 null-terminated. Perhaps we could handle non-null-terminated
101 strings by claiming they're shared substrings of a string we just
104 scm_take_str (char *s
, size_t len
)
105 #define FUNC_NAME "scm_take_str"
109 SCM_ASSERT_RANGE (2, scm_ulong2num (len
), len
<= SCM_STRING_MAX_LENGTH
);
111 answer
= scm_cell (SCM_MAKE_STRING_TAG (len
), (scm_t_bits
) s
);
112 scm_gc_register_collectable_memory (s
, len
+1, "string");
119 /* `s' must be a malloc'd string. See scm_take_str. */
121 scm_take0str (char *s
)
123 return scm_take_str (s
, strlen (s
));
128 scm_mem2string (const char *src
, size_t len
)
130 SCM s
= scm_allocate_string (len
);
131 char *dst
= SCM_STRING_CHARS (s
);
132 memcpy (dst
, src
, len
);
138 scm_str2string (const char *src
)
140 return scm_mem2string (src
, strlen (src
));
145 scm_makfrom0str (const char *src
)
147 if (!src
) return SCM_BOOL_F
;
148 return scm_mem2string (src
, strlen (src
));
153 scm_makfrom0str_opt (const char *src
)
155 return scm_makfrom0str (src
);
160 scm_allocate_string (size_t len
)
161 #define FUNC_NAME "scm_allocate_string"
166 SCM_ASSERT_RANGE (1, scm_long2num (len
), len
<= SCM_STRING_MAX_LENGTH
);
168 mem
= (char *) scm_gc_malloc (len
+ 1, "string");
171 s
= scm_cell (SCM_MAKE_STRING_TAG (len
), (scm_t_bits
) mem
);
178 SCM_DEFINE (scm_make_string
, "make-string", 1, 1, 0,
180 "Return a newly allocated string of\n"
181 "length @var{k}. If @var{chr} is given, then all elements of\n"
182 "the string are initialized to @var{chr}, otherwise the contents\n"
183 "of the @var{string} are unspecified.")
184 #define FUNC_NAME s_scm_make_string
188 long int i
= SCM_INUM (k
);
191 SCM_ASSERT_RANGE (1, k
, i
>= 0);
193 res
= scm_allocate_string (i
);
194 if (!SCM_UNBNDP (chr
))
198 SCM_VALIDATE_CHAR (2, chr
);
200 dst
= SCM_STRING_UCHARS (res
);
201 memset (dst
, SCM_CHAR (chr
), i
);
206 else if (SCM_BIGP (k
))
207 SCM_OUT_OF_RANGE (1, k
);
209 SCM_WRONG_TYPE_ARG (1, k
);
214 SCM_DEFINE (scm_string_length
, "string-length", 1, 0, 0,
216 "Return the number of characters in @var{string}.")
217 #define FUNC_NAME s_scm_string_length
219 SCM_VALIDATE_STRING (1, string
);
220 return SCM_MAKINUM (SCM_STRING_LENGTH (string
));
224 SCM_DEFINE (scm_string_ref
, "string-ref", 2, 0, 0,
226 "Return character @var{k} of @var{str} using zero-origin\n"
227 "indexing. @var{k} must be a valid index of @var{str}.")
228 #define FUNC_NAME s_scm_string_ref
232 SCM_VALIDATE_STRING (1, str
);
233 SCM_VALIDATE_INUM_COPY (2, k
, idx
);
234 SCM_ASSERT_RANGE (2, k
, idx
>= 0 && idx
< SCM_STRING_LENGTH (str
));
235 return SCM_MAKE_CHAR (SCM_STRING_UCHARS (str
)[idx
]);
240 SCM_DEFINE (scm_string_set_x
, "string-set!", 3, 0, 0,
241 (SCM str
, SCM k
, SCM chr
),
242 "Store @var{chr} in element @var{k} of @var{str} and return\n"
243 "an unspecified value. @var{k} must be a valid index of\n"
245 #define FUNC_NAME s_scm_string_set_x
247 SCM_VALIDATE_STRING (1, str
);
248 SCM_VALIDATE_INUM_RANGE (2, k
,0, SCM_STRING_LENGTH(str
));
249 SCM_VALIDATE_CHAR (3, chr
);
250 SCM_STRING_UCHARS (str
)[SCM_INUM (k
)] = SCM_CHAR (chr
);
251 return SCM_UNSPECIFIED
;
256 SCM_DEFINE (scm_substring
, "substring", 2, 1, 0,
257 (SCM str
, SCM start
, SCM end
),
258 "Return a newly allocated string formed from the characters\n"
259 "of @var{str} beginning with index @var{start} (inclusive) and\n"
260 "ending with index @var{end} (exclusive).\n"
261 "@var{str} must be a string, @var{start} and @var{end} must be\n"
262 "exact integers satisfying:\n\n"
263 "0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
264 #define FUNC_NAME s_scm_substring
270 SCM_VALIDATE_STRING (1, str
);
271 SCM_VALIDATE_INUM (2, start
);
272 SCM_VALIDATE_INUM_DEF (3, end
, SCM_STRING_LENGTH (str
));
274 from
= SCM_INUM (start
);
275 SCM_ASSERT_RANGE (2, start
, 0 <= from
&& from
<= SCM_STRING_LENGTH (str
));
277 SCM_ASSERT_RANGE (3, end
, from
<= to
&& to
<= SCM_STRING_LENGTH (str
));
279 substr
= scm_mem2string (&SCM_STRING_CHARS (str
)[from
], to
- from
);
280 scm_remember_upto_here_1 (str
);
286 SCM_DEFINE (scm_string_append
, "string-append", 0, 0, 1,
288 "Return a newly allocated string whose characters form the\n"
289 "concatenation of the given strings, @var{args}.")
290 #define FUNC_NAME s_scm_string_append
295 register unsigned char *data
;
297 SCM_VALIDATE_REST_ARGUMENT (args
);
298 for (l
= args
; !SCM_NULLP (l
); l
= SCM_CDR (l
)) {
300 SCM_VALIDATE_STRING (SCM_ARGn
, s
);
301 i
+= SCM_STRING_LENGTH (s
);
303 res
= scm_allocate_string (i
);
304 data
= SCM_STRING_UCHARS (res
);
305 for (l
= args
; !SCM_NULLP (l
);l
= SCM_CDR (l
)) {
307 for (i
= 0;i
<SCM_STRING_LENGTH (s
);i
++) *data
++ = SCM_STRING_UCHARS (s
)[i
];
314 /* Converts the given Scheme string OBJ into a C string, containing a copy
315 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
316 *LENP to the string's length.
318 When STR is non-NULL it receives the copy and is returned by the function,
319 otherwise new memory is allocated and the caller is responsible for
320 freeing it via free(). If out of memory, NULL is returned.
322 Note that Scheme strings may contain arbitrary data, including null
323 characters. This means that null termination is not a reliable way to
324 determine the length of the returned value. However, the function always
325 copies the complete contents of OBJ, and sets *LENP to the length of the
326 scheme string (if LENP is non-null). */
327 #define FUNC_NAME "scm_c_string2str"
329 scm_c_string2str (SCM obj
, char *str
, size_t *lenp
)
333 SCM_ASSERT (SCM_STRINGP (obj
), obj
, SCM_ARG1
, FUNC_NAME
);
334 len
= SCM_STRING_LENGTH (obj
);
338 /* FIXME: Should we use exported wrappers for malloc (and free), which
339 * allow windows DLLs to call the correct freeing function? */
340 str
= (char *) scm_malloc ((len
+ 1) * sizeof (char));
345 memcpy (str
, SCM_STRING_CHARS (obj
), len
);
346 scm_remember_upto_here_1 (obj
);
357 /* Copy LEN characters at START from the Scheme string OBJ to memory
358 at STR. START is an index into OBJ; zero means the beginning of
359 the string. STR has already been allocated by the caller.
361 If START + LEN is off the end of OBJ, silently truncate the source
362 region to fit the string. If truncation occurs, the corresponding
363 area of STR is left unchanged. */
364 #define FUNC_NAME "scm_c_substring2str"
366 scm_c_substring2str (SCM obj
, char *str
, size_t start
, size_t len
)
368 size_t src_length
, effective_length
;
370 SCM_ASSERT (SCM_STRINGP (obj
), obj
, SCM_ARG2
, FUNC_NAME
);
371 src_length
= SCM_STRING_LENGTH (obj
);
372 effective_length
= (len
+ start
<= src_length
) ? len
: src_length
- start
;
373 memcpy (str
, SCM_STRING_CHARS (obj
) + start
, effective_length
);
374 scm_remember_upto_here_1 (obj
);
383 scm_nullstr
= scm_allocate_string (0);
385 #include "libguile/strings.x"