conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

don't include type.h at the beginning of picrin.h

This commit is contained in:
Yuichi Nishiwaki 2016-02-18 23:25:45 +09:00
parent 615bdff61a
commit 08652df612
40 changed files with 470 additions and 482 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
contrib/20.r7rs/src/system.c
View File

@ -37,10 +37,10 @@ pic_system_exit(pic_state *pic)
argc = pic_get_args(pic, "|o", &v); argc = pic_get_args(pic, "|o", &v);
if (argc == 1) { if (argc == 1) {
switch (pic_type(pic, v)) { switch (pic_type(pic, v)) {
case PIC_TT_FLOAT: case PIC_TYPE_FLOAT:
status = (int)pic_float(pic, v); status = (int)pic_float(pic, v);
break; break;
case PIC_TT_INT: case PIC_TYPE_INT:
status = pic_int(pic, v); status = pic_int(pic, v);
break; break;
default: default:
@ -62,10 +62,10 @@ pic_system_emergency_exit(pic_state *pic)
argc = pic_get_args(pic, "|o", &v); argc = pic_get_args(pic, "|o", &v);
if (argc == 1) { if (argc == 1) {
switch (pic_type(pic, v)) { switch (pic_type(pic, v)) {
case PIC_TT_FLOAT: case PIC_TYPE_FLOAT:
status = (int)pic_float(pic, v); status = (int)pic_float(pic, v);
break; break;
case PIC_TT_INT: case PIC_TYPE_INT:
status = pic_int(pic, v); status = pic_int(pic, v);
break; break;
default: default:

2
contrib/30.readline/src/readline.c
View File

@ -21,7 +21,7 @@ pic_rl_readline(pic_state *pic)
if(result) if(result)
return pic_obj_value(pic_make_cstr(pic, result)); return pic_obj_value(pic_make_cstr(pic, result));
else else
return pic_eof_object(); return pic_eof_object(pic);
} }
static pic_value static pic_value

2
contrib/40.srfi/src/106.c
View File

@ -340,7 +340,7 @@ make_socket_port(pic_state *pic, struct pic_socket_t *sock, short dir)
{ {
struct pic_port *port; struct pic_port *port;
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = xfunopen(pic, sock, xf_socket_read, xf_socket_write, xf_socket_seek, xf_socket_close); port->file = xfunopen(pic, sock, xf_socket_read, xf_socket_write, xf_socket_seek, xf_socket_close);
port->flags = dir | PIC_PORT_BINARY | PIC_PORT_OPEN; port->flags = dir | PIC_PORT_BINARY | PIC_PORT_OPEN;
return port; return port;

2
extlib/benz/blob.c
View File

@ -9,7 +9,7 @@ pic_make_blob(pic_state *pic, int len)
{ {
struct pic_blob *bv; struct pic_blob *bv;
bv = (struct pic_blob *)pic_obj_alloc(pic, sizeof(struct pic_blob), PIC_TT_BLOB); bv = (struct pic_blob *)pic_obj_alloc(pic, sizeof(struct pic_blob), PIC_TYPE_BLOB);
bv->data = pic_malloc(pic, len); bv->data = pic_malloc(pic, len);
bv->len = len; bv->len = len;
return bv; return bv;

66
extlib/benz/bool.c
View File

@ -4,6 +4,60 @@
#include "picrin.h" #include "picrin.h"
#if PIC_NAN_BOXING
bool
pic_eq_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
return x == y;
}
bool
pic_eqv_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
return x == y;
}
#else
bool
pic_eq_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
if (pic_type(pic, x) != pic_type(pic, y))
return false;
switch (pic_type(pic, x)) {
case PIC_TYPE_NIL:
return true;
case PIC_TYPE_TRUE: case PIC_TYPE_FALSE:
return pic_type(pic, x) == pic_type(pic, y);
default:
return pic_obj_ptr(x) == pic_obj_ptr(y);
}
}
bool
pic_eqv_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
if (pic_type(pic, x) != pic_type(pic, y))
return false;
switch (pic_type(pic, x)) {
case PIC_TYPE_NIL:
return true;
case PIC_TYPE_TRUE: case PIC_TYPE_FALSE:
return pic_type(pic, x) == pic_type(pic, y);
case PIC_TYPE_FLOAT:
return pic_float(pic, x) == pic_float(pic, y);
case PIC_TYPE_INT:
return pic_int(pic, x) == pic_int(pic, y);
default:
return pic_obj_ptr(x) == pic_obj_ptr(y);
}
}
#endif
KHASH_DECLARE(m, void *, int) KHASH_DECLARE(m, void *, int)
KHASH_DEFINE2(m, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal) KHASH_DEFINE2(m, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
@ -38,7 +92,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
} }
switch (pic_type(pic, x)) { switch (pic_type(pic, x)) {
case PIC_TT_ID: { case PIC_TYPE_ID: {
struct pic_id *id1, *id2; struct pic_id *id1, *id2;
pic_sym *s1, *s2; pic_sym *s1, *s2;
@ -50,10 +104,10 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
return s1 == s2; return s1 == s2;
} }
case PIC_TT_STRING: { case PIC_TYPE_STRING: {
return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0; return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0;
} }
case PIC_TT_BLOB: { case PIC_TYPE_BLOB: {
struct pic_blob *blob1, *blob2; struct pic_blob *blob1, *blob2;
int i; int i;
@ -69,7 +123,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
} }
return true; return true;
} }
case PIC_TT_PAIR: { case PIC_TYPE_PAIR: {
if (! internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, h)) if (! internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, h))
return false; return false;
@ -102,7 +156,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
} }
goto LOOP; /* tail-call optimization */ goto LOOP; /* tail-call optimization */
} }
case PIC_TT_VECTOR: { case PIC_TYPE_VECTOR: {
int i; int i;
struct pic_vector *u, *v; struct pic_vector *u, *v;
@ -118,7 +172,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
} }
return true; return true;
} }
case PIC_TT_DATA: { case PIC_TYPE_DATA: {
return pic_data_ptr(x)->data == pic_data_ptr(y)->data; return pic_data_ptr(x)->data == pic_data_ptr(y)->data;
} }
default: default:

2
extlib/benz/cont.c
View File

@ -31,7 +31,7 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st
} }
here = pic->cp; here = pic->cp;
pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TT_CP); pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TYPE_CP);
pic->cp->prev = here; pic->cp->prev = here;
pic->cp->depth = here->depth + 1; pic->cp->depth = here->depth + 1;
pic->cp->in = in; pic->cp->in = in;

2
extlib/benz/data.c
View File

@ -5,7 +5,7 @@ pic_data_alloc(pic_state *pic, const pic_data_type *type, void *userdata)
{ {
struct pic_data *data; struct pic_data *data;
data = (struct pic_data *)pic_obj_alloc(pic, sizeof(struct pic_data), PIC_TT_DATA); data = (struct pic_data *)pic_obj_alloc(pic, sizeof(struct pic_data), PIC_TYPE_DATA);
data->type = type; data->type = type;
data->data = userdata; data->data = userdata;

2
extlib/benz/dict.c
View File

@ -11,7 +11,7 @@ pic_make_dict(pic_state *pic)
{ {
struct pic_dict *dict; struct pic_dict *dict;
dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT); dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TYPE_DICT);
kh_init(dict, &dict->hash); kh_init(dict, &dict->hash);
return dict; return dict;

2
extlib/benz/error.c
View File

@ -98,7 +98,7 @@ pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs)
stack = pic_get_backtrace(pic); stack = pic_get_backtrace(pic);
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR); e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TYPE_ERROR);
e->type = type; e->type = type;
e->msg = pic_make_cstr(pic, msg); e->msg = pic_make_cstr(pic, msg);
e->irrs = irrs; e->irrs = irrs;

25
extlib/benz/eval.c
View File

@ -293,10 +293,10 @@ static pic_value
analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj) analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
{ {
switch (pic_type(pic, obj)) { switch (pic_type(pic, obj)) {
case PIC_TT_SYMBOL: { case PIC_TYPE_SYMBOL: {
return analyze_var(pic, scope, pic_sym_ptr(obj)); return analyze_var(pic, scope, pic_sym_ptr(obj));
} }
case PIC_TT_PAIR: { case PIC_TYPE_PAIR: {
pic_value proc; pic_value proc;
if (! pic_list_p(pic, obj)) { if (! pic_list_p(pic, obj)) {
@ -694,38 +694,41 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
obj = pic_list_ref(pic, obj, 1); obj = pic_list_ref(pic, obj, 1);
switch (pic_type(pic, obj)) { switch (pic_type(pic, obj)) {
case PIC_TT_UNDEF: case PIC_TYPE_UNDEF:
emit_n(pic, cxt, OP_PUSHUNDEF); emit_n(pic, cxt, OP_PUSHUNDEF);
break; break;
case PIC_TT_BOOL: case PIC_TYPE_TRUE:
emit_n(pic, cxt, (pic_true_p(pic, obj) ? OP_PUSHTRUE : OP_PUSHFALSE)); emit_n(pic, cxt, OP_PUSHTRUE);
break; break;
case PIC_TT_INT: case PIC_TYPE_FALSE:
emit_n(pic, cxt, OP_PUSHFALSE);
break;
case PIC_TYPE_INT:
check_ints_size(pic, cxt); check_ints_size(pic, cxt);
pidx = (int)cxt->klen++; pidx = (int)cxt->klen++;
cxt->ints[pidx] = pic_int(pic, obj); cxt->ints[pidx] = pic_int(pic, obj);
emit_i(pic, cxt, OP_PUSHINT, pidx); emit_i(pic, cxt, OP_PUSHINT, pidx);
break; break;
case PIC_TT_FLOAT: case PIC_TYPE_FLOAT:
check_nums_size(pic, cxt); check_nums_size(pic, cxt);
pidx = (int)cxt->flen++; pidx = (int)cxt->flen++;
cxt->nums[pidx] = pic_float(pic, obj); cxt->nums[pidx] = pic_float(pic, obj);
emit_i(pic, cxt, OP_PUSHFLOAT, pidx); emit_i(pic, cxt, OP_PUSHFLOAT, pidx);
break; break;
case PIC_TT_NIL: case PIC_TYPE_NIL:
emit_n(pic, cxt, OP_PUSHNIL); emit_n(pic, cxt, OP_PUSHNIL);
break; break;
case PIC_TT_EOF: case PIC_TYPE_EOF:
emit_n(pic, cxt, OP_PUSHEOF); emit_n(pic, cxt, OP_PUSHEOF);
break; break;
case PIC_TT_CHAR: case PIC_TYPE_CHAR:
check_ints_size(pic, cxt); check_ints_size(pic, cxt);
pidx = (int)cxt->klen++; pidx = (int)cxt->klen++;
cxt->ints[pidx] = pic_char(pic, obj); cxt->ints[pidx] = pic_char(pic, obj);
emit_i(pic, cxt, OP_PUSHCHAR, pidx); emit_i(pic, cxt, OP_PUSHCHAR, pidx);
break; break;
default: default:
assert(pic_obj_p(obj)); assert(pic_obj_p(pic,obj));
check_pool_size(pic, cxt); check_pool_size(pic, cxt);
pidx = (int)cxt->plen++; pidx = (int)cxt->plen++;
cxt->pool[pidx] = pic_obj_ptr(obj); cxt->pool[pidx] = pic_obj_ptr(obj);

106
extlib/benz/gc.c
View File

@ -277,14 +277,14 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
#define LOOP(o) obj = (struct pic_object *)(o); goto loop #define LOOP(o) obj = (struct pic_object *)(o); goto loop
switch (obj->u.basic.tt) { switch (obj->u.basic.tt) {
case PIC_TT_PAIR: { case PIC_TYPE_PAIR: {
gc_mark(pic, obj->u.pair.car); gc_mark(pic, obj->u.pair.car);
if (pic_obj_p(pic, obj->u.pair.cdr)) { if (pic_obj_p(pic, obj->u.pair.cdr)) {
LOOP(pic_obj_ptr(obj->u.pair.cdr)); LOOP(pic_obj_ptr(obj->u.pair.cdr));
} }
break; break;
} }
case PIC_TT_CXT: { case PIC_TYPE_CXT: {
int i; int i;
for (i = 0; i < obj->u.cxt.regc; ++i) { for (i = 0; i < obj->u.cxt.regc; ++i) {
@ -295,7 +295,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
} }
break; break;
} }
case PIC_TT_PROC: { case PIC_TYPE_PROC: {
if (pic_proc_irep_p(&obj->u.proc)) { if (pic_proc_irep_p(&obj->u.proc)) {
if (obj->u.proc.u.i.cxt) { if (obj->u.proc.u.i.cxt) {
LOOP(obj->u.proc.u.i.cxt); LOOP(obj->u.proc.u.i.cxt);
@ -308,35 +308,35 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
} }
break; break;
} }
case PIC_TT_PORT: { case PIC_TYPE_PORT: {
break; break;
} }
case PIC_TT_ERROR: { case PIC_TYPE_ERROR: {
gc_mark_object(pic, (struct pic_object *)obj->u.err.type); gc_mark_object(pic, (struct pic_object *)obj->u.err.type);
gc_mark_object(pic, (struct pic_object *)obj->u.err.msg); gc_mark_object(pic, (struct pic_object *)obj->u.err.msg);
gc_mark(pic, obj->u.err.irrs); gc_mark(pic, obj->u.err.irrs);
LOOP(obj->u.err.stack); LOOP(obj->u.err.stack);
break; break;
} }
case PIC_TT_STRING: { case PIC_TYPE_STRING: {
break; break;
} }
case PIC_TT_VECTOR: { case PIC_TYPE_VECTOR: {
int i; int i;
for (i = 0; i < obj->u.vec.len; ++i) { for (i = 0; i < obj->u.vec.len; ++i) {
gc_mark(pic, obj->u.vec.data[i]); gc_mark(pic, obj->u.vec.data[i]);
} }
break; break;
} }
case PIC_TT_BLOB: { case PIC_TYPE_BLOB: {
break; break;
} }
case PIC_TT_ID: { case PIC_TYPE_ID: {
gc_mark_object(pic, (struct pic_object *)obj->u.id.u.id.id); gc_mark_object(pic, (struct pic_object *)obj->u.id.u.id.id);
LOOP(obj->u.id.u.id.env); LOOP(obj->u.id.u.id.env);
break; break;
} }
case PIC_TT_ENV: { case PIC_TYPE_ENV: {
khash_t(env) *h = &obj->u.env.map; khash_t(env) *h = &obj->u.env.map;
khiter_t it; khiter_t it;
@ -351,13 +351,13 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
} }
break; break;
} }
case PIC_TT_DATA: { case PIC_TYPE_DATA: {
if (obj->u.data.type->mark) { if (obj->u.data.type->mark) {
obj->u.data.type->mark(pic, obj->u.data.data, gc_mark); obj->u.data.type->mark(pic, obj->u.data.data, gc_mark);
} }
break; break;
} }
case PIC_TT_DICT: { case PIC_TYPE_DICT: {
pic_sym *sym; pic_sym *sym;
khiter_t it; khiter_t it;
@ -367,25 +367,25 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
} }
break; break;
} }
case PIC_TT_RECORD: { case PIC_TYPE_RECORD: {
gc_mark(pic, obj->u.rec.type); gc_mark(pic, obj->u.rec.type);
if (pic_obj_p(pic, obj->u.rec.datum)) { if (pic_obj_p(pic, obj->u.rec.datum)) {
LOOP(pic_obj_ptr(obj->u.rec.datum)); LOOP(pic_obj_ptr(obj->u.rec.datum));
} }
break; break;
} }
case PIC_TT_SYMBOL: { case PIC_TYPE_SYMBOL: {
LOOP(obj->u.sym.str); LOOP(obj->u.sym.str);
break; break;
} }
case PIC_TT_WEAK: { case PIC_TYPE_WEAK: {
struct pic_weak *weak = (struct pic_weak *)obj; struct pic_weak *weak = (struct pic_weak *)obj;
weak->prev = pic->heap->weaks; weak->prev = pic->heap->weaks;
pic->heap->weaks = weak; pic->heap->weaks = weak;
break; break;
} }
case PIC_TT_CP: { case PIC_TYPE_CP: {
if (obj->u.cp.prev) { if (obj->u.cp.prev) {
gc_mark_object(pic, (struct pic_object *)obj->u.cp.prev); gc_mark_object(pic, (struct pic_object *)obj->u.cp.prev);
} }
@ -397,14 +397,15 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
} }
break; break;
} }
case PIC_TT_NIL: case PIC_TYPE_NIL:
case PIC_TT_BOOL: case PIC_TYPE_TRUE:
case PIC_TT_FLOAT: case PIC_TYPE_FALSE:
case PIC_TT_INT: case PIC_TYPE_FLOAT:
case PIC_TT_CHAR: case PIC_TYPE_INT:
case PIC_TT_EOF: case PIC_TYPE_CHAR:
case PIC_TT_UNDEF: case PIC_TYPE_EOF:
case PIC_TT_INVALID: case PIC_TYPE_UNDEF:
case PIC_TYPE_INVALID:
pic_panic(pic, "logic flaw"); pic_panic(pic, "logic flaw");
} }
} }
@ -532,64 +533,65 @@ static void
gc_finalize_object(pic_state *pic, struct pic_object *obj) gc_finalize_object(pic_state *pic, struct pic_object *obj)
{ {
switch (obj->u.basic.tt) { switch (obj->u.basic.tt) {
case PIC_TT_VECTOR: { case PIC_TYPE_VECTOR: {
pic_free(pic, obj->u.vec.data); pic_free(pic, obj->u.vec.data);
break; break;
} }
case PIC_TT_BLOB: { case PIC_TYPE_BLOB: {
pic_free(pic, obj->u.blob.data); pic_free(pic, obj->u.blob.data);
break; break;
} }
case PIC_TT_STRING: { case PIC_TYPE_STRING: {
pic_rope_decref(pic, obj->u.str.rope); pic_rope_decref(pic, obj->u.str.rope);
break; break;
} }
case PIC_TT_ENV: { case PIC_TYPE_ENV: {
kh_destroy(env, &obj->u.env.map); kh_destroy(env, &obj->u.env.map);
break; break;
} }
case PIC_TT_DATA: { case PIC_TYPE_DATA: {
if (obj->u.data.type->dtor) { if (obj->u.data.type->dtor) {
obj->u.data.type->dtor(pic, obj->u.data.data); obj->u.data.type->dtor(pic, obj->u.data.data);
} }
break; break;
} }
case PIC_TT_DICT: { case PIC_TYPE_DICT: {
kh_destroy(dict, &obj->u.dict.hash); kh_destroy(dict, &obj->u.dict.hash);
break; break;
} }
case PIC_TT_SYMBOL: { case PIC_TYPE_SYMBOL: {
/* TODO: remove this symbol's entry from pic->syms immediately */ /* TODO: remove this symbol's entry from pic->syms immediately */
break; break;
} }
case PIC_TT_WEAK: { case PIC_TYPE_WEAK: {
kh_destroy(weak, &obj->u.weak.hash); kh_destroy(weak, &obj->u.weak.hash);
break; break;
} }
case PIC_TT_PROC: { case PIC_TYPE_PROC: {
if (pic_proc_irep_p(&obj->u.proc)) { if (pic_proc_irep_p(&obj->u.proc)) {
pic_irep_decref(pic, obj->u.proc.u.i.irep); pic_irep_decref(pic, obj->u.proc.u.i.irep);
} }
break; break;
} }
case PIC_TT_PAIR: case PIC_TYPE_PAIR:
case PIC_TT_CXT: case PIC_TYPE_CXT:
case PIC_TT_PORT: case PIC_TYPE_PORT:
case PIC_TT_ERROR: case PIC_TYPE_ERROR:
case PIC_TT_ID: case PIC_TYPE_ID:
case PIC_TT_RECORD: case PIC_TYPE_RECORD:
case PIC_TT_CP: case PIC_TYPE_CP:
break; break;
case PIC_TT_NIL: case PIC_TYPE_NIL:
case PIC_TT_BOOL: case PIC_TYPE_TRUE:
case PIC_TT_FLOAT: case PIC_TYPE_FALSE:
case PIC_TT_INT: case PIC_TYPE_FLOAT:
case PIC_TT_CHAR: case PIC_TYPE_INT:
case PIC_TT_EOF: case PIC_TYPE_CHAR:
case PIC_TT_UNDEF: case PIC_TYPE_EOF:
case PIC_TT_INVALID: case PIC_TYPE_UNDEF:
case PIC_TYPE_INVALID:
pic_panic(pic, "logic flaw"); pic_panic(pic, "logic flaw");
} }
} }
@ -704,7 +706,7 @@ pic_alloca(pic_state *pic, size_t n)
} }
struct pic_object * struct pic_object *
pic_obj_alloc_unsafe(pic_state *pic, size_t size, enum pic_tt tt) pic_obj_alloc_unsafe(pic_state *pic, size_t size, int type)
{ {
struct pic_object *obj; struct pic_object *obj;
@ -724,17 +726,17 @@ pic_obj_alloc_unsafe(pic_state *pic, size_t size, enum pic_tt tt)
} }
} }
obj->u.basic.gc_mark = PIC_GC_UNMARK; obj->u.basic.gc_mark = PIC_GC_UNMARK;
obj->u.basic.tt = tt; obj->u.basic.tt = type;
return obj; return obj;
} }
struct pic_object * struct pic_object *
pic_obj_alloc(pic_state *pic, size_t size, enum pic_tt tt) pic_obj_alloc(pic_state *pic, size_t size, int type)
{ {
struct pic_object *obj; struct pic_object *obj;
obj = pic_obj_alloc_unsafe(pic, size, tt); obj = pic_obj_alloc_unsafe(pic, size, type);
gc_protect(pic, obj); gc_protect(pic, obj);
return obj; return obj;

117
extlib/benz/include/picrin.h
View File

@ -36,7 +36,36 @@ extern "C" {
typedef struct pic_state pic_state; typedef struct pic_state pic_state;
#include "picrin/type.h" #if PIC_NAN_BOXING
# include <stdint.h>
typedef uint64_t pic_value;
#else
typedef struct {
unsigned char type;
union {
void *data;
double f;
int i;
char c;
} u;
} pic_value;
#endif
struct pic_object;
struct pic_symbol;
struct pic_pair;
struct pic_string;
struct pic_vector;
struct pic_blob;
struct pic_proc;
struct pic_port;
struct pic_error;
struct pic_env;
typedef struct pic_symbol pic_sym;
typedef struct pic_id pic_id;
typedef struct pic_pair pic_pair;
typedef struct pic_vector pic_vec;
typedef void *(*pic_allocf)(void *userdata, void *ptr, size_t n); typedef void *(*pic_allocf)(void *userdata, void *ptr, size_t n);
@ -87,13 +116,54 @@ pic_value pic_vcall(pic_state *, struct pic_proc *proc, int, va_list);
pic_value pic_apply(pic_state *, struct pic_proc *proc, int n, pic_value *argv); pic_value pic_apply(pic_state *, struct pic_proc *proc, int n, pic_value *argv);
pic_value pic_applyk(pic_state *, struct pic_proc *proc, int n, pic_value *argv); pic_value pic_applyk(pic_state *, struct pic_proc *proc, int n, pic_value *argv);
int pic_int(pic_state *, pic_value); #define PIC_TYPE_INVALID 1
double pic_float(pic_state *, pic_value); #define PIC_TYPE_FLOAT 2
char pic_char(pic_state *, pic_value); #define PIC_TYPE_INT 3
bool pic_bool(pic_state *, pic_value); #define PIC_TYPE_CHAR 4
/* const char *pic_str(pic_state *, pic_value); */ #define PIC_TYPE_EOF 5
/* unsigned char *pic_blob(pic_state *, pic_value, int *len); */ #define PIC_TYPE_UNDEF 6
/* void *pic_data(pic_state *, pic_value); */ #define PIC_TYPE_TRUE 8
#define PIC_TYPE_NIL 7
#define PIC_TYPE_FALSE 9
#define PIC_IVAL_END 10
/* --------------------- */
#define PIC_TYPE_STRING 16
#define PIC_TYPE_VECTOR 17
#define PIC_TYPE_BLOB 18
#define PIC_TYPE_PROC 19
#define PIC_TYPE_PORT 20
#define PIC_TYPE_ERROR 21
#define PIC_TYPE_ID 22
#define PIC_TYPE_ENV 23
#define PIC_TYPE_DATA 24
#define PIC_TYPE_DICT 25
#define PIC_TYPE_WEAK 26
#define PIC_TYPE_RECORD 27
#define PIC_TYPE_SYMBOL 28
#define PIC_TYPE_PAIR 29
#define PIC_TYPE_CXT 30
#define PIC_TYPE_CP 31
#include "picrin/type.h"
#define pic_undef_p(pic,v) (pic_type(pic,v) == PIC_TYPE_UNDEF)
#define pic_int_p(pic,v) (pic_type(pic,v) == PIC_TYPE_INT)
#define pic_float_p(pic,v) (pic_type(pic,v) == PIC_TYPE_FLOAT)
#define pic_char_p(pic,v) (pic_type(pic,v) == PIC_TYPE_CHAR)
#define pic_eof_p(pic, v) (pic_vtype(pic, v) == PIC_TYPE_EOF)
#define pic_true_p(pic,v) (pic_type(pic,v) == PIC_TYPE_TRUE)
#define pic_false_p(pic,v) (pic_type(pic,v) == PIC_TYPE_FALSE)
#define pic_str_p(pic,v) (pic_type(pic,v) == PIC_TYPE_STRING)
#define pic_blob_p(pic,v) (pic_type(pic,v) == PIC_TYPE_BLOB)
#define pic_proc_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PROC)
#define pic_data_p(pic,v) (pic_type(pic,v) == PIC_TYPE_DATA)
#define pic_nil_p(pic,v) (pic_type(pic,v) == PIC_TYPE_NIL)
#define pic_pair_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PAIR)
#define pic_vec_p(pic,v) (pic_type(pic,v) == PIC_TYPE_VECTOR)
#define pic_dict_p(pic,v) (pic_type(pic,v) == PIC_TYPE_DICT)
#define pic_weak_p(pic,v) (pic_type(pic,v) == PIC_TYPE_WEAK)
#define pic_port_p(pic, v) (pic_type(pic, v) == PIC_TYPE_PORT)
#define pic_sym_p(pic,v) (pic_type(pic,v) == PIC_TYPE_SYMBOL)
pic_value pic_undef_value(pic_state *); pic_value pic_undef_value(pic_state *);
pic_value pic_int_value(pic_state *, int); pic_value pic_int_value(pic_state *, int);
@ -102,27 +172,18 @@ pic_value pic_char_value(pic_state *, char);
pic_value pic_true_value(pic_state *); pic_value pic_true_value(pic_state *);
pic_value pic_false_value(pic_state *); pic_value pic_false_value(pic_state *);
pic_value pic_bool_value(pic_state *, bool); pic_value pic_bool_value(pic_state *, bool);
pic_value pic_eof_object(pic_state *);
#define pic_undef_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_UNDEF) int pic_int(pic_state *, pic_value);
#define pic_int_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_INT) double pic_float(pic_state *, pic_value);
#define pic_float_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_FLOAT) char pic_char(pic_state *, pic_value);
#define pic_char_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_CHAR) bool pic_bool(pic_state *, pic_value);
#define pic_true_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_TRUE) /* const char *pic_str(pic_state *, pic_value); */
#define pic_false_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_FALSE) /* unsigned char *pic_blob(pic_state *, pic_value, int *len); */
#define pic_str_p(pic,v) (pic_type(pic,v) == PIC_TT_STRING) /* void *pic_data(pic_state *, pic_value); */
#define pic_blob_p(pic,v) (pic_type(pic,v) == PIC_TT_BLOB)
#define pic_proc_p(pic,v) (pic_type(pic,v) == PIC_TT_PROC)
#define pic_data_p(pic,v) (pic_type(pic,v) == PIC_TT_DATA)
#define pic_nil_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_NIL)
#define pic_pair_p(pic,v) (pic_type(pic,v) == PIC_TT_PAIR)
#define pic_vec_p(pic,v) (pic_type(pic,v) == PIC_TT_VECTOR)
#define pic_dict_p(pic,v) (pic_type(pic,v) == PIC_TT_DICT)
#define pic_weak_p(pic,v) (pic_type(pic,v) == PIC_TT_WEAK)
#define pic_port_p(pic, v) (pic_type(pic, v) == PIC_TT_PORT)
#define pic_sym_p(pic,v) (pic_type(pic,v) == PIC_TT_SYMBOL)
enum pic_tt pic_type(pic_state *, pic_value); int pic_type(pic_state *, pic_value);
const char *pic_type_repr(pic_state *, enum pic_tt); const char *pic_typename(pic_state *, int);
bool pic_eq_p(pic_state *, pic_value, pic_value); bool pic_eq_p(pic_state *, pic_value, pic_value);
bool pic_eqv_p(pic_state *, pic_value, pic_value); bool pic_eqv_p(pic_state *, pic_value, pic_value);
@ -205,7 +266,7 @@ void *pic_default_allocf(void *, void *, size_t);
pic_errorf(pic, "expected " #type ", but got ~s", v); \ pic_errorf(pic, "expected " #type ", but got ~s", v); \
} }
struct pic_object *pic_obj_alloc(pic_state *, size_t, enum pic_tt); struct pic_object *pic_obj_alloc(pic_state *, size_t, int type);
#define pic_void(exec) \ #define pic_void(exec) \
pic_void_(PIC_GENSYM(ai), exec) pic_void_(PIC_GENSYM(ai), exec)

2
extlib/benz/include/picrin/blob.h
View File

@ -15,7 +15,7 @@ struct pic_blob {
int len; int len;
}; };
#define pic_blob_ptr(v) ((struct pic_blob *)pic_ptr(v)) #define pic_blob_ptr(v) ((struct pic_blob *)pic_obj_ptr(v))
struct pic_blob *pic_make_blob(pic_state *, int); struct pic_blob *pic_make_blob(pic_state *, int);

2
extlib/benz/include/picrin/data.h
View File

@ -21,7 +21,7 @@ struct pic_data {
void *data; void *data;
}; };
#define pic_data_ptr(o) ((struct pic_data *)pic_ptr(o)) #define pic_data_ptr(o) ((struct pic_data *)pic_obj_ptr(o))
PIC_INLINE bool pic_data_type_p(pic_state *pic, const pic_value obj, const pic_data_type *type) { PIC_INLINE bool pic_data_type_p(pic_state *pic, const pic_value obj, const pic_data_type *type) {
return pic_data_p(pic, obj) && pic_data_ptr(obj)->type == type; return pic_data_p(pic, obj) && pic_data_ptr(obj)->type == type;

2
extlib/benz/include/picrin/dict.h
View File

@ -16,7 +16,7 @@ struct pic_dict {
khash_t(dict) hash; khash_t(dict) hash;
}; };
#define pic_dict_ptr(v) ((struct pic_dict *)pic_ptr(v)) #define pic_dict_ptr(v) ((struct pic_dict *)pic_obj_ptr(v))
#define pic_dict_for_each(sym, dict, it) \ #define pic_dict_for_each(sym, dict, it) \
pic_dict_for_each_help(sym, (&(dict)->hash), it) pic_dict_for_each_help(sym, (&(dict)->hash), it)

4
extlib/benz/include/picrin/error.h
View File

@ -17,8 +17,8 @@ struct pic_error {
struct pic_string *stack; struct pic_string *stack;
}; };
#define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TT_ERROR) #define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ERROR)
#define pic_error_ptr(v) ((struct pic_error *)pic_ptr(v)) #define pic_error_ptr(v) ((struct pic_error *)pic_obj_ptr(v))
struct pic_error *pic_make_error(pic_state *, pic_sym *, const char *, pic_value); struct pic_error *pic_make_error(pic_state *, pic_sym *, const char *, pic_value);

4
extlib/benz/include/picrin/macro.h
View File

@ -18,8 +18,8 @@ struct pic_env {
struct pic_string *lib; struct pic_string *lib;
}; };
#define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TT_ENV) #define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ENV)
#define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v)) #define pic_env_ptr(v) ((struct pic_env *)pic_obj_ptr(v))
struct pic_env *pic_make_topenv(pic_state *, struct pic_string *); struct pic_env *pic_make_topenv(pic_state *, struct pic_string *);
struct pic_env *pic_make_env(pic_state *, struct pic_env *); struct pic_env *pic_make_env(pic_state *, struct pic_env *);

2
extlib/benz/include/picrin/pair.h
View File

@ -15,7 +15,7 @@ struct pic_pair {
pic_value cdr; pic_value cdr;
}; };
#define pic_pair_ptr(o) ((struct pic_pair *)pic_ptr(o)) #define pic_pair_ptr(o) ((struct pic_pair *)pic_obj_ptr(o))
PIC_INLINE pic_value PIC_INLINE pic_value
pic_car(pic_state *pic, pic_value obj) pic_car(pic_state *pic, pic_value obj)

4
extlib/benz/include/picrin/port.h
View File

@ -23,9 +23,7 @@ struct pic_port {
int flags; int flags;
}; };
#define pic_port_ptr(v) ((struct pic_port *)pic_ptr(v)) #define pic_port_ptr(v) ((struct pic_port *)pic_obj_ptr(v))
pic_value pic_eof_object();
struct pic_port *pic_open_input_string(pic_state *, const char *); struct pic_port *pic_open_input_string(pic_state *, const char *);
struct pic_port *pic_open_output_string(pic_state *); struct pic_port *pic_open_output_string(pic_state *);

6
extlib/benz/include/picrin/proc.h
View File

@ -39,10 +39,10 @@ struct pic_proc {
#define pic_proc_func_p(proc) ((proc)->tag == PIC_PROC_TAG_FUNC) #define pic_proc_func_p(proc) ((proc)->tag == PIC_PROC_TAG_FUNC)
#define pic_proc_irep_p(proc) ((proc)->tag == PIC_PROC_TAG_IREP) #define pic_proc_irep_p(proc) ((proc)->tag == PIC_PROC_TAG_IREP)
#define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o)) #define pic_proc_ptr(o) ((struct pic_proc *)pic_obj_ptr(o))
#define pic_context_p(o) (pic_type(pic, o) == PIC_TT_CXT) #define pic_context_p(o) (pic_type(pic, o) == PIC_TYPE_CXT)
#define pic_context_ptr(o) ((struct pic_context *)pic_ptr(o)) #define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
struct pic_proc *pic_make_proc(pic_state *, pic_func_t, int, pic_value *); struct pic_proc *pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
struct pic_proc *pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *); struct pic_proc *pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *);

4
extlib/benz/include/picrin/record.h
View File

@ -15,8 +15,8 @@ struct pic_record {
pic_value datum; pic_value datum;
}; };
#define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TT_RECORD) #define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TYPE_RECORD)
#define pic_rec_ptr(v) ((struct pic_record *)pic_ptr(v)) #define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v))
struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value); struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value);

4
extlib/benz/include/picrin/setup.h
View File

@ -5,13 +5,13 @@
#include "picrin/config.h" #include "picrin/config.h"
#ifndef PIC_DIRECT_THREADED_VM #ifndef PIC_DIRECT_THREADED_VM
# if (defined(__GNUC__) || defined(__clang__)) && __STRICT_ANSI__ != 1 # if (defined(__GNUC__) || defined(__clang__)) && ! defined(__STRICT_ANSI__)
# define PIC_DIRECT_THREADED_VM 1 # define PIC_DIRECT_THREADED_VM 1
# endif # endif
#endif #endif
#ifndef PIC_NAN_BOXING #ifndef PIC_NAN_BOXING
# if __x86_64__ && (defined(__GNUC__) || defined(__clang__)) && __STRICT_ANSI__ != 1 # if __x86_64__ && (defined(__GNUC__) || defined(__clang__)) && ! defined(__STRICT_ANSI__)
# define PIC_NAN_BOXING 1 # define PIC_NAN_BOXING 1
# endif # endif
#endif #endif

2
extlib/benz/include/picrin/string.h
View File

@ -17,7 +17,7 @@ struct pic_string {
void pic_rope_incref(pic_state *, struct pic_rope *); void pic_rope_incref(pic_state *, struct pic_rope *);
void pic_rope_decref(pic_state *, struct pic_rope *); void pic_rope_decref(pic_state *, struct pic_rope *);
#define pic_str_ptr(o) ((struct pic_string *)pic_ptr(o)) #define pic_str_ptr(o) ((struct pic_string *)pic_obj_ptr(o))
struct pic_string *pic_make_str(pic_state *, const char *, int); struct pic_string *pic_make_str(pic_state *, const char *, int);
#define pic_make_cstr(pic, cstr) pic_make_str(pic, (cstr), strlen(cstr)) #define pic_make_cstr(pic, cstr) pic_make_str(pic, (cstr), strlen(cstr))

6
extlib/benz/include/picrin/symbol.h
View File

@ -23,10 +23,10 @@ struct pic_id {
} u; } u;
}; };
#define pic_sym_ptr(v) ((pic_sym *)pic_ptr(v)) #define pic_sym_ptr(v) ((pic_sym *)pic_obj_ptr(v))
#define pic_id_p(pic, v) (pic_type(pic, v) == PIC_TT_ID || pic_type(pic, v) == PIC_TT_SYMBOL) #define pic_id_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ID || pic_type(pic, v) == PIC_TYPE_SYMBOL)
#define pic_id_ptr(v) ((pic_id *)pic_ptr(v)) #define pic_id_ptr(v) ((pic_id *)pic_obj_ptr(v))
pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *); pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *);

344
extlib/benz/include/picrin/type.h
View File

@ -14,43 +14,25 @@ extern "C" {
* it is only used for repsenting internal special state * it is only used for repsenting internal special state
*/ */
enum pic_vtype {
PIC_VTYPE_NIL = 1,
PIC_VTYPE_TRUE,
PIC_VTYPE_FALSE,
PIC_VTYPE_UNDEF,
PIC_VTYPE_INVALID,
PIC_VTYPE_FLOAT,
PIC_VTYPE_INT,
PIC_VTYPE_CHAR,
PIC_VTYPE_EOF,
PIC_VTYPE_HEAP
};
#if PIC_NAN_BOXING #if PIC_NAN_BOXING
#include <stdint.h>
/** /**
* value representation by nan-boxing: * value representation by nan-boxing:
* float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF * float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF
* ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP * ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP
* int : 1111111111110110 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII * int : 111111111111TTTT 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII
* char : 1111111111111000 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC * char : 111111111111TTTT 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC
*/ */
typedef uint64_t pic_value;
#define pic_ptr(v) ((void *)(0xfffffffffffful & (v)))
#define pic_init_value(v,vtype) (v = (0xfff0000000000000ul | ((uint64_t)(vtype) << 48))) #define pic_init_value(v,vtype) (v = (0xfff0000000000000ul | ((uint64_t)(vtype) << 48)))
static inline enum pic_vtype PIC_INLINE int
pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v) pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v)
{ {
return 0xfff0 >= (v >> 48) ? PIC_VTYPE_FLOAT : ((v >> 48) & 0xf); return 0xfff0 >= (v >> 48) ? PIC_TYPE_FLOAT : ((v >> 48) & 0xf);
} }
static inline double PIC_INLINE double
pic_float(pic_state PIC_UNUSED(*pic), pic_value v) pic_float(pic_state PIC_UNUSED(*pic), pic_value v)
{ {
union { double f; uint64_t i; } u; union { double f; uint64_t i; } u;
@ -58,7 +40,7 @@ pic_float(pic_state PIC_UNUSED(*pic), pic_value v)
return u.f; return u.f;
} }
static inline int PIC_INLINE int
pic_int(pic_state PIC_UNUSED(*pic), pic_value v) pic_int(pic_state PIC_UNUSED(*pic), pic_value v)
{ {
union { int i; unsigned u; } u; union { int i; unsigned u; } u;
@ -66,28 +48,28 @@ pic_int(pic_state PIC_UNUSED(*pic), pic_value v)
return u.i; return u.i;
} }
static inline char PIC_INLINE char
pic_char(pic_state PIC_UNUSED(*pic), pic_value v) pic_char(pic_state PIC_UNUSED(*pic), pic_value v)
{ {
return v & 0xfffffffful; return v & 0xfffffffful;
} }
PIC_INLINE struct pic_object *
pic_obj_ptr(pic_value v)
{
return (struct pic_object *)(0xfffffffffffful & v);
}
#else #else
typedef struct {
enum pic_vtype type;
union {
void *data;
double f;
int i;
char c;
} u;
} pic_value;
#define pic_ptr(v) ((v).u.data)
#define pic_vtype(pic,v) ((v).type)
#define pic_init_value(v,vtype) ((v).type = (vtype), (v).u.data = NULL) #define pic_init_value(v,vtype) ((v).type = (vtype), (v).u.data = NULL)
PIC_INLINE int
pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v)
{
return (int)(v.type);
}
PIC_INLINE double PIC_INLINE double
pic_float(pic_state PIC_UNUSED(*pic), pic_value v) pic_float(pic_state PIC_UNUSED(*pic), pic_value v)
{ {
@ -106,68 +88,24 @@ pic_char(pic_state PIC_UNUSED(*pic), pic_value v)
return v.u.c; return v.u.c;
} }
PIC_INLINE struct pic_object *
pic_obj_ptr(pic_value v)
{
return (struct pic_object *)(v.u.data);
}
#endif #endif
enum pic_tt {
/* immediate */
PIC_TT_NIL,
PIC_TT_BOOL,
PIC_TT_FLOAT,
PIC_TT_INT,
PIC_TT_CHAR,
PIC_TT_EOF,
PIC_TT_UNDEF,
PIC_TT_INVALID,
/* heap */
PIC_TT_SYMBOL,
PIC_TT_PAIR,
PIC_TT_STRING,
PIC_TT_VECTOR,
PIC_TT_BLOB,
PIC_TT_PROC,
PIC_TT_PORT,
PIC_TT_ERROR,
PIC_TT_ID,
PIC_TT_ENV,
PIC_TT_DATA,
PIC_TT_DICT,
PIC_TT_WEAK,
PIC_TT_RECORD,
PIC_TT_CXT,
PIC_TT_CP
};
#define PIC_OBJECT_HEADER \ #define PIC_OBJECT_HEADER \
enum pic_tt tt; \ unsigned char tt; \
char gc_mark; char gc_mark;
struct pic_basic { struct pic_basic {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
}; };
struct pic_object; #define pic_obj_p(pic,v) (pic_vtype(pic,v) == PIC_IVAL_END)
struct pic_symbol; #define pic_invalid_p(pic, v) (pic_vtype(pic, v) == PIC_TYPE_INVALID)
struct pic_pair;
struct pic_string;
struct pic_vector;
struct pic_blob;
struct pic_proc;
struct pic_port;
struct pic_error;
struct pic_env;
/* set aliases to basic types */
typedef struct pic_symbol pic_sym;
typedef struct pic_id pic_id;
typedef struct pic_pair pic_pair;
typedef struct pic_vector pic_vec;
#define pic_obj_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_HEAP)
#define pic_obj_ptr(v) ((struct pic_object *)pic_ptr(v))
#define pic_invalid_p(pic, v) (pic_vtype(pic, v) == PIC_VTYPE_INVALID)
#define pic_eof_p(pic, v) (pic_vtype(pic, v) == PIC_VTYPE_EOF)
#define pic_test(pic, v) (! pic_false_p(pic, v)) #define pic_test(pic, v) (! pic_false_p(pic, v))
@ -177,100 +115,21 @@ pic_valid_int(double v)
return INT_MIN <= v && v <= INT_MAX; return INT_MIN <= v && v <= INT_MAX;
} }
PIC_INLINE pic_value pic_invalid_value();
PIC_INLINE pic_value pic_obj_value(void *);
PIC_INLINE enum pic_tt
pic_type(pic_state PIC_UNUSED(*pic), pic_value v)
{
switch (pic_vtype(pic, v)) {
case PIC_VTYPE_NIL:
return PIC_TT_NIL;
case PIC_VTYPE_TRUE:
return PIC_TT_BOOL;
case PIC_VTYPE_FALSE:
return PIC_TT_BOOL;
case PIC_VTYPE_UNDEF:
return PIC_TT_UNDEF;
case PIC_VTYPE_INVALID:
return PIC_TT_INVALID;
case PIC_VTYPE_FLOAT:
return PIC_TT_FLOAT;
case PIC_VTYPE_INT:
return PIC_TT_INT;
case PIC_VTYPE_CHAR:
return PIC_TT_CHAR;
case PIC_VTYPE_EOF:
return PIC_TT_EOF;
case PIC_VTYPE_HEAP:
return ((struct pic_basic *)pic_ptr(v))->tt;
}
PIC_UNREACHABLE();
}
PIC_INLINE const char *
pic_type_repr(pic_state PIC_UNUSED(*pic), enum pic_tt tt)
{
switch (tt) {
case PIC_TT_NIL:
return "nil";
case PIC_TT_BOOL:
return "boolean";
case PIC_TT_FLOAT:
return "float";
case PIC_TT_INT:
return "int";
case PIC_TT_SYMBOL:
return "symbol";
case PIC_TT_CHAR:
return "char";
case PIC_TT_EOF:
return "eof";
case PIC_TT_UNDEF:
return "undef";
case PIC_TT_INVALID:
return "invalid";
case PIC_TT_PAIR:
return "pair";
case PIC_TT_STRING:
return "string";
case PIC_TT_VECTOR:
return "vector";
case PIC_TT_BLOB:
return "blob";
case PIC_TT_PORT:
return "port";
case PIC_TT_ERROR:
return "error";
case PIC_TT_ID:
return "id";
case PIC_TT_CXT:
return "cxt";
case PIC_TT_PROC:
return "proc";
case PIC_TT_ENV:
return "env";
case PIC_TT_DATA:
return "data";
case PIC_TT_DICT:
return "dict";
case PIC_TT_WEAK:
return "weak";
case PIC_TT_RECORD:
return "record";
case PIC_TT_CP:
return "checkpoint";
}
PIC_UNREACHABLE();
}
PIC_INLINE pic_value PIC_INLINE pic_value
pic_nil_value(pic_state PIC_UNUSED(*pic)) pic_nil_value(pic_state PIC_UNUSED(*pic))
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_NIL); pic_init_value(v, PIC_TYPE_NIL);
return v;
}
PIC_INLINE pic_value
pic_eof_object(pic_state PIC_UNUSED(*pic))
{
pic_value v;
pic_init_value(v, PIC_TYPE_EOF);
return v; return v;
} }
@ -279,7 +138,7 @@ pic_true_value(pic_state PIC_UNUSED(*pic))
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_TRUE); pic_init_value(v, PIC_TYPE_TRUE);
return v; return v;
} }
@ -288,7 +147,7 @@ pic_false_value(pic_state PIC_UNUSED(*pic))
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_FALSE); pic_init_value(v, PIC_TYPE_FALSE);
return v; return v;
} }
@ -297,7 +156,25 @@ pic_bool_value(pic_state PIC_UNUSED(*pic), bool b)
{ {
pic_value v; pic_value v;
pic_init_value(v, b ? PIC_VTYPE_TRUE : PIC_VTYPE_FALSE); pic_init_value(v, b ? PIC_TYPE_TRUE : PIC_TYPE_FALSE);
return v;
}
PIC_INLINE pic_value
pic_undef_value(pic_state PIC_UNUSED(*pic))
{
pic_value v;
pic_init_value(v, PIC_TYPE_UNDEF);
return v;
}
PIC_INLINE pic_value
pic_invalid_value()
{
pic_value v;
pic_init_value(v, PIC_TYPE_INVALID);
return v; return v;
} }
@ -308,7 +185,7 @@ pic_obj_value(void *ptr)
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_HEAP); pic_init_value(v, PIC_IVAL_END);
v |= 0xfffffffffffful & (uint64_t)ptr; v |= 0xfffffffffffful & (uint64_t)ptr;
return v; return v;
} }
@ -329,13 +206,10 @@ pic_float_value(pic_state PIC_UNUSED(*pic), double f)
PIC_INLINE pic_value PIC_INLINE pic_value
pic_int_value(pic_state PIC_UNUSED(*pic), int i) pic_int_value(pic_state PIC_UNUSED(*pic), int i)
{ {
union { int i; unsigned u; } u;
pic_value v; pic_value v;
u.i = i; pic_init_value(v, PIC_TYPE_INT);
v |= (unsigned)i;
pic_init_value(v, PIC_VTYPE_INT);
v |= u.u;
return v; return v;
} }
@ -344,8 +218,8 @@ pic_char_value(pic_state PIC_UNUSED(*pic), char c)
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_CHAR); pic_init_value(v, PIC_TYPE_CHAR);
v |= c; v |= (unsigned char)c;
return v; return v;
} }
@ -356,7 +230,7 @@ pic_obj_value(void *ptr)
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_HEAP); pic_init_value(v, PIC_IVAL_END);
v.u.data = ptr; v.u.data = ptr;
return v; return v;
} }
@ -366,7 +240,7 @@ pic_float_value(pic_state PIC_UNUSED(*pic), double f)
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_FLOAT); pic_init_value(v, PIC_TYPE_FLOAT);
v.u.f = f; v.u.f = f;
return v; return v;
} }
@ -376,7 +250,7 @@ pic_int_value(pic_state PIC_UNUSED(*pic), int i)
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_INT); pic_init_value(v, PIC_TYPE_INT);
v.u.i = i; v.u.i = i;
return v; return v;
} }
@ -386,95 +260,13 @@ pic_char_value(pic_state PIC_UNUSED(*pic), char c)
{ {
pic_value v; pic_value v;
pic_init_value(v, PIC_VTYPE_CHAR); pic_init_value(v, PIC_TYPE_CHAR);
v.u.c = c; v.u.c = c;
return v; return v;
} }
#endif #endif
PIC_INLINE pic_value
pic_undef_value(pic_state PIC_UNUSED(*pic))
{
pic_value v;
pic_init_value(v, PIC_VTYPE_UNDEF);
return v;
}
PIC_INLINE pic_value
pic_invalid_value()
{
pic_value v;
pic_init_value(v, PIC_VTYPE_INVALID);
return v;
}
#if PIC_NAN_BOXING
PIC_INLINE bool
pic_eq_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
return x == y;
}
PIC_INLINE bool
pic_eqv_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
return x == y;
}
#else
PIC_INLINE bool
pic_eq_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
if (pic_type(pic, x) != pic_type(pic, y))
return false;
switch (pic_type(pic, x)) {
case PIC_TT_NIL:
return true;
case PIC_TT_BOOL:
return pic_vtype(pic, x) == pic_vtype(pic, y);
default:
return pic_ptr(x) == pic_ptr(y);
}
}
PIC_INLINE bool
pic_eqv_p(pic_state PIC_UNUSED(*pic), pic_value x, pic_value y)
{
if (pic_type(pic, x) != pic_type(pic, y))
return false;
switch (pic_type(pic, x)) {
case PIC_TT_NIL:
return true;
case PIC_TT_BOOL:
return pic_vtype(pic, x) == pic_vtype(pic, y);
case PIC_TT_FLOAT:
return pic_float(pic, x) == pic_float(pic, y);
case PIC_TT_INT:
return pic_int(pic, x) == pic_int(pic, y);
default:
return pic_ptr(x) == pic_ptr(y);
}
}
#endif
pic_value pic_add(pic_state *, pic_value, pic_value);
pic_value pic_sub(pic_state *, pic_value, pic_value);
pic_value pic_mul(pic_state *, pic_value, pic_value);
pic_value pic_div(pic_state *, pic_value, pic_value);
bool pic_eq(pic_state *, pic_value, pic_value);
bool pic_lt(pic_state *, pic_value, pic_value);
bool pic_le(pic_state *, pic_value, pic_value);
bool pic_gt(pic_state *, pic_value, pic_value);
bool pic_ge(pic_state *, pic_value, pic_value);
#if defined(__cplusplus) #if defined(__cplusplus)
} }
#endif #endif

2
extlib/benz/include/picrin/vector.h
View File

@ -15,7 +15,7 @@ struct pic_vector {
int len; int len;
}; };
#define pic_vec_ptr(o) ((struct pic_vector *)pic_ptr(o)) #define pic_vec_ptr(o) ((struct pic_vector *)pic_obj_ptr(o))
#if defined(__cplusplus) #if defined(__cplusplus)
} }

2
extlib/benz/include/picrin/weak.h
View File

@ -17,7 +17,7 @@ struct pic_weak {
struct pic_weak *prev; /* for GC */ struct pic_weak *prev; /* for GC */
}; };
#define pic_weak_ptr(v) ((struct pic_weak *)pic_ptr(v)) #define pic_weak_ptr(v) ((struct pic_weak *)pic_obj_ptr(v))
#if defined(__cplusplus) #if defined(__cplusplus)
} }

10
extlib/benz/macro.c
View File

@ -13,7 +13,7 @@ pic_make_env(pic_state *pic, struct pic_env *up)
assert(up != NULL); assert(up != NULL);
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TYPE_ENV);
env->up = up; env->up = up;
env->lib = NULL; env->lib = NULL;
kh_init(env, &env->map); kh_init(env, &env->map);
@ -25,7 +25,7 @@ pic_make_topenv(pic_state *pic, struct pic_string *lib)
{ {
struct pic_env *env; struct pic_env *env;
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TYPE_ENV);
env->up = NULL; env->up = NULL;
env->lib = lib; env->lib = lib;
kh_init(env, &env->map); kh_init(env, &env->map);
@ -285,11 +285,11 @@ static pic_value
expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value deferred) expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value deferred)
{ {
switch (pic_type(pic, expr)) { switch (pic_type(pic, expr)) {
case PIC_TT_ID: case PIC_TYPE_ID:
case PIC_TT_SYMBOL: { case PIC_TYPE_SYMBOL: {
return expand_var(pic, pic_id_ptr(expr), env, deferred); return expand_var(pic, pic_id_ptr(expr), env, deferred);
} }
case PIC_TT_PAIR: { case PIC_TYPE_PAIR: {
struct pic_proc *mac; struct pic_proc *mac;
if (! pic_list_p(pic, expr)) { if (! pic_list_p(pic, expr)) {

2
extlib/benz/pair.c
View File

@ -9,7 +9,7 @@ pic_cons(pic_state *pic, pic_value car, pic_value cdr)
{ {
struct pic_pair *pair; struct pic_pair *pair;
pair = (struct pic_pair *)pic_obj_alloc(pic, sizeof(struct pic_pair), PIC_TT_PAIR); pair = (struct pic_pair *)pic_obj_alloc(pic, sizeof(struct pic_pair), PIC_TYPE_PAIR);
pair->car = car; pair->car = car;
pair->cdr = cdr; pair->cdr = cdr;

40
extlib/benz/port.c
View File

@ -4,16 +4,6 @@
#include "picrin.h" #include "picrin.h"
pic_value
pic_eof_object()
{
pic_value v;
pic_init_value(v, PIC_VTYPE_EOF);
return v;
}
static pic_value static pic_value
pic_assert_port(pic_state *pic) pic_assert_port(pic_state *pic)
{ {
@ -121,7 +111,7 @@ pic_open_file(pic_state *pic, const char *name, int flags) {
file_error(pic, pic_str_cstr(pic, pic_format(pic, "could not open file '%s'", name))); file_error(pic, pic_str_cstr(pic, pic_format(pic, "could not open file '%s'", name)));
} }
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = file; port->file = file;
port->flags = flags | PIC_PORT_OPEN; port->flags = flags | PIC_PORT_OPEN;
@ -159,7 +149,7 @@ pic_define_standard_port(pic_state *pic, const char *name, xFILE *file, int dir)
{ {
struct pic_port *port; struct pic_port *port;
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = file; port->file = file;
port->flags = dir | PIC_PORT_TEXT | PIC_PORT_OPEN; port->flags = dir | PIC_PORT_TEXT | PIC_PORT_OPEN;
@ -276,7 +266,7 @@ pic_open_input_string(pic_state *pic, const char *str)
{ {
struct pic_port *port; struct pic_port *port;
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = string_open(pic, str, strlen(str)); port->file = string_open(pic, str, strlen(str));
port->flags = PIC_PORT_IN | PIC_PORT_TEXT | PIC_PORT_OPEN; port->flags = PIC_PORT_IN | PIC_PORT_TEXT | PIC_PORT_OPEN;
@ -288,7 +278,7 @@ pic_open_output_string(pic_state *pic)
{ {
struct pic_port *port; struct pic_port *port;
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = string_open(pic, NULL, 0); port->file = string_open(pic, NULL, 0);
port->flags = PIC_PORT_OUT | PIC_PORT_TEXT | PIC_PORT_OPEN; port->flags = PIC_PORT_OUT | PIC_PORT_TEXT | PIC_PORT_OPEN;
@ -424,7 +414,7 @@ pic_port_eof_object(pic_state *pic)
{ {
pic_get_args(pic, ""); pic_get_args(pic, "");
return pic_eof_object(); return pic_eof_object(pic);
} }
static pic_value static pic_value
@ -516,7 +506,7 @@ pic_port_open_input_blob(pic_state *pic)
pic_get_args(pic, "b", &blob); pic_get_args(pic, "b", &blob);
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = string_open(pic, (const char *)blob->data, blob->len); port->file = string_open(pic, (const char *)blob->data, blob->len);
port->flags = PIC_PORT_IN | PIC_PORT_BINARY | PIC_PORT_OPEN; port->flags = PIC_PORT_IN | PIC_PORT_BINARY | PIC_PORT_OPEN;
@ -530,7 +520,7 @@ pic_port_open_output_bytevector(pic_state *pic)
pic_get_args(pic, ""); pic_get_args(pic, "");
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TYPE_PORT);
port->file = string_open(pic, NULL, 0); port->file = string_open(pic, NULL, 0);
port->flags = PIC_PORT_OUT | PIC_PORT_BINARY | PIC_PORT_OPEN; port->flags = PIC_PORT_OUT | PIC_PORT_BINARY | PIC_PORT_OPEN;
@ -573,7 +563,7 @@ pic_port_read_char(pic_state *pic)
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-char"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-char");
if ((c = xfgetc(pic, port->file)) == EOF) { if ((c = xfgetc(pic, port->file)) == EOF) {
return pic_eof_object(); return pic_eof_object(pic);
} }
else { else {
return pic_char_value(pic, (char)c); return pic_char_value(pic, (char)c);
@ -591,7 +581,7 @@ pic_port_peek_char(pic_state *pic)
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "peek-char"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "peek-char");
if ((c = xfgetc(pic, port->file)) == EOF) { if ((c = xfgetc(pic, port->file)) == EOF) {
return pic_eof_object(); return pic_eof_object(pic);
} }
else { else {
xungetc(c, port->file); xungetc(c, port->file);
@ -605,7 +595,7 @@ pic_port_read_line(pic_state *pic)
int c; int c;
struct pic_port *port = pic_stdin(pic), *buf; struct pic_port *port = pic_stdin(pic), *buf;
struct pic_string *str; struct pic_string *str;
pic_value res = pic_eof_object(); pic_value res = pic_eof_object(pic);
pic_get_args(pic, "|p", &port); pic_get_args(pic, "|p", &port);
@ -644,7 +634,7 @@ pic_port_read_string(pic_state *pic){
struct pic_string *str; struct pic_string *str;
int k, i; int k, i;
int c; int c;
pic_value res = pic_eof_object(); pic_value res = pic_eof_object(pic);
pic_get_args(pic, "i|p", &k, &port); pic_get_args(pic, "i|p", &k, &port);
@ -677,7 +667,7 @@ pic_port_read_byte(pic_state *pic){
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-u8"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-u8");
if ((c = xfgetc(pic, port->file)) == EOF) { if ((c = xfgetc(pic, port->file)) == EOF) {
return pic_eof_object(); return pic_eof_object(pic);
} }
return pic_int_value(pic, c); return pic_int_value(pic, c);
@ -695,7 +685,7 @@ pic_port_peek_byte(pic_state *pic)
c = xfgetc(pic, port->file); c = xfgetc(pic, port->file);
if (c == EOF) { if (c == EOF) {
return pic_eof_object(); return pic_eof_object(pic);
} }
else { else {
xungetc(c, port->file); xungetc(c, port->file);
@ -731,7 +721,7 @@ pic_port_read_blob(pic_state *pic)
i = xfread(pic, blob->data, sizeof(char), k, port->file); i = xfread(pic, blob->data, sizeof(char), k, port->file);
if (i == 0) { if (i == 0) {
return pic_eof_object(); return pic_eof_object(pic);
} }
else { else {
pic_realloc(pic, blob->data, i); pic_realloc(pic, blob->data, i);
@ -772,7 +762,7 @@ pic_port_read_blob_ip(pic_state *pic)
pic_free(pic, buf); pic_free(pic, buf);
if (i == 0) { if (i == 0) {
return pic_eof_object(); return pic_eof_object(pic);
} }
else { else {
return pic_int_value(pic, i); return pic_int_value(pic, i);

23
extlib/benz/proc.c
View File

@ -107,11 +107,11 @@ pic_get_args(pic_state *pic, const char *format, ...)
\ \
v = GET_OPERAND(pic, i); \ v = GET_OPERAND(pic, i); \
switch (pic_type(pic, v)) { \ switch (pic_type(pic, v)) { \
case PIC_TT_FLOAT: \ case PIC_TYPE_FLOAT: \
*n = pic_float(pic, v); \ *n = pic_float(pic, v); \
*e = false; \ *e = false; \
break; \ break; \
case PIC_TT_INT: \ case PIC_TYPE_INT: \
*n = pic_int(pic, v); \ *n = pic_int(pic, v); \
*e = true; \ *e = true; \
break; \ break; \
@ -195,7 +195,7 @@ vm_push_cxt(pic_state *pic)
{ {
pic_callinfo *ci = pic->ci; pic_callinfo *ci = pic->ci;
ci->cxt = (struct pic_context *)pic_obj_alloc(pic, offsetof(struct pic_context, storage) + sizeof(pic_value) * ci->regc, PIC_TT_CXT); ci->cxt = (struct pic_context *)pic_obj_alloc(pic, offsetof(struct pic_context, storage) + sizeof(pic_value) * ci->regc, PIC_TYPE_CXT);
ci->cxt->up = ci->up; ci->cxt->up = ci->up;
ci->cxt->regc = ci->regc; ci->cxt->regc = ci->regc;
ci->cxt->regs = ci->regs; ci->cxt->regs = ci->regs;
@ -321,6 +321,17 @@ pic_vm_tear_off(pic_state *pic)
# define VM_CALL_PRINT # define VM_CALL_PRINT
#endif #endif
/* for arithmetic instructions */
pic_value pic_add(pic_state *, pic_value, pic_value);
pic_value pic_sub(pic_state *, pic_value, pic_value);
pic_value pic_mul(pic_state *, pic_value, pic_value);
pic_value pic_div(pic_state *, pic_value, pic_value);
bool pic_eq(pic_state *, pic_value, pic_value);
bool pic_lt(pic_state *, pic_value, pic_value);
bool pic_le(pic_state *, pic_value, pic_value);
bool pic_gt(pic_state *, pic_value, pic_value);
bool pic_ge(pic_state *, pic_value, pic_value);
pic_value pic_value
pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv) pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
{ {
@ -399,7 +410,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
NEXT; NEXT;
} }
CASE(OP_PUSHEOF) { CASE(OP_PUSHEOF) {
PUSH(pic_eof_object()); PUSH(pic_eof_object(pic));
NEXT; NEXT;
} }
CASE(OP_PUSHCONST) { CASE(OP_PUSHCONST) {
@ -1003,7 +1014,7 @@ pic_make_proc(pic_state *pic, pic_func_t func, int n, pic_value *env)
struct pic_proc *proc; struct pic_proc *proc;
int i; int i;
proc = (struct pic_proc *)pic_obj_alloc(pic, offsetof(struct pic_proc, locals) + sizeof(pic_value) * n, PIC_TT_PROC); proc = (struct pic_proc *)pic_obj_alloc(pic, offsetof(struct pic_proc, locals) + sizeof(pic_value) * n, PIC_TYPE_PROC);
proc->tag = PIC_PROC_TAG_FUNC; proc->tag = PIC_PROC_TAG_FUNC;
proc->u.f.func = func; proc->u.f.func = func;
proc->u.f.localc = n; proc->u.f.localc = n;
@ -1018,7 +1029,7 @@ pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cx
{ {
struct pic_proc *proc; struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, offsetof(struct pic_proc, locals), PIC_TT_PROC); proc = (struct pic_proc *)pic_obj_alloc(pic, offsetof(struct pic_proc, locals), PIC_TYPE_PROC);
proc->tag = PIC_PROC_TAG_IREP; proc->tag = PIC_PROC_TAG_IREP;
proc->u.i.irep = irep; proc->u.i.irep = irep;
proc->u.i.cxt = cxt; proc->u.i.cxt = cxt;

2
extlib/benz/read.c
View File

@ -838,7 +838,7 @@ pic_read(pic_state *pic, struct pic_port *port)
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
} }
if (c == EOF) { if (c == EOF) {
return pic_eof_object(); return pic_eof_object(pic);
} }
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);

2
extlib/benz/record.c
View File

@ -9,7 +9,7 @@ pic_make_rec(pic_state *pic, pic_value type, pic_value datum)
{ {
struct pic_record *rec; struct pic_record *rec;
rec = (struct pic_record *)pic_obj_alloc(pic, sizeof(struct pic_record), PIC_TT_RECORD); rec = (struct pic_record *)pic_obj_alloc(pic, sizeof(struct pic_record), PIC_TYPE_RECORD);
rec->type = type; rec->type = type;
rec->datum = datum; rec->datum = datum;

2
extlib/benz/state.c
View File

@ -334,7 +334,7 @@ pic_open(pic_allocf allocf, void *userdata)
pic->macros = pic_make_weak(pic); pic->macros = pic_make_weak(pic);
/* root block */ /* root block */
pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TT_CP); pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TYPE_CP);
pic->cp->prev = NULL; pic->cp->prev = NULL;
pic->cp->depth = 0; pic->cp->depth = 0;
pic->cp->in = pic->cp->out = NULL; pic->cp->in = pic->cp->out = NULL;

2
extlib/benz/string.c
View File

@ -98,7 +98,7 @@ pic_make_string(pic_state *pic, struct pic_rope *rope)
{ {
struct pic_string *str; struct pic_string *str;
str = (struct pic_string *)pic_obj_alloc(pic, sizeof(struct pic_string), PIC_TT_STRING); str = (struct pic_string *)pic_obj_alloc(pic, sizeof(struct pic_string), PIC_TYPE_STRING);
str->rope = rope; /* delegate ownership */ str->rope = rope; /* delegate ownership */
return str; return str;
} }

4
extlib/benz/symbol.c
View File

@ -26,7 +26,7 @@ pic_intern(pic_state *pic, struct pic_string *str)
kh_val(h, it) = pic->sQUOTE; /* dummy */ kh_val(h, it) = pic->sQUOTE; /* dummy */
sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TT_SYMBOL); sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TYPE_SYMBOL);
sym->str = str; sym->str = str;
kh_val(h, it) = sym; kh_val(h, it) = sym;
@ -38,7 +38,7 @@ pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
{ {
pic_id *nid; pic_id *nid;
nid = (pic_id *)pic_obj_alloc(pic, sizeof(pic_id), PIC_TT_ID); nid = (pic_id *)pic_obj_alloc(pic, sizeof(pic_id), PIC_TYPE_ID);
nid->u.id.id = id; nid->u.id.id = id;
nid->u.id.env = env; nid->u.id.env = env;
return nid; return nid;

74
extlib/benz/value.c Normal file
View File

@ -0,0 +1,74 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
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);
}
}

2
extlib/benz/vector.c
View File

@ -10,7 +10,7 @@ pic_make_vec(pic_state *pic, int len)
struct pic_vector *vec; struct pic_vector *vec;
int i; int i;
vec = (struct pic_vector *)pic_obj_alloc(pic, sizeof(struct pic_vector), PIC_TT_VECTOR); vec = (struct pic_vector *)pic_obj_alloc(pic, sizeof(struct pic_vector), PIC_TYPE_VECTOR);
vec->len = len; vec->len = len;
vec->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len); vec->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len);
for (i = 0; i < len; ++i) { for (i = 0; i < len; ++i) {

2
extlib/benz/weak.c
View File

@ -11,7 +11,7 @@ pic_make_weak(pic_state *pic)
{ {
struct pic_weak *weak; struct pic_weak *weak;
weak = (struct pic_weak *)pic_obj_alloc(pic, sizeof(struct pic_weak), PIC_TT_WEAK); weak = (struct pic_weak *)pic_obj_alloc(pic, sizeof(struct pic_weak), PIC_TYPE_WEAK);
weak->prev = NULL; weak->prev = NULL;
kh_init(weak, &weak->hash); kh_init(weak, &weak->hash);

61
extlib/benz/write.c
View File

@ -134,10 +134,10 @@ write_pair_help(struct writer_control *p, struct pic_pair *pair)
else if (pic_pair_p(pic, pair->cdr)) { else if (pic_pair_p(pic, pair->cdr)) {
/* shared objects */ /* shared objects */
if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) { if ((it = kh_get(l, lh, pic_obj_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) {
xfprintf(pic, p->file, " . "); xfprintf(pic, p->file, " . ");
kh_put(v, vh, pic_ptr(pair->cdr), &ret); kh_put(v, vh, pic_obj_ptr(pair->cdr), &ret);
if (ret == 0) { /* if exists */ if (ret == 0) { /* if exists */
xfprintf(pic, p->file, "#%d#", kh_val(lh, it)); xfprintf(pic, p->file, "#%d#", kh_val(lh, it));
return; return;
@ -151,8 +151,8 @@ write_pair_help(struct writer_control *p, struct pic_pair *pair)
write_pair_help(p, pic_pair_ptr(pair->cdr)); write_pair_help(p, pic_pair_ptr(pair->cdr));
if (p->op == OP_WRITE) { if (p->op == OP_WRITE) {
if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) { if ((it = kh_get(l, lh, pic_obj_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) {
it = kh_get(v, vh, pic_ptr(pair->cdr)); it = kh_get(v, vh, pic_obj_ptr(pair->cdr));
kh_del(v, vh, it); kh_del(v, vh, it);
} }
} }
@ -263,8 +263,8 @@ write_core(struct writer_control *p, pic_value obj)
int ret; int ret;
/* shared objects */ /* shared objects */
if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_obj_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) {
kh_put(v, vh, pic_ptr(obj), &ret); kh_put(v, vh, pic_obj_ptr(obj), &ret);
if (ret == 0) { /* if exists */ if (ret == 0) { /* if exists */
xfprintf(pic, file, "#%d#", kh_val(lh, it)); xfprintf(pic, file, "#%d#", kh_val(lh, it));
return; return;
@ -273,56 +273,59 @@ write_core(struct writer_control *p, pic_value obj)
} }
switch (pic_type(pic, obj)) { switch (pic_type(pic, obj)) {
case PIC_TT_UNDEF: case PIC_TYPE_UNDEF:
xfprintf(pic, file, "#undefined"); xfprintf(pic, file, "#undefined");
break; break;
case PIC_TT_NIL: case PIC_TYPE_NIL:
xfprintf(pic, file, "()"); xfprintf(pic, file, "()");
break; break;
case PIC_TT_BOOL: case PIC_TYPE_TRUE:
xfprintf(pic, file, pic_true_p(pic, obj) ? "#t" : "#f"); xfprintf(pic, file, "#t");
break; break;
case PIC_TT_ID: case PIC_TYPE_FALSE:
xfprintf(pic, file, "#f");
break;
case PIC_TYPE_ID:
xfprintf(pic, file, "#<identifier %s>", pic_identifier_name(pic, pic_id_ptr(obj))); xfprintf(pic, file, "#<identifier %s>", pic_identifier_name(pic, pic_id_ptr(obj)));
break; break;
case PIC_TT_EOF: case PIC_TYPE_EOF:
xfprintf(pic, file, "#.(eof-object)"); xfprintf(pic, file, "#.(eof-object)");
break; break;
case PIC_TT_INT: case PIC_TYPE_INT:
xfprintf(pic, file, "%d", pic_int(pic, obj)); xfprintf(pic, file, "%d", pic_int(pic, obj));
break; break;
case PIC_TT_FLOAT: case PIC_TYPE_FLOAT:
write_float(pic, pic_float(pic, obj), file); write_float(pic, pic_float(pic, obj), file);
break; break;
case PIC_TT_SYMBOL: case PIC_TYPE_SYMBOL:
xfprintf(pic, file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj))); xfprintf(pic, file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj)));
break; break;
case PIC_TT_BLOB: case PIC_TYPE_BLOB:
write_blob(pic, pic_blob_ptr(obj), file); write_blob(pic, pic_blob_ptr(obj), file);
break; break;
case PIC_TT_CHAR: case PIC_TYPE_CHAR:
write_char(pic, pic_char(pic, obj), file, p->mode); write_char(pic, pic_char(pic, obj), file, p->mode);
break; break;
case PIC_TT_STRING: case PIC_TYPE_STRING:
write_str(pic, pic_str_ptr(obj), file, p->mode); write_str(pic, pic_str_ptr(obj), file, p->mode);
break; break;
case PIC_TT_PAIR: case PIC_TYPE_PAIR:
write_pair(p, pic_pair_ptr(obj)); write_pair(p, pic_pair_ptr(obj));
break; break;
case PIC_TT_VECTOR: case PIC_TYPE_VECTOR:
write_vec(p, pic_vec_ptr(obj)); write_vec(p, pic_vec_ptr(obj));
break; break;
case PIC_TT_DICT: case PIC_TYPE_DICT:
write_dict(p, pic_dict_ptr(obj)); write_dict(p, pic_dict_ptr(obj));
break; break;
default: default:
xfprintf(pic, file, "#<%s %p>", pic_type_repr(pic, pic_type(pic, obj)), pic_ptr(obj)); xfprintf(pic, file, "#<%s %p>", pic_typename(pic, pic_type(pic, obj)), pic_obj_ptr(obj));
break; break;
} }
if (p->op == OP_WRITE) { if (p->op == OP_WRITE) {
if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_obj_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) {
it = kh_get(v, vh, pic_ptr(obj)); it = kh_get(v, vh, pic_obj_ptr(obj));
kh_del(v, vh, it); kh_del(v, vh, it);
} }
} }
@ -338,14 +341,14 @@ traverse(struct writer_control *p, pic_value obj)
} }
switch (pic_type(pic, obj)) { switch (pic_type(pic, obj)) {
case PIC_TT_PAIR: case PIC_TYPE_PAIR:
case PIC_TT_VECTOR: case PIC_TYPE_VECTOR:
case PIC_TT_DICT: { case PIC_TYPE_DICT: {
khash_t(l) *h = &p->labels; khash_t(l) *h = &p->labels;
khiter_t it; khiter_t it;
int ret; int ret;
it = kh_put(l, h, pic_ptr(obj), &ret); it = kh_put(l, h, pic_obj_ptr(obj), &ret);
if (ret != 0) { if (ret != 0) {
/* first time */ /* first time */
kh_val(h, it) = -1; kh_val(h, it) = -1;
@ -369,7 +372,7 @@ traverse(struct writer_control *p, pic_value obj)
} }
if (p->op == OP_WRITE) { if (p->op == OP_WRITE) {
it = kh_get(l, h, pic_ptr(obj)); it = kh_get(l, h, pic_obj_ptr(obj));
if (kh_val(h, it) == -1) { if (kh_val(h, it) == -1) {
kh_del(l, h, it); kh_del(l, h, it);
} }