sexp sexp_string_count (sexp ctx, sexp self, sexp ch, sexp str, sexp start, sexp end) {
const unsigned char *s, *e;
sexp_sint_t c, count = 0;
#if SEXP_USE_UTF8_STRINGS
sexp_sint_t i;
#endif
sexp_assert_type(ctx, sexp_charp, SEXP_CHAR, ch);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, start);
if (sexp_not(end)) end = sexp_make_fixnum(sexp_string_size(str));
else sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, end);
c = sexp_unbox_character(ch);
#if SEXP_USE_UTF8_STRINGS
if (c < 128) {
#endif
s = (unsigned char*)sexp_string_data(str) + sexp_unbox_fixnum(start);
e = (unsigned char*)sexp_string_data(str) + sexp_unbox_fixnum(end);
if (e > (unsigned char*)sexp_string_data(str) + sexp_string_size(str))
return sexp_user_exception(ctx, self, "string-count: end index out of range", end);
/* fast case for ASCII chars */
while (s < e) if (*s++ == c) count++;
#if SEXP_USE_UTF8_STRINGS
} else {
/* decode utf8 chars */
s = (unsigned char*)sexp_string_data(str);
for (i = sexp_unbox_fixnum(start); i < sexp_unbox_fixnum(end);
i += sexp_utf8_initial_byte_count(s[i]))
if (sexp_string_utf8_ref(ctx, str, sexp_make_fixnum(i)) == ch) count++;
}
#endif
return sexp_make_fixnum(count);
}
static sexp sexp_string_cursor_copy (sexp ctx, sexp self, sexp_sint_t n, sexp dst, sexp sfrom, sexp src, sexp sstart, sexp send) {
unsigned char *pfrom, *pto, *pstart, *pend, *prev, *p;
sexp_sint_t from = sexp_unbox_fixnum(sfrom), to = sexp_string_size(dst),
start = sexp_unbox_fixnum(sstart), end = sexp_unbox_fixnum(send);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, dst);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, src);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, sfrom);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, sstart);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, send);
if (from < 0 || from > to)
return sexp_user_exception(ctx, self, "string-cursor-copy!: from out of range", sfrom);
if (start < 0 || start > sexp_string_size(src))
return sexp_user_exception(ctx, self, "string-cursor-copy!: start out of range", sstart);
if (end < start || end > sexp_string_size(src))
return sexp_user_exception(ctx, self, "string-cursor-copy!: end out of range", send);
pfrom = (unsigned char*)sexp_string_data(dst) + from;
pto = (unsigned char*)sexp_string_data(dst) + to;
pstart = (unsigned char*)sexp_string_data(src) + start;
pend = (unsigned char*)sexp_string_data(src) + end;
for ( ; pfrom < pto && pstart < pend; ++pfrom, ++pstart)
*pfrom = *pstart;
/* adjust for incomplete trailing chars */
prev = (unsigned char*)sexp_string_utf8_prev(pfrom);
if (sexp_utf8_initial_byte_count(*prev) > pfrom - prev) {
for (p = prev; p < pfrom; ++p)
*p = '\0';
pstart -= pfrom - prev;
}
return sexp_make_fixnum(pstart - (unsigned char*)sexp_string_data(src));
}
static sexp sexp_random_source_state_set (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp state) {
if (! sexp_random_source_p(rs))
return sexp_type_exception(ctx, self, rs_type_id, rs);
else if (! (sexp_stringp(state)
&& (sexp_string_size(state) == SEXP_RANDOM_STATE_SIZE)))
return sexp_type_exception(ctx, self, SEXP_STRING, state);
sexp_random_state(rs) = state;
sexp_random_init(rs, 1);
return SEXP_VOID;
}
sexp sexp_bytes_to_string (sexp ctx, sexp vec) {
sexp res;
#if SEXP_USE_PACKED_STRINGS
res = sexp_c_string(ctx, sexp_bytes_data(vec), sexp_bytes_length(vec));
#else
res = sexp_alloc_type(ctx, string, SEXP_STRING);
sexp_string_bytes(res) = vec;
sexp_string_offset(res) = 0;
sexp_string_size(res) = sexp_bytes_length(vec);
#endif
return res;
}
static ssize_t sexp_cookie_writer (void *cookie, const char *buffer, size_t size)
#endif
{
sexp vec = (sexp)cookie, ctx, res;
if (! sexp_procedurep(sexp_cookie_write(vec))) return -1;
sexp_gc_var2(ctx2, args);
ctx = sexp_cookie_ctx(vec);
ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
sexp_gc_preserve2(ctx, ctx2, args);
if (size > sexp_string_size(sexp_cookie_buffer(vec)))
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID));
memcpy(sexp_string_data(sexp_cookie_buffer(vec)), buffer, size);
args = sexp_list2(ctx, SEXP_ZERO, sexp_make_fixnum(size));
args = sexp_cons(ctx, sexp_cookie_buffer(vec), args);
res = sexp_apply(ctx, sexp_cookie_write(vec), args);
sexp_gc_release2(ctx);
return (sexp_fixnump(res) ? sexp_unbox_fixnum(res) : -1);
}
sexp sexp_string_to_utf8 (sexp ctx, sexp self, sexp str) {
sexp res;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str);
res = sexp_c_string(ctx, sexp_string_data(str), sexp_string_size(str));
return sexp_string_to_bytes(ctx, res);
}