SCM scm_gunzip_buf(SCM scm_buf, SCM scm_outlen){
//this should typecheck buf for us
size_t buflen = scm_c_bytevector_length(scm_buf);
uint8_t *buf = (uint8_t*)SCM_BYTEVECTOR_CONTENTS(scm_buf);
size_t outlen = scm_to_size_t(scm_outlen);
uint8_t *out = scm_gc_malloc_pointerless(outlen, SCM_GC_BYTEVECTOR);
z_stream stream = {.next_in = buf, .avail_in = buflen,
.next_out = out, .avail_out = outlen,
.zalloc = NULL, .zfree = NULL, .opaque = NULL};
//15 | 16 means use 15 bits for the decompression window, and only accept
//gzip compressed buffers
inflateInit2(&stream, 15 | 16);
int status = inflate(&stream, Z_FINISH);
if(status != Z_STREAM_END){ //the output buffer was too small
//Do something useful here, for now this just makes sure that
//we don't cause any errors
fprintf(stderr, "Return value was %d, expecting %d\n",
status, Z_FINISH);
scm_gc_free(out, outlen, SCM_GC_BYTEVECTOR);
SCM ret = scm_from_utf8_string(stream.msg);
inflateEnd(&stream);
return ret;
}
//I don't know what the tag bits for a bytevector are so I need to
//make an empty one.
SCM bv = scm_c_make_bytevector(0);
SCM_SET_CELL_WORD_1(bv, stream.total_out);
SCM_SET_CELL_WORD_2(bv, out);
inflateEnd(&stream);
return bv;
}
VISIBLE SCM
scm_rexp_interval (SCM match, SCM subexpression)
{
rexp_interval_t interv = rexp_interval (scm_to_rexp_match_t (match),
scm_to_size_t (subexpression));
return ((interv.i_start == -1) ?
SCM_BOOL_F : scm_list_2 (scm_from_int (interv.i_start),
scm_from_int (interv.i_end)));
}
VISIBLE SCM
scm_rexp_substring (SCM match, SCM string, SCM subexpression)
{
uint8_t *_string = (uint8_t *) scm_to_utf8_stringn (string, NULL);
uint8_t *_substring = u8_rexp_substr (scm_to_rexp_match_t (match), _string,
scm_to_size_t (subexpression));
free (_string);
return (_substring == NULL) ?
SCM_BOOL_F : scm_from_utf8_string ((const char *) _substring);
}
static SCM
scm_elev_scm_spline (const char *who,
void elev_scm_spline (size_t new_degree,
size_t degree,
ssize_t stride,
const SCM *spline,
ssize_t result_stride,
SCM *result),
SCM new_degree, SCM spline)
{
scm_t_array_handle handle;
scm_t_array_handle handle2;
scm_dynwind_begin (0);
const size_t _new_degree = scm_to_size_t (new_degree);
scm_array_get_handle (spline, &handle);
scm_dynwind_array_handle_release (&handle);
assert_c_rank_1_or_2_array (who, spline, &handle);
size_t dim;
ssize_t stride;
scm_array_handle_get_vector_dim_and_stride (who, spline, &handle,
&dim, &stride);
const SCM *_spline = scm_array_handle_elements (&handle);
if (_new_degree < dim - 1)
the_new_degree_is_not_an_elevation (who, new_degree,
scm_from_size_t (dim - 1), spline);
SCM result = scm_make_array (SCM_UNSPECIFIED,
scm_list_1 (scm_oneplus (new_degree)));
scm_array_get_handle (result, &handle2);
scm_dynwind_array_handle_release (&handle2);
SCM *_result = scm_array_handle_writable_elements (&handle2);
elev_scm_spline (_new_degree, dim - 1, stride, _spline, 1, _result);
scm_dynwind_end ();
return result;
}
SCM
yacl_scm_get_random (SCM len)
{
if (!scm_is_integer (len))
goto EXCEPTION;
size_t rndlen = scm_to_size_t (len);
SCM rnd = scm_c_make_bytevector (rndlen);
int rc = yacl_get_random(SCM_BYTEVECTOR_CONTENTS (rnd), rndlen);
if (rc)
goto EXCEPTION;
else
goto OUT;
EXCEPTION:
scm_throw (scm_from_locale_symbol ("BADRANDOM"), SCM_BOOL_T);
OUT:
return rnd;
}
