int
strm_str_eq(strm_string a, strm_string b)
{
if (a == b) return TRUE;
if (strm_value_tag(a) == STRM_TAG_STRING_F &&
strm_value_tag(b) == STRM_TAG_STRING_F) {
/* pointer comparison is OK if strings are interned */
return FALSE;
}
if (strm_str_len(a) != strm_str_len(b)) return FALSE;
if (memcmp(strm_str_ptr(a), strm_str_ptr(b), strm_str_len(a)) == 0)
return TRUE;
return FALSE;
}
int32_t
strm_value_int(strm_value v)
{
switch (strm_value_tag(v)) {
case STRM_TAG_INT:
return strm_to_int(v);
default:
if (strm_flt_p(v))
return strm_to_flt(v);
assert(strm_value_tag(v) == STRM_TAG_INT);
break;
}
/* not reached */
return 0;
}
const char*
strm_str_cstr(strm_string s, char buf[])
{
strm_int len;
switch (strm_value_tag(s)) {
case STRM_TAG_STRING_I:
len = VAL_PTR(s)[0];
memcpy(buf, VAL_PTR(s)+1, len);
buf[len] = '\0';
return buf;
case STRM_TAG_STRING_6:
memcpy(buf, VAL_PTR(s), 6);
buf[6] = '\0';
return buf;
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
{
struct strm_string* str = (struct strm_string*)strm_value_vptr(s);
return str->ptr;
}
default:
return NULL;
}
}
int
strm_nil_p(strm_value v)
{
if (strm_value_tag(v) != STRM_TAG_PTR)
return FALSE;
return strm_value_val(v) == 0;
}
int
strm_ptr_tag_p(strm_value v, enum strm_ptr_type e)
{
if (strm_value_tag(v) == STRM_TAG_PTR) {
void *p = strm_ptr(v);
return strm_ptr_type(p) == e;
}
return FALSE;
}
void*
strm_value_ptr(strm_value v, enum strm_ptr_type e)
{
void *p;
assert(strm_value_tag(v) == STRM_TAG_PTR);
p = strm_ptr(v);
assert(p && strm_ptr_type(p) == e);
return p;
}
int
strm_value_bool(strm_value v)
{
uint64_t i = strm_value_val(v);
if (i == 0) {
switch (strm_value_tag(v)) {
case STRM_TAG_BOOL: /* false */
case STRM_TAG_PTR: /* nil */
break;
default:
assert(strm_value_tag(v) == STRM_TAG_BOOL);
break;
}
return FALSE;
}
else {
return TRUE;
}
}
int
strm_array_p(strm_value v)
{
switch (strm_value_tag(v)) {
case STRM_TAG_ARRAY:
case STRM_TAG_STRUCT:
return TRUE;
default:
return FALSE;
}
}
int
strm_value_eq(strm_value a, strm_value b)
{
if (a == b) return TRUE;
if (strm_value_tag(a) != strm_value_tag(b)) return FALSE;
switch (strm_value_tag(a)) {
case STRM_TAG_ARRAY:
case STRM_TAG_STRUCT:
return strm_ary_eq(a, b);
case STRM_TAG_STRING_I:
case STRM_TAG_STRING_6:
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
return strm_str_eq(a, b);
case STRM_TAG_CFUNC:
return (strm_cfunc)strm_value_vptr(a) == (strm_cfunc)strm_value_vptr(b);
case STRM_TAG_PTR:
return strm_value_vptr(a) == strm_value_vptr(b);
default:
return FALSE;
}
}
int
strm_str_p(strm_value v)
{
switch (strm_value_tag(v)) {
case STRM_TAG_STRING_I:
case STRM_TAG_STRING_6:
case STRM_TAG_STRING_F:
case STRM_TAG_STRING_O:
return TRUE;
default:
return FALSE;
}
}
int
strm_string_p(strm_string s)
{
switch (strm_value_tag(s)) {
case STRM_TAG_STRING_I:
case STRM_TAG_STRING_6:
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
return TRUE;
default:
return FALSE;
}
}
int
strm_value_eq(strm_value a, strm_value b)
{
if (a == b) return TRUE;
if (strm_value_tag(a) != strm_value_tag(b)) goto typediff;
switch (strm_value_tag(a)) {
case STRM_TAG_STRUCT:
return strm_ary_eq(a, b);
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
return strm_str_eq(a, b);
case STRM_TAG_CFUNC:
return (strm_cfunc)(intptr_t)strm_value_val(a) == (strm_cfunc)(intptr_t)strm_value_val(b);
case STRM_TAG_PTR:
return strm_value_vptr(a) == strm_value_vptr(b);
typediff:
default:
if (strm_number_p(a) && strm_number_p(b)) {
return strm_value_flt(a) == strm_value_flt(b);
}
return FALSE;
}
}
strm_state*
strm_value_ns(strm_value val)
{
if (strm_array_p(val))
return strm_ary_ns(val);
if (strm_value_tag(val) == STRM_TAG_PTR) {
struct strm_misc* p = strm_ptr(val);
if (strm_ptr_type(p) == STRM_PTR_MISC) {
return p->ns;
}
}
return NULL;
}
static int
str_symbol_p(strm_string str)
{
switch (strm_value_tag(str)) {
case STRM_TAG_STRING_I:
case STRM_TAG_STRING_6:
return TRUE;
case STRM_TAG_STRING_O:
return FALSE;
case STRM_TAG_STRING_F:
return TRUE;
default:
return FALSE;
}
}
const char*
strm_strp_ptr(strm_string* s)
{
switch (strm_value_tag(*s)) {
case STRM_TAG_STRING_I:
return VALP_PTR(s)+1;
case STRM_TAG_STRING_6:
return VALP_PTR(s);
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
{
struct strm_string* str = (struct strm_string*)strm_value_vptr(*s);
return str->ptr;
}
default:
return NULL;
}
}
strm_int
strm_str_len(strm_string s)
{
switch (strm_value_tag(s)) {
case STRM_TAG_STRING_I:
return (strm_int)VAL_PTR(s)[0];
case STRM_TAG_STRING_6:
return 6;
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
{
struct strm_string* str = (struct strm_string*)strm_value_vptr(s);
return str->len;
}
default:
return 0;
}
}
int
strm_funcall(strm_stream* strm, strm_value func, int argc, strm_value* argv, strm_value* ret)
{
switch (strm_value_tag(func)) {
case STRM_TAG_CFUNC:
return (strm_value_cfunc(func))(strm, argc, argv, ret);
case STRM_TAG_ARRAY:
return ary_get(strm, func, argc, argv, ret);
case STRM_TAG_PTR:
if (!strm_lambda_p(func)) {
strm_raise(strm, "not a function");
return STRM_NG;
}
else {
return lambda_call(strm, func, argc, argv, ret);
}
default:
strm_raise(strm, "not a function");
break;
}
return STRM_NG;
}
int
strm_funcall(strm_state* state, strm_value func, int argc, strm_value* argv, strm_value* ret)
{
switch (strm_value_tag(func)) {
case STRM_TAG_CFUNC:
return (strm_value_cfunc(func))(state, argc, argv, ret);
case STRM_TAG_ARRAY:
return ary_get(state, func, argc, argv, ret);
case STRM_TAG_PTR:
if (!strm_lambda_p(func)) {
strm_raise(state, "not a function");
return STRM_NG;
}
else {
strm_lambda lambda = strm_value_lambda(func);
node_lambda* nlbd = lambda->body;
node_args* args = (node_args*)nlbd->args;
strm_state c = {0};
int i, n;
c.prev = lambda->state;
if ((args == NULL && argc != 0) &&
(args->len != argc)) return STRM_NG;
for (i=0; i<argc; i++) {
n = strm_var_set(&c, node_to_sym(args->data[i]), argv[i]);
if (n) return n;
}
n = exec_expr(&c, nlbd->compstmt, ret);
if (c.exc && c.exc->type == NODE_ERROR_RETURN) {
*ret = c.exc->arg;
return STRM_OK;
}
return n;
}
default:
break;
}
return STRM_NG;
}
strm_state*
strm_value_ns(strm_value val)
{
if (strm_array_p(val)) {
strm_state* ns = strm_ary_ns(val);
if (ns) return ns;
return strm_ns_array;
}
if (strm_string_p(val)) {
return strm_ns_string;
}
if (strm_number_p(val)) {
return strm_ns_number;
}
if (strm_value_tag(val) == STRM_TAG_PTR) {
struct strm_misc* p = strm_ptr(val);
if (!p) return NULL;
if (strm_ptr_type(p) == STRM_PTR_AUX) {
return p->ns;
}
}
return NULL;
}
int
strm_int_p(strm_value v)
{
return strm_value_tag(v) == STRM_TAG_INT;
}
void*
strm_value_foreign(strm_value v)
{
assert(strm_value_tag(v) == STRM_TAG_FOREIGN);
return strm_ptr(v);
}
strm_string
strm_to_str(strm_value v)
{
char buf[32];
int n;
switch (strm_value_tag(v)) {
case STRM_TAG_INT:
n = sprintf(buf, "%d", strm_to_int(v));
return strm_str_new(buf, n);
case STRM_TAG_BOOL:
n = sprintf(buf, strm_to_int(v) ? "true" : "false");
return strm_str_new(buf, n);
case STRM_TAG_CFUNC:
n = sprintf(buf, "<cfunc:%p>", (void*)strm_value_cfunc(v));
return strm_str_new(buf, n);
case STRM_TAG_STRING_I:
case STRM_TAG_STRING_6:
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
return strm_value_str(v);
case STRM_TAG_ARRAY:
case STRM_TAG_STRUCT:
return strm_inspect(v);
case STRM_TAG_PTR:
if (strm_value_val(v) == 0)
return strm_str_new("nil", 3);
else {
void *p = strm_ptr(v);
switch (strm_ptr_type(p)) {
case STRM_PTR_TASK:
n = sprintf(buf, "<task:%p>", p);
break;
case STRM_PTR_IO: {
strm_io io = (strm_io)p;
char *mode;
switch (io->mode & 3) {
case STRM_IO_READ:
mode = "r"; break;
case STRM_IO_WRITE:
mode = "w"; break;
case STRM_IO_READ|STRM_IO_WRITE:
mode = "rw"; break;
}
n = sprintf(buf, "<io: fd=%d mode=%s>", io->fd, mode);
break;
}
case STRM_PTR_LAMBDA:
n = sprintf(buf, "<lambda:%p>", p);
break;
case STRM_PTR_MISC:
n = sprintf(buf, "<obj:%p>", p);
break;
}
return strm_str_new(buf, n);
break;
}
default:
if (strm_flt_p(v)) {
n = sprintf(buf, "%g", strm_to_flt(v));
return strm_str_new(buf, n);
}
n = sprintf(buf, "<%p>", strm_value_vptr(v));
return strm_str_new(buf, n);
}
/* not reached */
return strm_str_null;
}
strm_string
strm_to_str(strm_value v)
{
char buf[32];
int n;
strm_state* ns = strm_value_ns(v);
if (ns) {
strm_value m;
n = strm_var_get(ns, strm_str_intern_lit("string"), &m);
if (n == STRM_OK) {
n = strm_funcall(NULL, m, 1, &v, &m);
if (n == STRM_OK && strm_string_p(m)) return m;
}
}
switch (strm_value_tag(v)) {
case STRM_TAG_INT:
n = sprintf(buf, "%d", strm_to_int(v));
return strm_str_new(buf, n);
case STRM_TAG_BOOL:
n = sprintf(buf, strm_to_int(v) ? "true" : "false");
return strm_str_new(buf, n);
case STRM_TAG_CFUNC:
n = sprintf(buf, "<cfunc:%p>", (void*)strm_value_cfunc(v));
return strm_str_new(buf, n);
case STRM_TAG_STRING_I:
case STRM_TAG_STRING_6:
case STRM_TAG_STRING_O:
case STRM_TAG_STRING_F:
return strm_value_str(v);
case STRM_TAG_ARRAY:
case STRM_TAG_STRUCT:
return strm_inspect(v);
case STRM_TAG_PTR:
if (strm_value_val(v) == 0)
return strm_str_lit("nil");
else {
void *p = strm_ptr(v);
switch (strm_ptr_type(p)) {
case STRM_PTR_STREAM:
n = sprintf(buf, "<stream:%p>", p);
break;
case STRM_PTR_IO: {
strm_io io = (strm_io)p;
char *mode;
switch (io->mode & 3) {
case STRM_IO_READ:
mode = "r"; break;
case STRM_IO_WRITE:
mode = "w"; break;
case STRM_IO_READ|STRM_IO_WRITE:
mode = "rw"; break;
default:
mode = "?"; break;
}
n = sprintf(buf, "<io: fd=%d mode=%s>", io->fd, mode);
break;
}
case STRM_PTR_LAMBDA:
n = sprintf(buf, "<lambda:%p>", p);
break;
case STRM_PTR_AUX:
n = sprintf(buf, "<obj:%p>", p);
break;
}
return strm_str_new(buf, n);
}
default:
if (strm_flt_p(v)) {
n = sprintf(buf, "%.14g", strm_to_flt(v));
return strm_str_new(buf, n);
}
n = sprintf(buf, "<%p>", strm_value_vptr(v));
return strm_str_new(buf, n);
}
/* not reached */
return strm_str_null;
}
strm_cfunc
strm_value_cfunc(strm_value v)
{
assert(strm_value_tag(v) == STRM_TAG_CFUNC);
return (strm_cfunc)(intptr_t)strm_value_val(v);
}
int
strm_bool_p(strm_value v)
{
return (strm_value_tag(v) == STRM_TAG_BOOL) ? TRUE : FALSE;
}
int
strm_cfunc_p(strm_value v)
{
return strm_value_tag(v) == STRM_TAG_CFUNC;
}
