picrin/extlib/benz/value.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);
  }
}