attribute as a macro

This commit is contained in:
Yuichi Nishiwaki 2016-02-03 21:49:55 +09:00
parent 0fe20178ae
commit 337ba027f2
6 changed files with 15 additions and 65 deletions

View File

@ -0,0 +1,13 @@
(define-library (picrin base)
(define attribute-table (make-register))
(define (attribute obj)
(let ((r (attribute-table obj)))
(if r
(cdr r)
(let ((dict (make-dictionary)))
(attribute-table obj dict)
dict))))
(export attribute))

View File

@ -0,0 +1,2 @@
CONTRIB_LIBS += \
contrib/10.attribute/attr.scm

View File

@ -1,48 +0,0 @@
#include "picrin.h"
struct pic_dict *
pic_attr(pic_state *pic, pic_value obj)
{
struct pic_dict *dict;
if (! pic_obj_p(obj)) {
pic_errorf(pic, "attribute: expected heap object, but got immediate value ~s", obj);
}
if (! pic_reg_has(pic, pic->attrs, pic_ptr(obj))) {
dict = pic_make_dict(pic);
pic_reg_set(pic, pic->attrs, pic_ptr(obj), pic_obj_value(dict));
return dict;
}
return pic_dict_ptr(pic_reg_ref(pic, pic->attrs, pic_ptr(obj)));
}
pic_value
pic_attr_ref(pic_state *pic, pic_value obj, const char *key)
{
return pic_dict_ref(pic, pic_attr(pic, obj), pic_intern(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_intern(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);
}

View File

@ -500,11 +500,6 @@ gc_mark_phase(pic_state *pic)
gc_mark_object(pic, (struct pic_object *)pic->macros); gc_mark_object(pic, (struct pic_object *)pic->macros);
} }
/* attribute table */
if (pic->attrs) {
gc_mark_object(pic, (struct pic_object *)pic->attrs);
}
/* error object */ /* error object */
gc_mark(pic, pic->err); gc_mark(pic, pic->err);

View File

@ -122,7 +122,6 @@ struct pic_state {
struct pic_reg *globals; struct pic_reg *globals;
struct pic_reg *macros; struct pic_reg *macros;
pic_value libs; pic_value libs;
struct pic_reg *attrs;
pic_reader reader; pic_reader reader;
xFILE files[XOPEN_MAX]; xFILE files[XOPEN_MAX];
@ -235,10 +234,6 @@ void pic_warnf(pic_state *, const char *, ...);
pic_str *pic_get_backtrace(pic_state *); pic_str *pic_get_backtrace(pic_state *);
void pic_print_backtrace(pic_state *, xFILE *); void pic_print_backtrace(pic_state *, xFILE *);
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_stdin(pic_state *);
struct pic_port *pic_stdout(pic_state *); struct pic_port *pic_stdout(pic_state *);
struct pic_port *pic_stderr(pic_state *); struct pic_port *pic_stderr(pic_state *);

View File

@ -38,7 +38,6 @@ void pic_init_dict(pic_state *);
void pic_init_record(pic_state *); void pic_init_record(pic_state *);
void pic_init_eval(pic_state *); void pic_init_eval(pic_state *);
void pic_init_lib(pic_state *); void pic_init_lib(pic_state *);
void pic_init_attr(pic_state *);
void pic_init_reg(pic_state *); void pic_init_reg(pic_state *);
extern const char pic_boot[][80]; extern const char pic_boot[][80];
@ -180,7 +179,6 @@ pic_init_core(pic_state *pic)
pic_init_record(pic); DONE; pic_init_record(pic); DONE;
pic_init_eval(pic); DONE; pic_init_eval(pic); DONE;
pic_init_lib(pic); DONE; pic_init_lib(pic); DONE;
pic_init_attr(pic); DONE;
pic_init_reg(pic); DONE; pic_init_reg(pic); DONE;
VM3(CONS); VM3(CONS);
@ -311,9 +309,6 @@ pic_open(pic_allocf allocf, void *userdata)
/* macros */ /* macros */
pic->macros = NULL; pic->macros = NULL;
/* attributes */
pic->attrs = NULL;
/* features */ /* features */
pic->features = pic_nil_value(); pic->features = pic_nil_value();
@ -404,7 +399,6 @@ pic_open(pic_allocf allocf, void *userdata)
/* root tables */ /* root tables */
pic->globals = pic_make_reg(pic); pic->globals = pic_make_reg(pic);
pic->macros = pic_make_reg(pic); pic->macros = pic_make_reg(pic);
pic->attrs = pic_make_reg(pic);
/* root block */ /* root block */
pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TT_CP); pic->cp = (pic_checkpoint *)pic_obj_alloc(pic, sizeof(pic_checkpoint), PIC_TT_CP);
@ -478,7 +472,6 @@ pic_close(pic_state *pic)
pic->err = pic_invalid_value(); pic->err = pic_invalid_value();
pic->globals = NULL; pic->globals = NULL;
pic->macros = NULL; pic->macros = NULL;
pic->attrs = NULL;
pic->features = pic_nil_value(); pic->features = pic_nil_value();
pic->libs = pic_nil_value(); pic->libs = pic_nil_value();