record cfunc procedure names

include/picrin/proc.h

@@ -45,7 +45,7 @@ struct pic_proc {
 #define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o))
 #define pic_env_ptr(o) ((struct pic_env *)pic_ptr(o))
 
-struct pic_proc *pic_proc_new(pic_state *, pic_func_t);
+struct pic_proc *pic_proc_new(pic_state *, pic_func_t, const char *);
 struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_env *);
 
 /* closed variables accessor */

src/cont.c

@@ -219,7 +219,7 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
   else {
     struct pic_proc *c;
 
-    c = pic_proc_new(pic, cont_call);
+    c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
 
     /* save the continuation object in proc */
     pic_proc_cv_init(pic, c, 1);
@@ -241,7 +241,7 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
   else {
     struct pic_proc *c;
 
-    c = pic_proc_new(pic, cont_call);
+    c = pic_proc_new(pic, cont_call, "<continuation-procedure>");
 
     /* save the continuation object in proc */
     pic_proc_cv_init(pic, c, 1);

src/macro.c

@@ -764,12 +764,12 @@ er_macro_call(pic_state *pic)
     pic_error(pic, "unexpected type of argument 3");
   }
 
-  rename = pic_proc_new(pic, er_macro_rename);
+  rename = pic_proc_new(pic, er_macro_rename, "<er-macro-renamer>");
   pic_proc_cv_init(pic, rename, 2);
   pic_proc_cv_set(pic, rename, 0, use_env);
   pic_proc_cv_set(pic, rename, 1, mac_env);
 
-  compare = pic_proc_new(pic, er_macro_compare);
+  compare = pic_proc_new(pic, er_macro_compare, "<er-macro-comparator>");
   pic_proc_cv_init(pic, compare, 2);
   pic_proc_cv_set(pic, compare, 0, use_env);
   pic_proc_cv_set(pic, compare, 1, mac_env);
@@ -786,7 +786,7 @@ pic_macro_er_macro_transformer(pic_state *pic)
 
   pic_get_args(pic, "l", &cb);
 
-  proc = pic_proc_new(pic, er_macro_call);
+  proc = pic_proc_new(pic, er_macro_call, "<er-macro-procedure>");
   pic_proc_cv_init(pic, proc, 1);
   pic_proc_cv_set(pic, proc, 0, pic_obj_value(cb));
 
@@ -887,12 +887,12 @@ ir_macro_call(pic_state *pic)
     pic_error(pic, "unexpected type of argument 3");
   }
 
-  inject = pic_proc_new(pic, ir_macro_inject);
+  inject = pic_proc_new(pic, ir_macro_inject, "<ir-macro-injecter>");
   pic_proc_cv_init(pic, inject, 2);
   pic_proc_cv_set(pic, inject, 0, use_env);
   pic_proc_cv_set(pic, inject, 1, mac_env);
 
-  compare = pic_proc_new(pic, ir_macro_compare);
+  compare = pic_proc_new(pic, ir_macro_compare, "<ir-macro-comparator>");
   pic_proc_cv_init(pic, compare, 2);
   pic_proc_cv_set(pic, compare, 0, use_env);
   pic_proc_cv_set(pic, compare, 1, mac_env);
@@ -912,7 +912,7 @@ pic_macro_ir_macro_transformer(pic_state *pic)
 
   pic_get_args(pic, "l", &cb);
 
-  proc = pic_proc_new(pic, ir_macro_call);
+  proc = pic_proc_new(pic, ir_macro_call, "<ir-macro-procedure>");
   pic_proc_cv_init(pic, proc, 1);
   pic_proc_cv_set(pic, proc, 0, pic_obj_value(cb));
 
@@ -922,7 +922,7 @@ pic_macro_ir_macro_transformer(pic_state *pic)
 void
 pic_init_macro(pic_state *pic)
 {
-  pic_defmacro(pic, "include", pic_proc_new(pic, pic_macro_include));
+  pic_defmacro(pic, "include", pic_proc_new(pic, pic_macro_include, "<include-procedure>"));
 
   pic_deflibrary ("(picrin macro)") {
 

src/proc.c

@@ -8,14 +8,16 @@
 #include "picrin/irep.h"
 
 struct pic_proc *
-pic_proc_new(pic_state *pic, pic_func_t func)
+pic_proc_new(pic_state *pic, pic_func_t func, const char *name)
 {
   struct pic_proc *proc;
 
+  assert(name != NULL);
+
   proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
   proc->kind = PIC_PROC_KIND_FUNC;
   proc->u.func.f = func;
-  proc->u.func.name = pic_intern_cstr(pic, "(no name)");
+  proc->u.func.name = pic_intern_cstr(pic, name);
   proc->env = NULL;
   return proc;
 }
@@ -95,7 +97,7 @@ pic_papply(pic_state *pic, struct pic_proc *proc, pic_value arg)
 {
   struct pic_proc *pa_proc;
 
-  pa_proc = pic_proc_new(pic, papply_call);
+  pa_proc = pic_proc_new(pic, papply_call, "<partial-applied-procedure>");
   pic_proc_cv_init(pic, pa_proc, 2);
   pic_proc_cv_set(pic, pa_proc, 0, pic_obj_value(proc));
   pic_proc_cv_set(pic, pa_proc, 1, arg);

src/var.c

@@ -100,7 +100,7 @@ pic_wrap_var(pic_state *pic, struct pic_var *var)
 {
   struct pic_proc *proc;
 
-  proc = pic_proc_new(pic, var_call);
+  proc = pic_proc_new(pic, var_call, "<var-procedure>");
   pic_proc_cv_init(pic, proc, 1);
   pic_proc_cv_set(pic, proc, 0, pic_obj_value(var));
   return proc;

src/vm.c

@@ -409,7 +409,7 @@ pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
 {
   struct pic_proc *proc;
 
-  proc = pic_proc_new(pic, cfunc);
+  proc = pic_proc_new(pic, cfunc, name);
   pic_define(pic, name, pic_obj_value(proc));
 }