From b7d8a2c7249e6f0cdefd7448687d452a0c1f2ec9 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 26 Mar 2014 21:20:06 +0900 Subject: [PATCH] record cfunc procedure names --- include/picrin/proc.h | 2 +- src/cont.c | 4 ++-- src/macro.c | 14 +++++++------- src/proc.c | 8 +++++--- src/var.c | 2 +- src/vm.c | 2 +- 6 files changed, 17 insertions(+), 15 deletions(-) diff --git a/include/picrin/proc.h b/include/picrin/proc.h index fc8c39cf..18df1357 100644 --- a/include/picrin/proc.h +++ b/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 */ diff --git a/src/cont.c b/src/cont.c index 9ee93c60..6248a503 100644 --- a/src/cont.c +++ b/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, ""); /* 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, ""); /* save the continuation object in proc */ pic_proc_cv_init(pic, c, 1); diff --git a/src/macro.c b/src/macro.c index e11fd3ed..5db52872 100644 --- a/src/macro.c +++ b/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, ""); 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, ""); 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, ""); 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, ""); 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, ""); 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, ""); 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, "")); pic_deflibrary ("(picrin macro)") { diff --git a/src/proc.c b/src/proc.c index eea16bc1..1dfb259a 100644 --- a/src/proc.c +++ b/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, ""); 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); diff --git a/src/var.c b/src/var.c index 6aa4e18a..a779ddff 100644 --- a/src/var.c +++ b/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, ""); pic_proc_cv_init(pic, proc, 1); pic_proc_cv_set(pic, proc, 0, pic_obj_value(var)); return proc; diff --git a/src/vm.c b/src/vm.c index be3fe654..9f4422cb 100644 --- a/src/vm.c +++ b/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)); }