conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
contrib/10.callcc/callcc.c
View File

@ -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)

69
extlib/benz/codegen.c
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_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, 1);
body = pic_list_ref(pic, defer, 2);
dst = pic_list_ref(pic, defer, 3);
formal = pic_list_ref(pic, defer, 0);
body = pic_list_ref(pic, defer, 1);
dst = pic_list_ref(pic, defer, 2);
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, 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 {
var = analyze_declare(pic, scope, pic_sym_ptr(pic_list_ref(pic, obj, 1)));
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, 2);
rest_opt = pic_list_ref(pic, obj, 1);
if (pic_sym_p(rest_opt)) {
rest = pic_sym_ptr(rest_opt);
}
args = pic_vec_ptr(pic_list_ref(pic, obj, 3));
locals = pic_vec_ptr(pic_list_ref(pic, obj, 4));
captures = pic_vec_ptr(pic_list_ref(pic, obj, 5));
body = pic_list_ref(pic, obj, 6);
args = pic_vec_ptr(pic_list_ref(pic, obj, 2));
locals = pic_vec_ptr(pic_list_ref(pic, obj, 3));
captures = pic_vec_ptr(pic_list_ref(pic, obj, 4));
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);

2
extlib/benz/cont.c
View File

@ -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);

2
extlib/benz/debug.c
View File

@ -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"));

3
extlib/benz/gc.c
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);
}
} 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]);
}

2
extlib/benz/include/picrin/error.h
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) { \
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);

1
extlib/benz/include/picrin/irep.h
View File

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

4
extlib/benz/include/picrin/proc.h
View File

@ -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 *);

2
extlib/benz/port.c
View File

@ -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) \

20
extlib/benz/proc.c
View File

@ -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)
{

2
extlib/benz/reg.c
View File

@ -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));

2
extlib/benz/var.c
View File

@ -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));

10
extlib/benz/vm.c
View File

@ -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_symbol_name(pic, pic_proc_name(pic_proc_ptr(GET_OPERAND(pic, 0)))) ,
argc,
rest? "at least " : "",
paramc);
pic_errorf(pic, "pic_get_args: wrong number of arguments (%d for %s%d)", 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