remove pic_proc_name (for a moment)

contrib/10.callcc/callcc.c

@@ -246,7 +246,7 @@ pic_callcc_full(pic_state *pic, struct pic_proc *proc)
     struct pic_proc *c;
     struct pic_data *dat;
 
-    c = pic_make_proc(pic, cont_call, "<continuation-procedure>");
+    c = pic_make_proc(pic, cont_call);
 
     dat = pic_data_alloc(pic, &cont_type, cont);
 
@@ -270,7 +270,7 @@ pic_callcc_full_trampoline(pic_state *pic, struct pic_proc *proc)
     struct pic_proc *c;
     struct pic_data *dat;
 
-    c = pic_make_proc(pic, cont_call, "<continuation-procedure>");
+    c = pic_make_proc(pic, cont_call);
 
     dat = pic_data_alloc(pic, &cont_type, cont);
 
@@ -292,7 +292,7 @@ pic_callcc_callcc(pic_state *pic)
 }
 
 #define pic_redefun(pic, lib, name, func)       \
-  pic_set(pic, lib, name, pic_obj_value(pic_make_proc(pic, func, name)))
+  pic_set(pic, lib, name, pic_obj_value(pic_make_proc(pic, func)))
 
 void
 pic_init_callcc(pic_state *pic)

extlib/benz/codegen.c

@@ -379,7 +379,7 @@ define_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
 }
 
 static pic_value analyze_node(pic_state *, analyze_scope *, pic_value, bool);
-static pic_value analyze_procedure(pic_state *, analyze_scope *, pic_value, pic_value, pic_value);
+static pic_value analyze_procedure(pic_state *, analyze_scope *, pic_value, pic_value);
 
 static pic_value
 analyze(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos)
@@ -423,14 +423,14 @@ analyze_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
 }
 
 static pic_value
-analyze_defer(pic_state *pic, analyze_scope *scope, pic_value name, pic_value formal, pic_value body)
+analyze_defer(pic_state *pic, analyze_scope *scope, pic_value formal, pic_value body)
 {
   pic_sym *sNOWHERE = pic_intern_cstr(pic, "<<nowhere>>");
   pic_value skel;
 
   skel = pic_list2(pic, pic_obj_value(pic->sGREF), pic_obj_value(sNOWHERE));
 
-  pic_push(pic, pic_list4(pic, name, formal, body, skel), scope->defer);
+  pic_push(pic, pic_list3(pic, formal, body, skel), scope->defer);
 
   return skel;
 }
@@ -438,15 +438,14 @@ analyze_defer(pic_state *pic, analyze_scope *scope, pic_value name, pic_value fo
 static void
 analyze_deferred(pic_state *pic, analyze_scope *scope)
 {
-  pic_value defer, val, name, formal, body, dst, it;
+  pic_value defer, val, formal, body, dst, it;
 
   pic_for_each (defer, pic_reverse(pic, scope->defer), it) {
-    name = pic_list_ref(pic, defer, 0);
+    formal = pic_list_ref(pic, defer, 0);
-    formal = pic_list_ref(pic, defer, 1);
+    body = pic_list_ref(pic, defer, 1);
-    body = pic_list_ref(pic, defer, 2);
+    dst = pic_list_ref(pic, defer, 2);
-    dst = pic_list_ref(pic, defer, 3);
 
-    val = analyze_procedure(pic, scope, name, formal, body);
+    val = analyze_procedure(pic, scope, formal, body);
 
     /* copy */
     pic_pair_ptr(dst)->car = pic_car(pic, val);
@@ -457,15 +456,13 @@ analyze_deferred(pic_state *pic, analyze_scope *scope)
 }
 
 static pic_value
-analyze_procedure(pic_state *pic, analyze_scope *up, pic_value name, pic_value formals, pic_value body)
+analyze_procedure(pic_state *pic, analyze_scope *up, pic_value formals, pic_value body)
 {
   analyze_scope s, *scope = &s;
   pic_value rest = pic_undef_value();
   pic_vec *args, *locals, *captures;
   size_t i, j;
 
-  assert(pic_sym_p(name) || pic_false_p(name));
-
   analyzer_scope_init(pic, scope, formals, up);
 
   /* analyze body */
@@ -497,7 +494,7 @@ analyze_procedure(pic_state *pic, analyze_scope *up, pic_value name, pic_value f
 
   analyzer_scope_destroy(pic, scope);
 
-  return pic_list7(pic, pic_obj_value(pic->sLAMBDA), name, rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body);
+  return pic_list6(pic, pic_obj_value(pic->sLAMBDA), rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body);
 }
 
 static pic_value
@@ -508,7 +505,7 @@ analyze_lambda(pic_state *pic, analyze_scope *scope, pic_value obj)
   formals = pic_list_ref(pic, obj, 1);
   body = pic_list_ref(pic, obj, 2);
 
-  return analyze_defer(pic, scope, pic_false_value(), formals, body);
+  return analyze_defer(pic, scope, formals, body);
 }
 
 static pic_value
@@ -523,25 +520,9 @@ static pic_value
 analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj)
 {
   pic_value var, val;
-  pic_sym *sym;
 
-  sym = pic_sym_ptr(pic_list_ref(pic, obj, 1));
+  var = analyze_declare(pic, scope, pic_sym_ptr(pic_list_ref(pic, obj, 1)));
-  var = analyze_declare(pic, scope, sym);
+  val = analyze(pic, scope, pic_list_ref(pic, obj, 2), false);
-
-  if (pic_pair_p(pic_list_ref(pic, obj, 2))
-      && pic_sym_p(pic_list_ref(pic, pic_list_ref(pic, obj, 2), 0))
-      && pic_sym_ptr(pic_list_ref(pic, pic_list_ref(pic, obj, 2), 0)) == pic->uLAMBDA) {
-    pic_value formals, body;
-
-    /* restore (define (foo ...) ...) structure */
-
-    formals = pic_list_ref(pic, pic_list_ref(pic, obj, 2), 1);
-    body = pic_list_ref(pic, pic_list_ref(pic, obj, 2), 2);
-
-    val = analyze_defer(pic, scope, pic_obj_value(sym), formals, body);
-  } else {
-    val = analyze(pic, scope, pic_list_ref(pic, obj, 2), false);
-  }
 
   return pic_list3(pic, pic_obj_value(pic->sSETBANG), var, val);
 }
@@ -893,7 +874,6 @@ pic_analyze(pic_state *pic, pic_value obj)
 }
 
 typedef struct codegen_context {
-  pic_sym *name;
   /* rest args variable is counted as a local */
   pic_sym *rest;
   pic_vec *args, *locals, *captures;
@@ -916,14 +896,9 @@ typedef struct codegen_context {
 static void create_activation(pic_state *, codegen_context *);
 
 static void
-codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up, pic_value name, pic_sym *rest, pic_vec *args, pic_vec *locals, pic_vec *captures)
+codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up, pic_sym *rest, pic_vec *args, pic_vec *locals, pic_vec *captures)
 {
-  assert(pic_sym_p(name) || pic_false_p(name));
-
   cxt->up = up;
-  cxt->name = pic_false_p(name)
-    ? pic_intern_cstr(pic, "(anonymous lambda)")
-    : pic_sym_ptr(name);
   cxt->rest = rest;
 
   cxt->args = args;
@@ -956,7 +931,6 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
 
   /* create irep */
   irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_IREP);
-  irep->name = cxt->name;
   irep->varg = cxt->rest != NULL;
   irep->argc = (int)cxt->args->len + 1;
   irep->localc = (int)cxt->locals->len;
@@ -1382,22 +1356,21 @@ static struct pic_irep *
 codegen_lambda(pic_state *pic, codegen_context *up, pic_value obj)
 {
   codegen_context c, *cxt = &c;
-  pic_value name, rest_opt, body;
+  pic_value rest_opt, body;
   pic_sym *rest = NULL;
   pic_vec *args, *locals, *captures;
 
-  name = pic_list_ref(pic, obj, 1);
+  rest_opt = pic_list_ref(pic, obj, 1);
-  rest_opt = pic_list_ref(pic, obj, 2);
   if (pic_sym_p(rest_opt)) {
     rest = pic_sym_ptr(rest_opt);
   }
-  args = pic_vec_ptr(pic_list_ref(pic, obj, 3));
+  args = pic_vec_ptr(pic_list_ref(pic, obj, 2));
-  locals = pic_vec_ptr(pic_list_ref(pic, obj, 4));
+  locals = pic_vec_ptr(pic_list_ref(pic, obj, 3));
-  captures = pic_vec_ptr(pic_list_ref(pic, obj, 5));
+  captures = pic_vec_ptr(pic_list_ref(pic, obj, 4));
-  body = pic_list_ref(pic, obj, 6);
+  body = pic_list_ref(pic, obj, 5);
 
   /* inner environment */
-  codegen_context_init(pic, cxt, up, name, rest, args, locals, captures);
+  codegen_context_init(pic, cxt, up, rest, args, locals, captures);
   {
     /* body */
     codegen(pic, cxt, body);
@@ -1411,7 +1384,7 @@ pic_codegen(pic_state *pic, pic_value obj)
   pic_vec *empty = pic_make_vec(pic, 0);
   codegen_context c, *cxt = &c;
 
-  codegen_context_init(pic, cxt, NULL, pic_false_value(), NULL, empty, empty, empty);
+  codegen_context_init(pic, cxt, NULL, NULL, empty, empty, empty);
 
   codegen(pic, cxt, obj);
 

extlib/benz/cont.c

@@ -121,7 +121,7 @@ pic_make_cont(pic_state *pic, struct pic_cont *cont)
   struct pic_proc *c;
   struct pic_data *e;
 
-  c = pic_make_proc(pic, cont_call, "<cont-procedure>");
+  c = pic_make_proc(pic, cont_call);
 
   e = pic_data_alloc(pic, &cont_type, cont);
 

extlib/benz/debug.c

@@ -17,7 +17,7 @@ pic_get_backtrace(pic_state *pic)
     struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
 
     trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, "  at "));
-    trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc))));
+    trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, "(anonymous lambda)"));
 
     if (pic_proc_func_p(proc)) {
       trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));

extlib/benz/gc.c

@@ -366,7 +366,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
         gc_mark_object(pic, (struct pic_object *)proc->u.i.cxt);
       }
     } else {
-      gc_mark_object(pic, (struct pic_object *)proc->u.f.name);
       if (proc->u.f.env) {
         gc_mark_object(pic, (struct pic_object *)proc->u.f.env);
       }
@@ -430,8 +429,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     struct pic_irep *irep = (struct pic_irep *)obj;
     size_t i;
 
-    gc_mark_object(pic, (struct pic_object *)irep->name);
-
     for (i = 0; i < irep->ilen; ++i) {
       gc_mark_object(pic, (struct pic_object *)irep->irep[i]);
     }

extlib/benz/include/picrin/error.h

@@ -35,7 +35,7 @@ struct pic_error *pic_make_error(pic_state *, pic_sym *, const char *, pic_list)
     if (PIC_SETJMP(pic, cont.jmp) == 0) {                               \
       extern pic_value pic_native_exception_handler(pic_state *);       \
       struct pic_proc *handler;                                         \
-      handler = pic_make_proc(pic, pic_native_exception_handler, "(native-exception-handler)"); \
+      handler = pic_make_proc(pic, pic_native_exception_handler);       \
       pic_proc_env_set(pic, handler, "cont", pic_obj_value(pic_make_cont(pic, &cont))); \
       do {                                                              \
         pic_push_handler(pic, handler);

extlib/benz/include/picrin/irep.h

@@ -68,7 +68,6 @@ typedef struct {
 
 struct pic_irep {
   PIC_OBJECT_HEADER
-  pic_sym *name;
   pic_code *code;
   int argc, localc, capturec;
   bool varg;

extlib/benz/include/picrin/proc.h

@@ -26,7 +26,6 @@ struct pic_proc {
   union {
     struct {
       pic_func_t func;
-      pic_sym *name;
       struct pic_dict *env;
     } f;
     struct {
@@ -45,10 +44,9 @@ struct pic_proc {
 #define pic_context_p(o) (pic_type(o) == PIC_TT_CXT)
 #define pic_context_ptr(o) ((struct pic_context *)pic_ptr(o))
 
-struct pic_proc *pic_make_proc(pic_state *, pic_func_t, const char *);
+struct pic_proc *pic_make_proc(pic_state *, pic_func_t);
 struct pic_proc *pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *);
 
-pic_sym *pic_proc_name(struct pic_proc *);
 struct pic_dict *pic_proc_env(pic_state *, struct pic_proc *);
 bool pic_proc_env_has(pic_state *, struct pic_proc *, const char *);
 pic_value pic_proc_env_ref(pic_state *, struct pic_proc *, const char *);

extlib/benz/port.c

@@ -154,7 +154,7 @@ pic_define_standard_port(pic_state *pic, const char *name, xFILE *file, int dir)
   port->file = file;
   port->flags = dir | PIC_PORT_TEXT | PIC_PORT_OPEN;
 
-  pic_defvar(pic, name, pic_obj_value(port), pic_make_proc(pic, pic_assert_port, "pic_assert_port"));
+  pic_defvar(pic, name, pic_obj_value(port), pic_make_proc(pic, pic_assert_port));
 }
 
 #define DEFINE_STANDARD_PORT_ACCESSOR(name, var)        \

extlib/benz/proc.c

@@ -5,19 +5,13 @@
 #include "picrin.h"
 
 struct pic_proc *
-pic_make_proc(pic_state *pic, pic_func_t func, const char *name)
+pic_make_proc(pic_state *pic, pic_func_t func)
 {
   struct pic_proc *proc;
-  pic_sym *sym;
-
-  assert(name != NULL);
-
-  sym = pic_intern_cstr(pic, name);
 
   proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
   proc->tag = PIC_PROC_TAG_FUNC;
   proc->u.f.func = func;
-  proc->u.f.name = sym;
   proc->u.f.env = NULL;
   return proc;
 }
@@ -34,18 +28,6 @@ pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cx
   return proc;
 }
 
-pic_sym *
-pic_proc_name(struct pic_proc *proc)
-{
-  switch (proc->tag) {
-  case PIC_PROC_TAG_FUNC:
-    return proc->u.f.name;
-  case PIC_PROC_TAG_IREP:
-    return proc->u.i.irep->name;
-  }
-  PIC_UNREACHABLE();
-}
-
 struct pic_dict *
 pic_proc_env(pic_state *pic, struct pic_proc *proc)
 {

extlib/benz/reg.c

@@ -118,7 +118,7 @@ pic_reg_make_register(pic_state *pic)
 
   reg = pic_make_reg(pic);
 
-  proc = pic_make_proc(pic, reg_call, "<reg-call>");
+  proc = pic_make_proc(pic, reg_call);
 
   pic_proc_env_set(pic, proc, "reg", pic_obj_value(reg));
 

extlib/benz/var.c

@@ -61,7 +61,7 @@ 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>");
+  var = pic_make_proc(pic, var_call);
 
   if (conv != NULL) {
     pic_proc_env_set(pic, var, "conv", pic_obj_value(conv));

extlib/benz/vm.c

@@ -82,11 +82,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
 
   /* check argc. */
   if (argc < paramc || (paramc + optc < argc && ! rest)) {
-    pic_errorf(pic, "%s: wrong number of arguments (%d for %s%d)",
+    pic_errorf(pic, "pic_get_args: wrong number of arguments (%d for %s%d)", argc, rest? "at least " : "", paramc);
-               pic_symbol_name(pic, pic_proc_name(pic_proc_ptr(GET_OPERAND(pic, 0)))) ,
-               argc,
-               rest? "at least " : "",
-               paramc);
   }
 
   /* start dispatching */
@@ -1131,7 +1127,7 @@ pic_defun_vm(pic_state *pic, const char *name, pic_sym *uid, pic_func_t func)
   struct pic_proc *proc;
   pic_sym *sym;
 
-  proc = pic_make_proc(pic, func, name);
+  proc = pic_make_proc(pic, func);
 
   sym = pic_intern_cstr(pic, name);
 
@@ -1168,7 +1164,7 @@ pic_define(pic_state *pic, const char *name, pic_value val)
 void
 pic_defun_(pic_state *pic, const char *name, pic_func_t cfunc)
 {
-  pic_define_(pic, name, pic_obj_value(pic_make_proc(pic, cfunc, name)));
+  pic_define_(pic, name, pic_obj_value(pic_make_proc(pic, cfunc)));
 }
 
 void