Merge branch 'closure-attribute'. close #124

include/picrin/dict.h

@@ -17,6 +17,8 @@ struct pic_dict {
 #define pic_dict_p(v) (pic_type(v) == PIC_TT_DICT)
 #define pic_dict_ptr(v) ((struct pic_dict *)pic_ptr(v))
 
+struct pic_dict *pic_dict_new(pic_state *);
+
 #if defined(__cplusplus)
 }
 #endif

include/picrin/proc.h

@@ -31,6 +31,7 @@ struct pic_proc {
     struct pic_irep *irep;
   } u;
   struct pic_env *env;
+  struct pic_dict *attr;
 };
 
 #define PIC_PROC_KIND_FUNC 1
@@ -50,6 +51,8 @@ struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_en
 
 pic_sym pic_proc_name(struct pic_proc *);
 
+struct pic_dict *pic_proc_attr(pic_state *, struct pic_proc *);
+
 /* closed variables accessor */
 void pic_proc_cv_init(pic_state *, struct pic_proc *, size_t);
 int pic_proc_cv_size(pic_state *, struct pic_proc *);

src/dict.c

@@ -5,6 +5,17 @@
 #include "picrin.h"
 #include "picrin/dict.h"
 
+struct pic_dict *
+pic_dict_new(pic_state *pic)
+{
+  struct pic_dict *dict;
+
+  dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
+  xh_init_int(&dict->hash, sizeof(pic_value));
+
+  return dict;
+}
+
 static pic_value
 pic_dict_dict(pic_state *pic)
 {
@@ -12,9 +23,7 @@ pic_dict_dict(pic_state *pic)
 
   pic_get_args(pic, "");
 
-  dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
-
-  xh_init_int(&dict->hash, sizeof(pic_value));
+  dict = pic_dict_new(pic);
 
   return pic_obj_value(dict);
 }

src/gc.c

@@ -381,6 +381,9 @@ 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);
     }

src/proc.c

@@ -6,6 +6,7 @@
 #include "picrin/pair.h"
 #include "picrin/proc.h"
 #include "picrin/irep.h"
+#include "picrin/dict.h"
 
 struct pic_proc *
 pic_proc_new(pic_state *pic, pic_func_t func, const char *name)
@@ -19,6 +20,7 @@ pic_proc_new(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;
 }
 
@@ -31,6 +33,7 @@ pic_proc_new_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;
 }
 
@@ -46,6 +49,15 @@ pic_proc_name(struct pic_proc *proc)
   UNREACHABLE();
 }
 
+struct pic_dict *
+pic_proc_attr(pic_state *pic, struct pic_proc *proc)
+{
+  if (proc->attr == NULL) {
+    proc->attr = pic_dict_new(pic);
+  }
+  return proc->attr;
+}
+
 void
 pic_proc_cv_init(pic_state *pic, struct pic_proc *proc, size_t cv_size)
 {
@@ -206,6 +218,16 @@ pic_proc_for_each(pic_state *pic)
   return pic_none_value();
 }
 
+static pic_value
+pic_proc_attribute(pic_state *pic)
+{
+  struct pic_proc *proc;
+
+  pic_get_args(pic, "l", &proc);
+
+  return pic_obj_value(pic_proc_attr(pic, proc));
+}
+
 void
 pic_init_proc(pic_state *pic)
 {
@@ -213,4 +235,8 @@ pic_init_proc(pic_state *pic)
   pic_defun(pic, "apply", pic_proc_apply);
   pic_defun(pic, "map", pic_proc_map);
   pic_defun(pic, "for-each", pic_proc_for_each);
+
+  pic_deflibrary ("(picrin attribute)") {
+    pic_defun(pic, "attribute", pic_proc_attribute);
+  }
 }