generalized attribute
This commit is contained in:
parent
6fc8341f50
commit
77d4196b06
|
@ -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
4
cont.c
|
@ -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;
|
||||
}
|
||||
|
|
8
error.c
8
error.c
|
@ -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
11
gc.c
|
@ -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
|
||||
|
|
|
@ -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 *);
|
||||
|
|
|
@ -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
2
init.c
|
@ -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
36
proc.c
|
@ -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);
|
||||
}
|
||||
|
|
6
state.c
6
state.c
|
@ -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
10
var.c
|
@ -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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue