remove pic_proc_name (for a moment)

This commit is contained in:
Yuichi Nishiwaki 2015-06-27 19:02:18 +09:00
parent 36c498e7d7
commit ddcf96f689
13 changed files with 36 additions and 91 deletions

View File

@ -246,7 +246,7 @@ pic_callcc_full(pic_state *pic, struct pic_proc *proc)
struct pic_proc *c; struct pic_proc *c;
struct pic_data *dat; 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); 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_proc *c;
struct pic_data *dat; 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); 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) \ #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 void
pic_init_callcc(pic_state *pic) pic_init_callcc(pic_state *pic)

View File

@ -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_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 static pic_value
analyze(pic_state *pic, analyze_scope *scope, pic_value obj, bool tailpos) 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 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_sym *sNOWHERE = pic_intern_cstr(pic, "<<nowhere>>");
pic_value skel; pic_value skel;
skel = pic_list2(pic, pic_obj_value(pic->sGREF), pic_obj_value(sNOWHERE)); 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; return skel;
} }
@ -438,15 +438,14 @@ analyze_defer(pic_state *pic, analyze_scope *scope, pic_value name, pic_value fo
static void static void
analyze_deferred(pic_state *pic, analyze_scope *scope) 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) { 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 */ /* copy */
pic_pair_ptr(dst)->car = pic_car(pic, val); pic_pair_ptr(dst)->car = pic_car(pic, val);
@ -457,15 +456,13 @@ analyze_deferred(pic_state *pic, analyze_scope *scope)
} }
static pic_value 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; analyze_scope s, *scope = &s;
pic_value rest = pic_undef_value(); pic_value rest = pic_undef_value();
pic_vec *args, *locals, *captures; pic_vec *args, *locals, *captures;
size_t i, j; size_t i, j;
assert(pic_sym_p(name) || pic_false_p(name));
analyzer_scope_init(pic, scope, formals, up); analyzer_scope_init(pic, scope, formals, up);
/* analyze body */ /* 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); 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 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); formals = pic_list_ref(pic, obj, 1);
body = pic_list_ref(pic, obj, 2); 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 static pic_value
@ -523,25 +520,9 @@ static pic_value
analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj) analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj)
{ {
pic_value var, val; 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);
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); val = analyze(pic, scope, pic_list_ref(pic, obj, 2), false);
}
return pic_list3(pic, pic_obj_value(pic->sSETBANG), var, val); 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 { typedef struct codegen_context {
pic_sym *name;
/* rest args variable is counted as a local */ /* rest args variable is counted as a local */
pic_sym *rest; pic_sym *rest;
pic_vec *args, *locals, *captures; pic_vec *args, *locals, *captures;
@ -916,14 +896,9 @@ typedef struct codegen_context {
static void create_activation(pic_state *, codegen_context *); static void create_activation(pic_state *, codegen_context *);
static void 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->up = up;
cxt->name = pic_false_p(name)
? pic_intern_cstr(pic, "(anonymous lambda)")
: pic_sym_ptr(name);
cxt->rest = rest; cxt->rest = rest;
cxt->args = args; cxt->args = args;
@ -956,7 +931,6 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
/* create irep */ /* create irep */
irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_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->varg = cxt->rest != NULL;
irep->argc = (int)cxt->args->len + 1; irep->argc = (int)cxt->args->len + 1;
irep->localc = (int)cxt->locals->len; 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_lambda(pic_state *pic, codegen_context *up, pic_value obj)
{ {
codegen_context c, *cxt = &c; codegen_context c, *cxt = &c;
pic_value name, rest_opt, body; pic_value rest_opt, body;
pic_sym *rest = NULL; pic_sym *rest = NULL;
pic_vec *args, *locals, *captures; 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)) { if (pic_sym_p(rest_opt)) {
rest = pic_sym_ptr(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 */ /* inner environment */
codegen_context_init(pic, cxt, up, name, rest, args, locals, captures); codegen_context_init(pic, cxt, up, rest, args, locals, captures);
{ {
/* body */ /* body */
codegen(pic, cxt, 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); pic_vec *empty = pic_make_vec(pic, 0);
codegen_context c, *cxt = &c; 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); codegen(pic, cxt, obj);

View File

@ -121,7 +121,7 @@ pic_make_cont(pic_state *pic, struct pic_cont *cont)
struct pic_proc *c; struct pic_proc *c;
struct pic_data *e; 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); e = pic_data_alloc(pic, &cont_type, cont);

View File

@ -17,7 +17,7 @@ pic_get_backtrace(pic_state *pic)
struct pic_proc *proc = pic_proc_ptr(ci->fp[0]); 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, " 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)) { if (pic_proc_func_p(proc)) {
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n")); trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));

View File

@ -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); gc_mark_object(pic, (struct pic_object *)proc->u.i.cxt);
} }
} else { } else {
gc_mark_object(pic, (struct pic_object *)proc->u.f.name);
if (proc->u.f.env) { if (proc->u.f.env) {
gc_mark_object(pic, (struct pic_object *)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; struct pic_irep *irep = (struct pic_irep *)obj;
size_t i; size_t i;
gc_mark_object(pic, (struct pic_object *)irep->name);
for (i = 0; i < irep->ilen; ++i) { for (i = 0; i < irep->ilen; ++i) {
gc_mark_object(pic, (struct pic_object *)irep->irep[i]); gc_mark_object(pic, (struct pic_object *)irep->irep[i]);
} }

View File

@ -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) { \ if (PIC_SETJMP(pic, cont.jmp) == 0) { \
extern pic_value pic_native_exception_handler(pic_state *); \ extern pic_value pic_native_exception_handler(pic_state *); \
struct pic_proc *handler; \ 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))); \ pic_proc_env_set(pic, handler, "cont", pic_obj_value(pic_make_cont(pic, &cont))); \
do { \ do { \
pic_push_handler(pic, handler); pic_push_handler(pic, handler);

View File

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

View File

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

View File

@ -154,7 +154,7 @@ pic_define_standard_port(pic_state *pic, const char *name, xFILE *file, int dir)
port->file = file; port->file = file;
port->flags = dir | PIC_PORT_TEXT | PIC_PORT_OPEN; 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) \ #define DEFINE_STANDARD_PORT_ACCESSOR(name, var) \

View File

@ -5,19 +5,13 @@
#include "picrin.h" #include "picrin.h"
struct pic_proc * 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; 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 = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->tag = PIC_PROC_TAG_FUNC; proc->tag = PIC_PROC_TAG_FUNC;
proc->u.f.func = func; proc->u.f.func = func;
proc->u.f.name = sym;
proc->u.f.env = NULL; proc->u.f.env = NULL;
return proc; return proc;
} }
@ -34,18 +28,6 @@ pic_make_proc_irep(pic_state *pic, struct pic_irep *irep, struct pic_context *cx
return proc; 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 * struct pic_dict *
pic_proc_env(pic_state *pic, struct pic_proc *proc) pic_proc_env(pic_state *pic, struct pic_proc *proc)
{ {

View File

@ -118,7 +118,7 @@ pic_reg_make_register(pic_state *pic)
reg = pic_make_reg(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)); pic_proc_env_set(pic, proc, "reg", pic_obj_value(reg));

View File

@ -61,7 +61,7 @@ pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv)
{ {
struct pic_proc *var; struct pic_proc *var;
var = pic_make_proc(pic, var_call, "<var-call>"); var = pic_make_proc(pic, var_call);
if (conv != NULL) { if (conv != NULL) {
pic_proc_env_set(pic, var, "conv", pic_obj_value(conv)); pic_proc_env_set(pic, var, "conv", pic_obj_value(conv));

View File

@ -82,11 +82,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
/* check argc. */ /* check argc. */
if (argc < paramc || (paramc + optc < argc && ! rest)) { 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 */ /* 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; struct pic_proc *proc;
pic_sym *sym; pic_sym *sym;
proc = pic_make_proc(pic, func, name); proc = pic_make_proc(pic, func);
sym = pic_intern_cstr(pic, name); sym = pic_intern_cstr(pic, name);
@ -1168,7 +1164,7 @@ pic_define(pic_state *pic, const char *name, pic_value val)
void void
pic_defun_(pic_state *pic, const char *name, pic_func_t cfunc) 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 void