generalized attribute

This commit is contained in:
Yuichi Nishiwaki 2014-09-25 09:44:21 +09:00
parent 6fc8341f50
commit 77d4196b06
10 changed files with 81 additions and 56 deletions

50
attr.c Normal file
View File

@ -0,0 +1,50 @@
#include "picrin.h"
#include "picrin/dict.h"
struct pic_dict *
pic_attr(pic_state *pic, pic_value obj)
{
xh_entry *e;
if (pic_vtype(obj) != PIC_VTYPE_HEAP) {
pic_errorf(pic, "attribute: expected heap object, but got immediate value ~s", obj);
}
e = xh_get_ptr(&pic->attrs, pic_ptr(obj));
if (e == NULL) {
struct pic_dict *dict = pic_make_dict(pic);
e = xh_put_ptr(&pic->attrs, pic_ptr(obj), &dict);
assert(dict == xh_val(e, struct pic_dict *));
}
return xh_val(e, struct pic_dict *);
}
pic_value
pic_attr_ref(pic_state *pic, pic_value obj, const char *key)
{
return pic_dict_ref(pic, pic_attr(pic, obj), pic_sym_value(pic_intern_cstr(pic, key)));
}
void
pic_attr_set(pic_state *pic, pic_value obj, const char *key, pic_value v)
{
pic_dict_set(pic, pic_attr(pic, obj), pic_sym_value(pic_intern_cstr(pic, key)), v);
}
static pic_value
pic_attr_attribute(pic_state *pic)
{
pic_value obj;
pic_get_args(pic, "o", &obj);
return pic_obj_value(pic_attr(pic, obj));
}
void
pic_init_attr(pic_state *pic)
{
pic_defun(pic, "attribute", pic_attr_attribute);
}

4
cont.c
View File

@ -102,7 +102,7 @@ escape_call(pic_state *pic)
pic_get_args(pic, "*", &argc, &argv);
e = pic_data_ptr(pic_attr_ref(pic, pic_get_proc(pic), "@@escape"));
e = pic_data_ptr(pic_attr_ref(pic, pic_obj_value(pic_get_proc(pic)), "@@escape"));
pic_load_point(pic, e->data);
@ -121,7 +121,7 @@ pic_make_econt(pic_state *pic, struct pic_escape *escape)
e = pic_data_alloc(pic, &escape_type, escape);
/* save the escape continuation in proc */
pic_attr_set(pic, cont, "@@escape", pic_obj_value(e));
pic_attr_set(pic, pic_obj_value(cont), "@@escape", pic_obj_value(e));
return cont;
}

View File

@ -79,7 +79,7 @@ native_exception_handler(pic_state *pic)
pic->err = err;
cont = pic_proc_ptr(pic_attr_ref(pic, pic_get_proc(pic), "@@escape"));
cont = pic_proc_ptr(pic_attr_ref(pic, pic_obj_value(pic_get_proc(pic)), "@@escape"));
pic_apply1(pic, cont, pic_false_value());
@ -96,7 +96,7 @@ pic_push_try(pic_state *pic, struct pic_escape *escape)
handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)");
pic_attr_set(pic, handler, "@@escape", pic_obj_value(cont));
pic_attr_set(pic, pic_obj_value(handler), "@@escape", pic_obj_value(cont));
if (pic->xp >= pic->xpend) {
xp_len = (pic->xpend - pic->xpbase) * 2;
@ -116,11 +116,11 @@ pic_pop_try(pic_state *pic)
assert(pic->xp > pic->xpbase);
cont = pic_attr_ref(pic, *--pic->xp, "@@escape");
cont = pic_attr_ref(pic, pic_obj_value(*--pic->xp), "@@escape");
assert(pic_proc_p(cont));
escape = pic_attr_ref(pic, pic_proc_ptr(cont), "@@escape");
escape = pic_attr_ref(pic, cont, "@@escape");
assert(pic_data_p(escape));

11
gc.c
View File

@ -381,9 +381,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
if (proc->env) {
gc_mark_object(pic, (struct pic_object *)proc->env);
}
if (proc->attr) {
gc_mark_object(pic, (struct pic_object *)proc->attr);
}
if (pic_proc_irep_p(proc)) {
gc_mark_object(pic, (struct pic_object *)proc->u.irep);
}
@ -562,7 +559,7 @@ gc_mark_phase(pic_state *pic)
}
/* macro objects */
for (it = xh_begin(&pic->macros); it != NULL; it = xh_next(it)) {
for (it = xh_begin(&pic->macros); it != NULL; it = xh_next(it)) {
gc_mark_object(pic, xh_val(it, struct pic_object *));
}
@ -588,6 +585,12 @@ gc_mark_phase(pic_state *pic)
if (pic->xSTDERR) {
gc_mark_object(pic, (struct pic_object *)pic->xSTDERR);
}
/* attributes */
for (it = xh_begin(&pic->attrs); it != NULL; it = xh_next(it)) {
gc_mark_object(pic, xh_key(it, struct pic_object *));
gc_mark_object(pic, (struct pic_object *)xh_val(it, struct pic_dict *));
}
}
static void

View File

@ -111,6 +111,7 @@ typedef struct {
xhash globals;
xhash macros;
pic_value libs;
xhash attrs;
struct pic_reader *reader;
@ -224,6 +225,10 @@ static inline void pic_warn(pic_state *pic, const char *msg)
pic_warnf(pic, msg);
}
struct pic_dict *pic_attr(pic_state *, pic_value);
pic_value pic_attr_ref(pic_state *, pic_value, const char *);
void pic_attr_set(pic_state *, pic_value, const char *, pic_value);
struct pic_port *pic_stdin(pic_state *);
struct pic_port *pic_stdout(pic_state *);
struct pic_port *pic_stderr(pic_state *);

View File

@ -31,7 +31,6 @@ struct pic_proc {
struct pic_irep *irep;
} u;
struct pic_env *env;
struct pic_dict *attr;
};
#define PIC_PROC_KIND_FUNC 1
@ -51,10 +50,6 @@ struct pic_proc *pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_e
pic_sym pic_proc_name(struct pic_proc *);
struct pic_dict *pic_attr(pic_state *, struct pic_proc *);
pic_value pic_attr_ref(pic_state *, struct pic_proc *, const char *);
void pic_attr_set(pic_state *, struct pic_proc *, const char *, pic_value);
#if defined(__cplusplus)
}
#endif

2
init.c
View File

@ -38,6 +38,7 @@ void pic_init_dict(pic_state *);
void pic_init_record(pic_state *);
void pic_init_eval(pic_state *);
void pic_init_lib(pic_state *);
void pic_init_attr(pic_state *);
extern const char pic_boot[];
@ -138,6 +139,7 @@ pic_init_core(pic_state *pic)
pic_init_record(pic); DONE;
pic_init_eval(pic); DONE;
pic_init_lib(pic); DONE;
pic_init_attr(pic); DONE;
pic_load_cstr(pic, pic_boot);
}

36
proc.c
View File

@ -6,7 +6,6 @@
#include "picrin/pair.h"
#include "picrin/proc.h"
#include "picrin/irep.h"
#include "picrin/dict.h"
struct pic_proc *
pic_make_proc(pic_state *pic, pic_func_t func, const char *name)
@ -20,7 +19,6 @@ pic_make_proc(pic_state *pic, pic_func_t func, const char *name)
proc->u.func.f = func;
proc->u.func.name = pic_intern_cstr(pic, name);
proc->env = NULL;
proc->attr = NULL;
return proc;
}
@ -33,7 +31,6 @@ pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_env *env)
proc->kind = PIC_PROC_KIND_IREP;
proc->u.irep = irep;
proc->env = env;
proc->attr = NULL;
return proc;
}
@ -49,27 +46,6 @@ pic_proc_name(struct pic_proc *proc)
UNREACHABLE();
}
struct pic_dict *
pic_attr(pic_state *pic, struct pic_proc *proc)
{
if (proc->attr == NULL) {
proc->attr = pic_make_dict(pic);
}
return proc->attr;
}
pic_value
pic_attr_ref(pic_state *pic, struct pic_proc *proc, const char *key)
{
return pic_dict_ref(pic, pic_attr(pic, proc), pic_sym_value(pic_intern_cstr(pic, key)));
}
void
pic_attr_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value v)
{
pic_dict_set(pic, pic_attr(pic, proc), pic_sym_value(pic_intern_cstr(pic, key)), v);
}
static pic_value
pic_proc_proc_p(pic_state *pic)
{
@ -102,21 +78,9 @@ pic_proc_apply(pic_state *pic)
return pic_apply_trampoline(pic, proc, arg_list);
}
static pic_value
pic_proc_attribute(pic_state *pic)
{
struct pic_proc *proc;
pic_get_args(pic, "l", &proc);
return pic_obj_value(pic_attr(pic, proc));
}
void
pic_init_proc(pic_state *pic)
{
pic_defun(pic, "procedure?", pic_proc_proc_p);
pic_defun(pic, "apply", pic_proc_apply);
pic_defun(pic, "attribute", pic_proc_attribute);
}

View File

@ -61,6 +61,9 @@ pic_open(int argc, char *argv[], char **envp)
/* macros */
xh_init_int(&pic->macros, sizeof(struct pic_macro *));
/* attributes */
xh_init_ptr(&pic->attrs, sizeof(struct pic_dict *));
/* features */
pic->features = pic_nil_value();
@ -195,7 +198,9 @@ pic_close(pic_state *pic)
pic->xp = pic->xpbase;
pic->arena_idx = 0;
pic->err = pic_undef_value();
xh_clear(&pic->globals);
xh_clear(&pic->macros);
xh_clear(&pic->attrs);
pic->features = pic_nil_value();
pic->libs = pic_nil_value();
@ -219,6 +224,7 @@ pic_close(pic_state *pic)
xh_destroy(&pic->syms);
xh_destroy(&pic->globals);
xh_destroy(&pic->macros);
xh_destroy(&pic->attrs);
/* free GC arena */
free(pic->arena);

10
var.c
View File

@ -43,7 +43,7 @@ var_call(pic_state *pic)
box = var_lookup(pic, pic_obj_value(self));
if (! pic_test(box)) {
box = pic_attr_ref(pic, self, "@@box");
box = pic_attr_ref(pic, pic_obj_value(self), "@@box");
}
switch (n) {
@ -51,7 +51,7 @@ var_call(pic_state *pic)
return pic_car(pic, box);
case 1:
conv = pic_attr_ref(pic, self, "@@converter");
conv = pic_attr_ref(pic, pic_obj_value(self), "@@converter");
if (pic_test(conv)) {
pic_assert_type(pic, conv, proc);
@ -64,7 +64,7 @@ var_call(pic_state *pic)
case 2:
assert(pic_false_p(tmp));
conv = pic_attr_ref(pic, self, "@@converter");
conv = pic_attr_ref(pic, pic_obj_value(self), "@@converter");
if (pic_test(conv)) {
pic_assert_type(pic, conv, proc);
@ -82,8 +82,8 @@ pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv)
struct pic_proc *var;
var = pic_make_proc(pic, var_call, "<var-call>");
pic_attr_set(pic, var, "@@box", pic_list1(pic, init));
pic_attr_set(pic, var, "@@converter", conv ? pic_obj_value(conv) : pic_false_value());
pic_attr_set(pic, pic_obj_value(var), "@@box", pic_list1(pic, init));
pic_attr_set(pic, pic_obj_value(var), "@@converter", conv ? pic_obj_value(conv) : pic_false_value());
return var;
}