From 08652df612a77aa51be058c382bee7585c59ff5f Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 18 Feb 2016 23:25:45 +0900 Subject: [PATCH] don't include type.h at the beginning of picrin.h --- contrib/20.r7rs/src/system.c | 8 +- contrib/30.readline/src/readline.c | 2 +- contrib/40.srfi/src/106.c | 2 +- extlib/benz/blob.c | 2 +- extlib/benz/bool.c | 66 +++++- extlib/benz/cont.c | 2 +- extlib/benz/data.c | 2 +- extlib/benz/dict.c | 2 +- extlib/benz/error.c | 2 +- extlib/benz/eval.c | 25 +- extlib/benz/gc.c | 106 ++++----- extlib/benz/include/picrin.h | 117 +++++++--- extlib/benz/include/picrin/blob.h | 2 +- extlib/benz/include/picrin/data.h | 2 +- extlib/benz/include/picrin/dict.h | 2 +- extlib/benz/include/picrin/error.h | 4 +- extlib/benz/include/picrin/macro.h | 4 +- extlib/benz/include/picrin/pair.h | 2 +- extlib/benz/include/picrin/port.h | 4 +- extlib/benz/include/picrin/proc.h | 6 +- extlib/benz/include/picrin/record.h | 4 +- extlib/benz/include/picrin/setup.h | 4 +- extlib/benz/include/picrin/string.h | 2 +- extlib/benz/include/picrin/symbol.h | 6 +- extlib/benz/include/picrin/type.h | 344 ++++++---------------------- extlib/benz/include/picrin/vector.h | 2 +- extlib/benz/include/picrin/weak.h | 2 +- extlib/benz/macro.c | 10 +- extlib/benz/pair.c | 2 +- extlib/benz/port.c | 40 ++-- extlib/benz/proc.c | 23 +- extlib/benz/read.c | 2 +- extlib/benz/record.c | 2 +- extlib/benz/state.c | 2 +- extlib/benz/string.c | 2 +- extlib/benz/symbol.c | 4 +- extlib/benz/value.c | 74 ++++++ extlib/benz/vector.c | 2 +- extlib/benz/weak.c | 2 +- extlib/benz/write.c | 61 ++--- 40 files changed, 470 insertions(+), 482 deletions(-) create mode 100644 extlib/benz/value.c diff --git a/contrib/20.r7rs/src/system.c b/contrib/20.r7rs/src/system.c index 26ffbfe1..d53169aa 100644 --- a/contrib/20.r7rs/src/system.c +++ b/contrib/20.r7rs/src/system.c @@ -37,10 +37,10 @@ pic_system_exit(pic_state *pic) argc = pic_get_args(pic, "|o", &v); if (argc == 1) { switch (pic_type(pic, v)) { - case PIC_TT_FLOAT: + case PIC_TYPE_FLOAT: status = (int)pic_float(pic, v); break; - case PIC_TT_INT: + case PIC_TYPE_INT: status = pic_int(pic, v); break; default: @@ -62,10 +62,10 @@ pic_system_emergency_exit(pic_state *pic) argc = pic_get_args(pic, "|o", &v); if (argc == 1) { switch (pic_type(pic, v)) { - case PIC_TT_FLOAT: + case PIC_TYPE_FLOAT: status = (int)pic_float(pic, v); break; - case PIC_TT_INT: + case PIC_TYPE_INT: status = pic_int(pic, v); break; default: diff --git a/contrib/30.readline/src/readline.c b/contrib/30.readline/src/readline.c index a7542af5..50c77163 100644 --- a/contrib/30.readline/src/readline.c +++ b/contrib/30.readline/src/readline.c @@ -21,7 +21,7 @@ pic_rl_readline(pic_state *pic) if(result) return pic_obj_value(pic_make_cstr(pic, result)); else - return pic_eof_object(); + return pic_eof_object(pic); } static pic_value diff --git a/contrib/40.srfi/src/106.c b/contrib/40.srfi/src/106.c index b1aac0ce..f88504de 100644 --- a/contrib/40.srfi/src/106.c +++ b/contrib/40.srfi/src/106.c @@ -340,7 +340,7 @@ make_socket_port(pic_state *pic, struct pic_socket_t *sock, short dir) { 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->flags = dir | PIC_PORT_BINARY | PIC_PORT_OPEN; return port; diff --git a/extlib/benz/blob.c b/extlib/benz/blob.c index fc464aa0..9d1161f0 100644 --- a/extlib/benz/blob.c +++ b/extlib/benz/blob.c @@ -9,7 +9,7 @@ pic_make_blob(pic_state *pic, int len) { 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->len = len; return bv; diff --git a/extlib/benz/bool.c b/extlib/benz/bool.c index cf72b27c..ff7d4a31 100644 --- a/extlib/benz/bool.c +++ b/extlib/benz/bool.c @@ -4,6 +4,60 @@ #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_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)) { - case PIC_TT_ID: { + case PIC_TYPE_ID: { struct pic_id *id1, *id2; 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; } - case PIC_TT_STRING: { + case PIC_TYPE_STRING: { 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; 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; } - case PIC_TT_PAIR: { + case PIC_TYPE_PAIR: { if (! internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, h)) 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 */ } - case PIC_TT_VECTOR: { + case PIC_TYPE_VECTOR: { int i; 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; } - case PIC_TT_DATA: { + case PIC_TYPE_DATA: { return pic_data_ptr(x)->data == pic_data_ptr(y)->data; } default: diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c index 4ee65e09..8dac1bcd 100644 --- a/extlib/benz/cont.c +++ b/extlib/benz/cont.c @@ -31,7 +31,7 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st } 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->depth = here->depth + 1; pic->cp->in = in; diff --git a/extlib/benz/data.c b/extlib/benz/data.c index 0df3ab06..a570b6be 100644 --- a/extlib/benz/data.c +++ b/extlib/benz/data.c @@ -5,7 +5,7 @@ pic_data_alloc(pic_state *pic, const pic_data_type *type, void *userdata) { 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->data = userdata; diff --git a/extlib/benz/dict.c b/extlib/benz/dict.c index 3583d5e3..39dcacf6 100644 --- a/extlib/benz/dict.c +++ b/extlib/benz/dict.c @@ -11,7 +11,7 @@ pic_make_dict(pic_state *pic) { 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); return dict; diff --git a/extlib/benz/error.c b/extlib/benz/error.c index 306b69c2..b416ed18 100644 --- a/extlib/benz/error.c +++ b/extlib/benz/error.c @@ -98,7 +98,7 @@ pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs) 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->msg = pic_make_cstr(pic, msg); e->irrs = irrs; diff --git a/extlib/benz/eval.c b/extlib/benz/eval.c index a87c8f75..371651c6 100644 --- a/extlib/benz/eval.c +++ b/extlib/benz/eval.c @@ -293,10 +293,10 @@ static pic_value analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj) { switch (pic_type(pic, obj)) { - case PIC_TT_SYMBOL: { + case PIC_TYPE_SYMBOL: { return analyze_var(pic, scope, pic_sym_ptr(obj)); } - case PIC_TT_PAIR: { + case PIC_TYPE_PAIR: { pic_value proc; 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); switch (pic_type(pic, obj)) { - case PIC_TT_UNDEF: + case PIC_TYPE_UNDEF: emit_n(pic, cxt, OP_PUSHUNDEF); break; - case PIC_TT_BOOL: - emit_n(pic, cxt, (pic_true_p(pic, obj) ? OP_PUSHTRUE : OP_PUSHFALSE)); + case PIC_TYPE_TRUE: + emit_n(pic, cxt, OP_PUSHTRUE); 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); pidx = (int)cxt->klen++; cxt->ints[pidx] = pic_int(pic, obj); emit_i(pic, cxt, OP_PUSHINT, pidx); break; - case PIC_TT_FLOAT: + case PIC_TYPE_FLOAT: check_nums_size(pic, cxt); pidx = (int)cxt->flen++; cxt->nums[pidx] = pic_float(pic, obj); emit_i(pic, cxt, OP_PUSHFLOAT, pidx); break; - case PIC_TT_NIL: + case PIC_TYPE_NIL: emit_n(pic, cxt, OP_PUSHNIL); break; - case PIC_TT_EOF: + case PIC_TYPE_EOF: emit_n(pic, cxt, OP_PUSHEOF); break; - case PIC_TT_CHAR: + case PIC_TYPE_CHAR: check_ints_size(pic, cxt); pidx = (int)cxt->klen++; cxt->ints[pidx] = pic_char(pic, obj); emit_i(pic, cxt, OP_PUSHCHAR, pidx); break; default: - assert(pic_obj_p(obj)); + assert(pic_obj_p(pic,obj)); check_pool_size(pic, cxt); pidx = (int)cxt->plen++; cxt->pool[pidx] = pic_obj_ptr(obj); diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index d91f6d31..e0c53e81 100644 --- a/extlib/benz/gc.c +++ b/extlib/benz/gc.c @@ -277,14 +277,14 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) #define LOOP(o) obj = (struct pic_object *)(o); goto loop switch (obj->u.basic.tt) { - case PIC_TT_PAIR: { + case PIC_TYPE_PAIR: { gc_mark(pic, obj->u.pair.car); if (pic_obj_p(pic, obj->u.pair.cdr)) { LOOP(pic_obj_ptr(obj->u.pair.cdr)); } break; } - case PIC_TT_CXT: { + case PIC_TYPE_CXT: { int 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; } - case PIC_TT_PROC: { + case PIC_TYPE_PROC: { if (pic_proc_irep_p(&obj->u.proc)) { if (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; } - case PIC_TT_PORT: { + case PIC_TYPE_PORT: { 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.msg); gc_mark(pic, obj->u.err.irrs); LOOP(obj->u.err.stack); break; } - case PIC_TT_STRING: { + case PIC_TYPE_STRING: { break; } - case PIC_TT_VECTOR: { + case PIC_TYPE_VECTOR: { int i; for (i = 0; i < obj->u.vec.len; ++i) { gc_mark(pic, obj->u.vec.data[i]); } break; } - case PIC_TT_BLOB: { + case PIC_TYPE_BLOB: { break; } - case PIC_TT_ID: { + case PIC_TYPE_ID: { gc_mark_object(pic, (struct pic_object *)obj->u.id.u.id.id); LOOP(obj->u.id.u.id.env); break; } - case PIC_TT_ENV: { + case PIC_TYPE_ENV: { khash_t(env) *h = &obj->u.env.map; khiter_t it; @@ -351,13 +351,13 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) } break; } - case PIC_TT_DATA: { + case PIC_TYPE_DATA: { if (obj->u.data.type->mark) { obj->u.data.type->mark(pic, obj->u.data.data, gc_mark); } break; } - case PIC_TT_DICT: { + case PIC_TYPE_DICT: { pic_sym *sym; khiter_t it; @@ -367,25 +367,25 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) } break; } - case PIC_TT_RECORD: { + case PIC_TYPE_RECORD: { gc_mark(pic, obj->u.rec.type); if (pic_obj_p(pic, obj->u.rec.datum)) { LOOP(pic_obj_ptr(obj->u.rec.datum)); } break; } - case PIC_TT_SYMBOL: { + case PIC_TYPE_SYMBOL: { LOOP(obj->u.sym.str); break; } - case PIC_TT_WEAK: { + case PIC_TYPE_WEAK: { struct pic_weak *weak = (struct pic_weak *)obj; weak->prev = pic->heap->weaks; pic->heap->weaks = weak; break; } - case PIC_TT_CP: { + case PIC_TYPE_CP: { if (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; } - case PIC_TT_NIL: - case PIC_TT_BOOL: - case PIC_TT_FLOAT: - case PIC_TT_INT: - case PIC_TT_CHAR: - case PIC_TT_EOF: - case PIC_TT_UNDEF: - case PIC_TT_INVALID: + case PIC_TYPE_NIL: + case PIC_TYPE_TRUE: + case PIC_TYPE_FALSE: + case PIC_TYPE_FLOAT: + case PIC_TYPE_INT: + case PIC_TYPE_CHAR: + case PIC_TYPE_EOF: + case PIC_TYPE_UNDEF: + case PIC_TYPE_INVALID: pic_panic(pic, "logic flaw"); } } @@ -532,64 +533,65 @@ static void gc_finalize_object(pic_state *pic, struct pic_object *obj) { switch (obj->u.basic.tt) { - case PIC_TT_VECTOR: { + case PIC_TYPE_VECTOR: { pic_free(pic, obj->u.vec.data); break; } - case PIC_TT_BLOB: { + case PIC_TYPE_BLOB: { pic_free(pic, obj->u.blob.data); break; } - case PIC_TT_STRING: { + case PIC_TYPE_STRING: { pic_rope_decref(pic, obj->u.str.rope); break; } - case PIC_TT_ENV: { + case PIC_TYPE_ENV: { kh_destroy(env, &obj->u.env.map); break; } - case PIC_TT_DATA: { + case PIC_TYPE_DATA: { if (obj->u.data.type->dtor) { obj->u.data.type->dtor(pic, obj->u.data.data); } break; } - case PIC_TT_DICT: { + case PIC_TYPE_DICT: { kh_destroy(dict, &obj->u.dict.hash); break; } - case PIC_TT_SYMBOL: { + case PIC_TYPE_SYMBOL: { /* TODO: remove this symbol's entry from pic->syms immediately */ break; } - case PIC_TT_WEAK: { + case PIC_TYPE_WEAK: { kh_destroy(weak, &obj->u.weak.hash); break; } - case PIC_TT_PROC: { + case PIC_TYPE_PROC: { if (pic_proc_irep_p(&obj->u.proc)) { pic_irep_decref(pic, obj->u.proc.u.i.irep); } break; } - case PIC_TT_PAIR: - case PIC_TT_CXT: - case PIC_TT_PORT: - case PIC_TT_ERROR: - case PIC_TT_ID: - case PIC_TT_RECORD: - case PIC_TT_CP: + case PIC_TYPE_PAIR: + case PIC_TYPE_CXT: + case PIC_TYPE_PORT: + case PIC_TYPE_ERROR: + case PIC_TYPE_ID: + case PIC_TYPE_RECORD: + case PIC_TYPE_CP: break; - case PIC_TT_NIL: - case PIC_TT_BOOL: - case PIC_TT_FLOAT: - case PIC_TT_INT: - case PIC_TT_CHAR: - case PIC_TT_EOF: - case PIC_TT_UNDEF: - case PIC_TT_INVALID: + case PIC_TYPE_NIL: + case PIC_TYPE_TRUE: + case PIC_TYPE_FALSE: + case PIC_TYPE_FLOAT: + case PIC_TYPE_INT: + case PIC_TYPE_CHAR: + case PIC_TYPE_EOF: + case PIC_TYPE_UNDEF: + case PIC_TYPE_INVALID: pic_panic(pic, "logic flaw"); } } @@ -704,7 +706,7 @@ pic_alloca(pic_state *pic, size_t n) } 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; @@ -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.tt = tt; + obj->u.basic.tt = type; return obj; } 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; - obj = pic_obj_alloc_unsafe(pic, size, tt); + obj = pic_obj_alloc_unsafe(pic, size, type); gc_protect(pic, obj); return obj; diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index bdd3649b..6515bac7 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -36,7 +36,36 @@ extern "C" { typedef struct pic_state pic_state; -#include "picrin/type.h" +#if PIC_NAN_BOXING +# include +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); @@ -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_applyk(pic_state *, struct pic_proc *proc, int n, pic_value *argv); -int pic_int(pic_state *, pic_value); -double pic_float(pic_state *, pic_value); -char pic_char(pic_state *, pic_value); -bool pic_bool(pic_state *, pic_value); -/* const char *pic_str(pic_state *, pic_value); */ -/* unsigned char *pic_blob(pic_state *, pic_value, int *len); */ -/* void *pic_data(pic_state *, pic_value); */ +#define PIC_TYPE_INVALID 1 +#define PIC_TYPE_FLOAT 2 +#define PIC_TYPE_INT 3 +#define PIC_TYPE_CHAR 4 +#define PIC_TYPE_EOF 5 +#define PIC_TYPE_UNDEF 6 +#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_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_false_value(pic_state *); 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) -#define pic_int_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_INT) -#define pic_float_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_FLOAT) -#define pic_char_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_CHAR) -#define pic_true_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_TRUE) -#define pic_false_p(pic,v) (pic_vtype(pic,v) == PIC_VTYPE_FALSE) -#define pic_str_p(pic,v) (pic_type(pic,v) == PIC_TT_STRING) -#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) +int pic_int(pic_state *, pic_value); +double pic_float(pic_state *, pic_value); +char pic_char(pic_state *, pic_value); +bool pic_bool(pic_state *, pic_value); +/* const char *pic_str(pic_state *, pic_value); */ +/* unsigned char *pic_blob(pic_state *, pic_value, int *len); */ +/* void *pic_data(pic_state *, pic_value); */ -enum pic_tt pic_type(pic_state *, pic_value); -const char *pic_type_repr(pic_state *, enum pic_tt); +int pic_type(pic_state *, pic_value); +const char *pic_typename(pic_state *, int); bool pic_eq_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); \ } -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) \ pic_void_(PIC_GENSYM(ai), exec) diff --git a/extlib/benz/include/picrin/blob.h b/extlib/benz/include/picrin/blob.h index 2440c27f..e75051d6 100644 --- a/extlib/benz/include/picrin/blob.h +++ b/extlib/benz/include/picrin/blob.h @@ -15,7 +15,7 @@ struct pic_blob { 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); diff --git a/extlib/benz/include/picrin/data.h b/extlib/benz/include/picrin/data.h index fdd88008..6a701faa 100644 --- a/extlib/benz/include/picrin/data.h +++ b/extlib/benz/include/picrin/data.h @@ -21,7 +21,7 @@ struct pic_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) { return pic_data_p(pic, obj) && pic_data_ptr(obj)->type == type; diff --git a/extlib/benz/include/picrin/dict.h b/extlib/benz/include/picrin/dict.h index 0aaa11aa..d0ce786e 100644 --- a/extlib/benz/include/picrin/dict.h +++ b/extlib/benz/include/picrin/dict.h @@ -16,7 +16,7 @@ struct pic_dict { 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) \ pic_dict_for_each_help(sym, (&(dict)->hash), it) diff --git a/extlib/benz/include/picrin/error.h b/extlib/benz/include/picrin/error.h index 235a9d87..d09056c7 100644 --- a/extlib/benz/include/picrin/error.h +++ b/extlib/benz/include/picrin/error.h @@ -17,8 +17,8 @@ struct pic_error { struct pic_string *stack; }; -#define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TT_ERROR) -#define pic_error_ptr(v) ((struct pic_error *)pic_ptr(v)) +#define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ERROR) +#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); diff --git a/extlib/benz/include/picrin/macro.h b/extlib/benz/include/picrin/macro.h index a8fab6ea..3c2703b8 100644 --- a/extlib/benz/include/picrin/macro.h +++ b/extlib/benz/include/picrin/macro.h @@ -18,8 +18,8 @@ struct pic_env { struct pic_string *lib; }; -#define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TT_ENV) -#define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v)) +#define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ENV) +#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_env(pic_state *, struct pic_env *); diff --git a/extlib/benz/include/picrin/pair.h b/extlib/benz/include/picrin/pair.h index ddd5a706..a9ae5933 100644 --- a/extlib/benz/include/picrin/pair.h +++ b/extlib/benz/include/picrin/pair.h @@ -15,7 +15,7 @@ struct pic_pair { 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_car(pic_state *pic, pic_value obj) diff --git a/extlib/benz/include/picrin/port.h b/extlib/benz/include/picrin/port.h index 22674b33..835d1988 100644 --- a/extlib/benz/include/picrin/port.h +++ b/extlib/benz/include/picrin/port.h @@ -23,9 +23,7 @@ struct pic_port { int flags; }; -#define pic_port_ptr(v) ((struct pic_port *)pic_ptr(v)) - -pic_value pic_eof_object(); +#define pic_port_ptr(v) ((struct pic_port *)pic_obj_ptr(v)) struct pic_port *pic_open_input_string(pic_state *, const char *); struct pic_port *pic_open_output_string(pic_state *); diff --git a/extlib/benz/include/picrin/proc.h b/extlib/benz/include/picrin/proc.h index b536868e..7fcbe509 100644 --- a/extlib/benz/include/picrin/proc.h +++ b/extlib/benz/include/picrin/proc.h @@ -39,10 +39,10 @@ struct pic_proc { #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_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_ptr(o) ((struct pic_context *)pic_ptr(o)) +#define pic_context_p(o) (pic_type(pic, o) == PIC_TYPE_CXT) +#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_irep(pic_state *, struct pic_irep *, struct pic_context *); diff --git a/extlib/benz/include/picrin/record.h b/extlib/benz/include/picrin/record.h index d45cef27..0549fa90 100644 --- a/extlib/benz/include/picrin/record.h +++ b/extlib/benz/include/picrin/record.h @@ -15,8 +15,8 @@ struct pic_record { pic_value datum; }; -#define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TT_RECORD) -#define pic_rec_ptr(v) ((struct pic_record *)pic_ptr(v)) +#define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TYPE_RECORD) +#define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v)) struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value); diff --git a/extlib/benz/include/picrin/setup.h b/extlib/benz/include/picrin/setup.h index 47b97638..2fa429a7 100644 --- a/extlib/benz/include/picrin/setup.h +++ b/extlib/benz/include/picrin/setup.h @@ -5,13 +5,13 @@ #include "picrin/config.h" #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 # endif #endif #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 # endif #endif diff --git a/extlib/benz/include/picrin/string.h b/extlib/benz/include/picrin/string.h index f9b44fbc..117fc24e 100644 --- a/extlib/benz/include/picrin/string.h +++ b/extlib/benz/include/picrin/string.h @@ -17,7 +17,7 @@ struct pic_string { void pic_rope_incref(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); #define pic_make_cstr(pic, cstr) pic_make_str(pic, (cstr), strlen(cstr)) diff --git a/extlib/benz/include/picrin/symbol.h b/extlib/benz/include/picrin/symbol.h index 0d1ff11c..3104c363 100644 --- a/extlib/benz/include/picrin/symbol.h +++ b/extlib/benz/include/picrin/symbol.h @@ -23,10 +23,10 @@ struct pic_id { } 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_ptr(v) ((pic_id *)pic_ptr(v)) +#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_obj_ptr(v)) pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *); diff --git a/extlib/benz/include/picrin/type.h b/extlib/benz/include/picrin/type.h index 5e6f92d6..0f03314e 100644 --- a/extlib/benz/include/picrin/type.h +++ b/extlib/benz/include/picrin/type.h @@ -14,43 +14,25 @@ extern "C" { * 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 -#include - /** * value representation by nan-boxing: * float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF * ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP - * int : 1111111111110110 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII - * char : 1111111111111000 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC + * int : 111111111111TTTT 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII + * 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))) -static inline enum pic_vtype +PIC_INLINE int 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) { union { double f; uint64_t i; } u; @@ -58,7 +40,7 @@ pic_float(pic_state PIC_UNUSED(*pic), pic_value v) return u.f; } -static inline int +PIC_INLINE int pic_int(pic_state PIC_UNUSED(*pic), pic_value v) { union { int i; unsigned u; } u; @@ -66,28 +48,28 @@ pic_int(pic_state PIC_UNUSED(*pic), pic_value v) return u.i; } -static inline char +PIC_INLINE char pic_char(pic_state PIC_UNUSED(*pic), pic_value v) { return v & 0xfffffffful; } +PIC_INLINE struct pic_object * +pic_obj_ptr(pic_value v) +{ + return (struct pic_object *)(0xfffffffffffful & v); +} + #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) +PIC_INLINE int +pic_vtype(pic_state PIC_UNUSED(*pic), pic_value v) +{ + return (int)(v.type); +} + PIC_INLINE double 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; } +PIC_INLINE struct pic_object * +pic_obj_ptr(pic_value v) +{ + return (struct pic_object *)(v.u.data); +} + #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 \ - enum pic_tt tt; \ + unsigned char tt; \ char gc_mark; struct pic_basic { PIC_OBJECT_HEADER }; -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; - -/* 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_obj_p(pic,v) (pic_vtype(pic,v) == PIC_IVAL_END) +#define pic_invalid_p(pic, v) (pic_vtype(pic, v) == PIC_TYPE_INVALID) #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; } -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_nil_value(pic_state PIC_UNUSED(*pic)) { 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; } @@ -279,7 +138,7 @@ pic_true_value(pic_state PIC_UNUSED(*pic)) { pic_value v; - pic_init_value(v, PIC_VTYPE_TRUE); + pic_init_value(v, PIC_TYPE_TRUE); return v; } @@ -288,7 +147,7 @@ pic_false_value(pic_state PIC_UNUSED(*pic)) { pic_value v; - pic_init_value(v, PIC_VTYPE_FALSE); + pic_init_value(v, PIC_TYPE_FALSE); return v; } @@ -297,7 +156,25 @@ pic_bool_value(pic_state PIC_UNUSED(*pic), bool b) { 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; } @@ -308,7 +185,7 @@ pic_obj_value(void *ptr) { pic_value v; - pic_init_value(v, PIC_VTYPE_HEAP); + pic_init_value(v, PIC_IVAL_END); v |= 0xfffffffffffful & (uint64_t)ptr; return v; } @@ -329,13 +206,10 @@ pic_float_value(pic_state PIC_UNUSED(*pic), double f) PIC_INLINE pic_value pic_int_value(pic_state PIC_UNUSED(*pic), int i) { - union { int i; unsigned u; } u; pic_value v; - u.i = i; - - pic_init_value(v, PIC_VTYPE_INT); - v |= u.u; + pic_init_value(v, PIC_TYPE_INT); + v |= (unsigned)i; return v; } @@ -344,8 +218,8 @@ pic_char_value(pic_state PIC_UNUSED(*pic), char c) { pic_value v; - pic_init_value(v, PIC_VTYPE_CHAR); - v |= c; + pic_init_value(v, PIC_TYPE_CHAR); + v |= (unsigned char)c; return v; } @@ -356,7 +230,7 @@ pic_obj_value(void *ptr) { pic_value v; - pic_init_value(v, PIC_VTYPE_HEAP); + pic_init_value(v, PIC_IVAL_END); v.u.data = ptr; return v; } @@ -366,7 +240,7 @@ pic_float_value(pic_state PIC_UNUSED(*pic), double f) { pic_value v; - pic_init_value(v, PIC_VTYPE_FLOAT); + pic_init_value(v, PIC_TYPE_FLOAT); v.u.f = f; return v; } @@ -376,7 +250,7 @@ pic_int_value(pic_state PIC_UNUSED(*pic), int i) { pic_value v; - pic_init_value(v, PIC_VTYPE_INT); + pic_init_value(v, PIC_TYPE_INT); v.u.i = i; return v; } @@ -386,95 +260,13 @@ pic_char_value(pic_state PIC_UNUSED(*pic), char c) { pic_value v; - pic_init_value(v, PIC_VTYPE_CHAR); + pic_init_value(v, PIC_TYPE_CHAR); v.u.c = c; return v; } #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) } #endif diff --git a/extlib/benz/include/picrin/vector.h b/extlib/benz/include/picrin/vector.h index e3ac6fd0..bb5ddad1 100644 --- a/extlib/benz/include/picrin/vector.h +++ b/extlib/benz/include/picrin/vector.h @@ -15,7 +15,7 @@ struct pic_vector { 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) } diff --git a/extlib/benz/include/picrin/weak.h b/extlib/benz/include/picrin/weak.h index 1b502365..914865b8 100644 --- a/extlib/benz/include/picrin/weak.h +++ b/extlib/benz/include/picrin/weak.h @@ -17,7 +17,7 @@ struct pic_weak { 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) } diff --git a/extlib/benz/macro.c b/extlib/benz/macro.c index 176c39bf..1df08a07 100644 --- a/extlib/benz/macro.c +++ b/extlib/benz/macro.c @@ -13,7 +13,7 @@ pic_make_env(pic_state *pic, struct pic_env *up) 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->lib = NULL; kh_init(env, &env->map); @@ -25,7 +25,7 @@ pic_make_topenv(pic_state *pic, struct pic_string *lib) { 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->lib = lib; 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) { switch (pic_type(pic, expr)) { - case PIC_TT_ID: - case PIC_TT_SYMBOL: { + case PIC_TYPE_ID: + case PIC_TYPE_SYMBOL: { return expand_var(pic, pic_id_ptr(expr), env, deferred); } - case PIC_TT_PAIR: { + case PIC_TYPE_PAIR: { struct pic_proc *mac; if (! pic_list_p(pic, expr)) { diff --git a/extlib/benz/pair.c b/extlib/benz/pair.c index 80c95121..a853440c 100644 --- a/extlib/benz/pair.c +++ b/extlib/benz/pair.c @@ -9,7 +9,7 @@ pic_cons(pic_state *pic, pic_value car, pic_value cdr) { 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->cdr = cdr; diff --git a/extlib/benz/port.c b/extlib/benz/port.c index 84b27e40..4ad2251c 100644 --- a/extlib/benz/port.c +++ b/extlib/benz/port.c @@ -4,16 +4,6 @@ #include "picrin.h" -pic_value -pic_eof_object() -{ - pic_value v; - - pic_init_value(v, PIC_VTYPE_EOF); - - return v; -} - static pic_value 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))); } - 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->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; - 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->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; - 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->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; - 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->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, ""); - return pic_eof_object(); + return pic_eof_object(pic); } static pic_value @@ -516,7 +506,7 @@ pic_port_open_input_blob(pic_state *pic) 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->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, ""); - 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->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"); if ((c = xfgetc(pic, port->file)) == EOF) { - return pic_eof_object(); + return pic_eof_object(pic); } else { 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"); if ((c = xfgetc(pic, port->file)) == EOF) { - return pic_eof_object(); + return pic_eof_object(pic); } else { xungetc(c, port->file); @@ -605,7 +595,7 @@ pic_port_read_line(pic_state *pic) int c; struct pic_port *port = pic_stdin(pic), *buf; struct pic_string *str; - pic_value res = pic_eof_object(); + pic_value res = pic_eof_object(pic); pic_get_args(pic, "|p", &port); @@ -644,7 +634,7 @@ pic_port_read_string(pic_state *pic){ struct pic_string *str; int k, i; int c; - pic_value res = pic_eof_object(); + pic_value res = pic_eof_object(pic); 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"); if ((c = xfgetc(pic, port->file)) == EOF) { - return pic_eof_object(); + return pic_eof_object(pic); } return pic_int_value(pic, c); @@ -695,7 +685,7 @@ pic_port_peek_byte(pic_state *pic) c = xfgetc(pic, port->file); if (c == EOF) { - return pic_eof_object(); + return pic_eof_object(pic); } else { 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); if (i == 0) { - return pic_eof_object(); + return pic_eof_object(pic); } else { pic_realloc(pic, blob->data, i); @@ -772,7 +762,7 @@ pic_port_read_blob_ip(pic_state *pic) pic_free(pic, buf); if (i == 0) { - return pic_eof_object(); + return pic_eof_object(pic); } else { return pic_int_value(pic, i); diff --git a/extlib/benz/proc.c b/extlib/benz/proc.c index 699474d4..0430c661 100644 --- a/extlib/benz/proc.c +++ b/extlib/benz/proc.c @@ -107,11 +107,11 @@ pic_get_args(pic_state *pic, const char *format, ...) \ v = GET_OPERAND(pic, i); \ switch (pic_type(pic, v)) { \ - case PIC_TT_FLOAT: \ + case PIC_TYPE_FLOAT: \ *n = pic_float(pic, v); \ *e = false; \ break; \ - case PIC_TT_INT: \ + case PIC_TYPE_INT: \ *n = pic_int(pic, v); \ *e = true; \ break; \ @@ -195,7 +195,7 @@ vm_push_cxt(pic_state *pic) { 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->regc = ci->regc; ci->cxt->regs = ci->regs; @@ -321,6 +321,17 @@ pic_vm_tear_off(pic_state *pic) # define VM_CALL_PRINT #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_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; } CASE(OP_PUSHEOF) { - PUSH(pic_eof_object()); + PUSH(pic_eof_object(pic)); NEXT; } 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; 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->u.f.func = func; 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; - 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->u.i.irep = irep; proc->u.i.cxt = cxt; diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 3819d9e5..59aee417 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -838,7 +838,7 @@ pic_read(pic_state *pic, struct pic_port *port) pic_gc_arena_restore(pic, ai); } if (c == EOF) { - return pic_eof_object(); + return pic_eof_object(pic); } pic_gc_arena_restore(pic, ai); diff --git a/extlib/benz/record.c b/extlib/benz/record.c index ded83ab2..c338989a 100644 --- a/extlib/benz/record.c +++ b/extlib/benz/record.c @@ -9,7 +9,7 @@ pic_make_rec(pic_state *pic, pic_value type, pic_value datum) { 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->datum = datum; diff --git a/extlib/benz/state.c b/extlib/benz/state.c index 917bd59f..a6e0ee97 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -334,7 +334,7 @@ pic_open(pic_allocf allocf, void *userdata) pic->macros = pic_make_weak(pic); /* 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->depth = 0; pic->cp->in = pic->cp->out = NULL; diff --git a/extlib/benz/string.c b/extlib/benz/string.c index bd0ac8b4..e29ffb32 100644 --- a/extlib/benz/string.c +++ b/extlib/benz/string.c @@ -98,7 +98,7 @@ pic_make_string(pic_state *pic, struct pic_rope *rope) { 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 */ return str; } diff --git a/extlib/benz/symbol.c b/extlib/benz/symbol.c index 0e185dec..51e9cfbc 100644 --- a/extlib/benz/symbol.c +++ b/extlib/benz/symbol.c @@ -26,7 +26,7 @@ pic_intern(pic_state *pic, struct pic_string *str) 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; 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; - 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.env = env; return nid; diff --git a/extlib/benz/value.c b/extlib/benz/value.c new file mode 100644 index 00000000..e0857dfb --- /dev/null +++ b/extlib/benz/value.c @@ -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); + } +} diff --git a/extlib/benz/vector.c b/extlib/benz/vector.c index af273b9b..1aa87e76 100644 --- a/extlib/benz/vector.c +++ b/extlib/benz/vector.c @@ -10,7 +10,7 @@ pic_make_vec(pic_state *pic, int len) struct pic_vector *vec; 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->data = (pic_value *)pic_malloc(pic, sizeof(pic_value) * len); for (i = 0; i < len; ++i) { diff --git a/extlib/benz/weak.c b/extlib/benz/weak.c index 6dda9cd8..484bcbd8 100644 --- a/extlib/benz/weak.c +++ b/extlib/benz/weak.c @@ -11,7 +11,7 @@ pic_make_weak(pic_state *pic) { 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; kh_init(weak, &weak->hash); diff --git a/extlib/benz/write.c b/extlib/benz/write.c index 4cd4da89..426f9804 100644 --- a/extlib/benz/write.c +++ b/extlib/benz/write.c @@ -134,10 +134,10 @@ write_pair_help(struct writer_control *p, struct pic_pair *pair) else if (pic_pair_p(pic, pair->cdr)) { /* 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, " . "); - kh_put(v, vh, pic_ptr(pair->cdr), &ret); + kh_put(v, vh, pic_obj_ptr(pair->cdr), &ret); if (ret == 0) { /* if exists */ xfprintf(pic, p->file, "#%d#", kh_val(lh, it)); 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)); if (p->op == OP_WRITE) { - if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) { - it = kh_get(v, vh, pic_ptr(pair->cdr)); + 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_obj_ptr(pair->cdr)); kh_del(v, vh, it); } } @@ -263,8 +263,8 @@ write_core(struct writer_control *p, pic_value obj) int ret; /* shared objects */ - if (pic_obj_p(pic, obj) && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) { - kh_put(v, vh, pic_ptr(obj), &ret); + 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_obj_ptr(obj), &ret); if (ret == 0) { /* if exists */ xfprintf(pic, file, "#%d#", kh_val(lh, it)); return; @@ -273,56 +273,59 @@ write_core(struct writer_control *p, pic_value obj) } switch (pic_type(pic, obj)) { - case PIC_TT_UNDEF: + case PIC_TYPE_UNDEF: xfprintf(pic, file, "#undefined"); break; - case PIC_TT_NIL: + case PIC_TYPE_NIL: xfprintf(pic, file, "()"); break; - case PIC_TT_BOOL: - xfprintf(pic, file, pic_true_p(pic, obj) ? "#t" : "#f"); + case PIC_TYPE_TRUE: + xfprintf(pic, file, "#t"); break; - case PIC_TT_ID: + case PIC_TYPE_FALSE: + xfprintf(pic, file, "#f"); + break; + case PIC_TYPE_ID: xfprintf(pic, file, "#", pic_identifier_name(pic, pic_id_ptr(obj))); break; - case PIC_TT_EOF: + case PIC_TYPE_EOF: xfprintf(pic, file, "#.(eof-object)"); break; - case PIC_TT_INT: + case PIC_TYPE_INT: xfprintf(pic, file, "%d", pic_int(pic, obj)); break; - case PIC_TT_FLOAT: + case PIC_TYPE_FLOAT: write_float(pic, pic_float(pic, obj), file); break; - case PIC_TT_SYMBOL: + case PIC_TYPE_SYMBOL: xfprintf(pic, file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj))); break; - case PIC_TT_BLOB: + case PIC_TYPE_BLOB: write_blob(pic, pic_blob_ptr(obj), file); break; - case PIC_TT_CHAR: + case PIC_TYPE_CHAR: write_char(pic, pic_char(pic, obj), file, p->mode); break; - case PIC_TT_STRING: + case PIC_TYPE_STRING: write_str(pic, pic_str_ptr(obj), file, p->mode); break; - case PIC_TT_PAIR: + case PIC_TYPE_PAIR: write_pair(p, pic_pair_ptr(obj)); break; - case PIC_TT_VECTOR: + case PIC_TYPE_VECTOR: write_vec(p, pic_vec_ptr(obj)); break; - case PIC_TT_DICT: + case PIC_TYPE_DICT: write_dict(p, pic_dict_ptr(obj)); break; 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; } 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) { - it = kh_get(v, vh, pic_ptr(obj)); + 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_obj_ptr(obj)); kh_del(v, vh, it); } } @@ -338,14 +341,14 @@ traverse(struct writer_control *p, pic_value obj) } switch (pic_type(pic, obj)) { - case PIC_TT_PAIR: - case PIC_TT_VECTOR: - case PIC_TT_DICT: { + case PIC_TYPE_PAIR: + case PIC_TYPE_VECTOR: + case PIC_TYPE_DICT: { khash_t(l) *h = &p->labels; khiter_t it; int ret; - it = kh_put(l, h, pic_ptr(obj), &ret); + it = kh_put(l, h, pic_obj_ptr(obj), &ret); if (ret != 0) { /* first time */ kh_val(h, it) = -1; @@ -369,7 +372,7 @@ traverse(struct writer_control *p, pic_value obj) } 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) { kh_del(l, h, it); }