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);
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:

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

@ -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

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;
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;

2
extlib/benz/blob.c
View File

@ -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;

66
extlib/benz/bool.c
View File

@ -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:

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;
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;

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;
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;

2
extlib/benz/dict.c
View File

@ -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;

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);
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;

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)
{
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);

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
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;

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

@ -36,7 +36,36 @@ extern "C" {
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);
@ -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)

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

@ -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);

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

@ -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;

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

@ -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)

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

@ -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);

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

@ -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 *);

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

@ -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)

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

@ -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 *);

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_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 *);

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

@ -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);

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

@ -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

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_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))

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

@ -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 *);

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

@ -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 <stdint.h>
/**
* 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

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

@ -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)
}

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

@ -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)
}

10
extlib/benz/macro.c
View File

@ -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)) {

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;
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;

40
extlib/benz/port.c
View File

@ -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);

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); \
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;

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);
}
if (c == EOF) {
return pic_eof_object();
return pic_eof_object(pic);
}
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;
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;

2
extlib/benz/state.c
View File

@ -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;

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;
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;
}

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 */
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;

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;
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) {

2
extlib/benz/weak.c
View File

@ -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);

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)) {
/* 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, "#<identifier %s>", 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);
}