picrin/extlib/benz/value.c

261 lines
4.7 KiB
C

/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/object.h"
#if PIC_NAN_BOXING
/**
* value representation by nan-boxing:
* float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF
* ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP
* int : 111111111111TTTT 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII
* char : 111111111111TTTT 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC
*/
#define pic_init_value(v,vtype) (v = (0xfff0000000000000ul | ((uint64_t)(vtype) << 48)))
int
pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v)
{
return 0xfff0 >= (v >> 48) ? PIC_TYPE_FLOAT : ((v >> 48) & 0xf);
}
double
pic_float(pic_state PIC_UNUSED(*pic), pic_value v)
{
union { double f; uint64_t i; } u;
u.i = v;
return u.f;
}
int
pic_int(pic_state PIC_UNUSED(*pic), pic_value v)
{
union { int i; unsigned u; } u;
u.u = v & 0xfffffffful;
return u.i;
}
char
pic_char(pic_state PIC_UNUSED(*pic), pic_value v)
{
return v & 0xfffffffful;
}
struct pic_object *
pic_obj_ptr(pic_value v)
{
return (struct pic_object *)(0xfffffffffffful & v);
}
#else
#define pic_init_value(v,vtype) ((v).type = (vtype), (v).u.data = NULL)
int
pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v)
{
return (int)(v.type);
}
double
pic_float(pic_state PIC_UNUSED(*pic), pic_value v)
{
return v.u.f;
}
int
pic_int(pic_state PIC_UNUSED(*pic), pic_value v)
{
return v.u.i;
}
char
pic_char(pic_state PIC_UNUSED(*pic), pic_value v)
{
return v.u.c;
}
struct pic_object *
pic_obj_ptr(pic_value v)
{
return (struct pic_object *)(v.u.data);
}
#endif
#if PIC_NAN_BOXING
pic_value
pic_obj_value(void *ptr)
{
pic_value v;
pic_init_value(v, PIC_IVAL_END);
v |= 0xfffffffffffful & (uint64_t)ptr;
return v;
}
pic_value
pic_float_value(pic_state PIC_UNUSED(*pic), double f)
{
union { double f; uint64_t i; } u;
if (f != f) {
return 0x7ff8000000000000ul;
} else {
u.f = f;
return u.i;
}
}
pic_value
pic_int_value(pic_state PIC_UNUSED(*pic), int i)
{
pic_value v;
pic_init_value(v, PIC_TYPE_INT);
v |= (unsigned)i;
return v;
}
pic_value
pic_char_value(pic_state PIC_UNUSED(*pic), char c)
{
pic_value v;
pic_init_value(v, PIC_TYPE_CHAR);
v |= (unsigned char)c;
return v;
}
#else
pic_value
pic_obj_value(void *ptr)
{
pic_value v;
pic_init_value(v, PIC_IVAL_END);
v.u.data = ptr;
return v;
}
pic_value
pic_float_value(pic_state PIC_UNUSED(*pic), double f)
{
pic_value v;
pic_init_value(v, PIC_TYPE_FLOAT);
v.u.f = f;
return v;
}
pic_value
pic_int_value(pic_state PIC_UNUSED(*pic), int i)
{
pic_value v;
pic_init_value(v, PIC_TYPE_INT);
v.u.i = i;
return v;
}
pic_value
pic_char_value(pic_state PIC_UNUSED(*pic), char c)
{
pic_value v;
pic_init_value(v, PIC_TYPE_CHAR);
v.u.c = c;
return v;
}
#endif
#define DEFVAL(name, type) \
pic_value name(pic_state PIC_UNUSED(*pic)) { \
pic_value v; \
pic_init_value(v, type); \
return v; \
}
DEFVAL(pic_nil_value, PIC_TYPE_NIL)
DEFVAL(pic_eof_object, PIC_TYPE_EOF)
DEFVAL(pic_true_value, PIC_TYPE_TRUE)
DEFVAL(pic_false_value, PIC_TYPE_FALSE)
DEFVAL(pic_undef_value, PIC_TYPE_UNDEF)
DEFVAL(pic_invalid_value, PIC_TYPE_INVALID)
int
pic_type(pic_state PIC_UNUSED(*pic), pic_value v)
{
int tt = pic_vtype(pic, v);
if (tt < PIC_IVAL_END) {
return tt;
}
return ((struct pic_basic *)pic_obj_ptr(v))->tt;
}
const char *
pic_typename(pic_state *pic, int type)
{
switch (type) {
case PIC_TYPE_NIL:
return "null";
case PIC_TYPE_TRUE:
case PIC_TYPE_FALSE:
return "boolean";
case PIC_TYPE_FLOAT:
return "float";
case PIC_TYPE_INT:
return "int";
case PIC_TYPE_SYMBOL:
return "symbol";
case PIC_TYPE_CHAR:
return "char";
case PIC_TYPE_EOF:
return "eof-object";
case PIC_TYPE_UNDEF:
return "undefined";
case PIC_TYPE_INVALID:
return "invalid";
case PIC_TYPE_PAIR:
return "pair";
case PIC_TYPE_STRING:
return "string";
case PIC_TYPE_VECTOR:
return "vector";
case PIC_TYPE_BLOB:
return "bytevector";
case PIC_TYPE_PORT:
return "port";
case PIC_TYPE_ERROR:
return "error";
case PIC_TYPE_ID:
return "identifier";
case PIC_TYPE_CXT:
return "context";
case PIC_TYPE_PROC:
return "procedure";
case PIC_TYPE_ENV:
return "environment";
case PIC_TYPE_DATA:
return "data";
case PIC_TYPE_DICT:
return "dictionary";
case PIC_TYPE_WEAK:
return "ephemeron";
case PIC_TYPE_RECORD:
return "record";
case PIC_TYPE_CP:
return "checkpoint";
default:
pic_errorf(pic, "pic_typename: invalid type given %d", type);
}
}