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

s/syntax/macro/g

This commit is contained in:
Yuichi Nishiwaki 2014-02-12 11:13:29 +09:00
parent 8ea3a7b544
commit 098d5dc022
6 changed files with 37 additions and 35 deletions

6
include/picrin/macro.h
View File

@ -15,7 +15,7 @@ struct pic_senv {
struct pic_senv *up; struct pic_senv *up;
}; };
struct pic_syntax { struct pic_macro {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
struct pic_proc *proc; struct pic_proc *proc;
struct pic_senv *senv; struct pic_senv *senv;
@ -30,8 +30,8 @@ struct pic_sc {
#define pic_sc(v) ((struct pic_sc *)pic_ptr(v)) #define pic_sc(v) ((struct pic_sc *)pic_ptr(v))
#define pic_sc_p(v) (pic_type(v) == PIC_TT_SC) #define pic_sc_p(v) (pic_type(v) == PIC_TT_SC)
#define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v)) #define pic_macro(v) ((struct pic_macro *)pic_ptr(v))
#define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX) #define pic_macro_p(v) (pic_type(v) == PIC_TT_MACRO)
#define pic_senv(v) ((struct pic_senv *)pic_ptr(v)) #define pic_senv(v) ((struct pic_senv *)pic_ptr(v))
#define pic_senv_p(v) (pic_type(v) == PIC_TT_SENV) #define pic_senv_p(v) (pic_type(v) == PIC_TT_SENV)

6
include/picrin/value.h
View File

@ -99,7 +99,7 @@ enum pic_tt {
PIC_TT_ENV, PIC_TT_ENV,
PIC_TT_CONT, PIC_TT_CONT,
PIC_TT_SENV, PIC_TT_SENV,
PIC_TT_SYNTAX, PIC_TT_MACRO,
PIC_TT_SC, PIC_TT_SC,
PIC_TT_LIB, PIC_TT_LIB,
PIC_TT_VAR, PIC_TT_VAR,
@ -248,8 +248,8 @@ pic_type_repr(enum pic_tt tt)
return "sc"; return "sc";
case PIC_TT_SENV: case PIC_TT_SENV:
return "senv"; return "senv";
case PIC_TT_SYNTAX: case PIC_TT_MACRO:
return "syntax"; return "macro";
case PIC_TT_LIB: case PIC_TT_LIB:
return "lib"; return "lib";
case PIC_TT_VAR: case PIC_TT_VAR:

2
src/codegen.c
View File

@ -561,7 +561,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
case PIC_TT_PORT: case PIC_TT_PORT:
case PIC_TT_ERROR: case PIC_TT_ERROR:
case PIC_TT_SENV: case PIC_TT_SENV:
case PIC_TT_SYNTAX: case PIC_TT_MACRO:
case PIC_TT_SC: case PIC_TT_SC:
case PIC_TT_LIB: case PIC_TT_LIB:
case PIC_TT_VAR: case PIC_TT_VAR:

14
src/gc.c
View File

@ -387,14 +387,14 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
gc_mark(pic, cont->results); gc_mark(pic, cont->results);
break; break;
} }
case PIC_TT_SYNTAX: { case PIC_TT_MACRO: {
struct pic_syntax *stx = (struct pic_syntax *)obj; struct pic_macro *mac = (struct pic_macro *)obj;
if (stx->proc) { if (mac->proc) {
gc_mark_object(pic, (struct pic_object *)stx->proc); gc_mark_object(pic, (struct pic_object *)mac->proc);
} }
if (stx->senv) { if (mac->senv) {
gc_mark_object(pic, (struct pic_object *)stx->senv); gc_mark_object(pic, (struct pic_object *)mac->senv);
} }
break; break;
} }
@ -567,7 +567,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
xh_destroy(senv->name); xh_destroy(senv->name);
break; break;
} }
case PIC_TT_SYNTAX: { case PIC_TT_MACRO: {
break; break;
} }
case PIC_TT_SC: { case PIC_TT_SC: {

40
src/macro.c
View File

@ -59,15 +59,15 @@ new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
return senv; return senv;
} }
struct pic_syntax * struct pic_macro *
syntax_new(pic_state *pic, struct pic_proc *proc, struct pic_senv *mac_env) macro_new(pic_state *pic, struct pic_proc *proc, struct pic_senv *mac_env)
{ {
struct pic_syntax *stx; struct pic_macro *mac;
stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX); mac = (struct pic_macro *)pic_obj_alloc(pic, sizeof(struct pic_macro), PIC_TT_MACRO);
stx->senv = mac_env; mac->senv = mac_env;
stx->proc = proc; mac->proc = proc;
return stx; return mac;
} }
static struct pic_sc * static struct pic_sc *
@ -148,14 +148,14 @@ pic_export(pic_state *pic, pic_sym sym)
static void static void
defsyntax(pic_state *pic, pic_sym sym, struct pic_proc *macro, struct pic_senv *mac_env) defsyntax(pic_state *pic, pic_sym sym, struct pic_proc *macro, struct pic_senv *mac_env)
{ {
struct pic_syntax *stx; struct pic_macro *mac;
pic_sym uniq; pic_sym uniq;
stx = syntax_new(pic, macro, mac_env); mac = macro_new(pic, macro, mac_env);
uniq = pic_gensym(pic, sym); uniq = pic_gensym(pic, sym);
xh_put_int(pic->lib->senv->name, sym, uniq); xh_put_int(pic->lib->senv->name, sym, uniq);
xh_put_int(pic->macros, uniq, (long)stx); xh_put_int(pic->macros, uniq, (long)mac);
} }
static void static void
@ -432,16 +432,18 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
/* macro */ /* macro */
if ((e = xh_get_int(pic->macros, tag)) != NULL) { if ((e = xh_get_int(pic->macros, tag)) != NULL) {
pic_value v; pic_value v;
struct pic_syntax *stx = (struct pic_syntax *)e->val; struct pic_macro *mac;
if (stx->senv == NULL) { /* legacy macro */
v = pic_apply(pic, stx->proc, pic_cdr(pic, expr)); mac = (struct pic_macro *)e->val;
if (mac->senv == NULL) { /* legacy macro */
v = pic_apply(pic, mac->proc, pic_cdr(pic, expr));
if (pic->err) { if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic)); printf("macroexpand error: %s\n", pic_errmsg(pic));
abort(); abort();
} }
} }
else { else {
v = pic_apply_argv(pic, stx->proc, 3, expr, pic_obj_value(senv), pic_obj_value(stx->senv)); v = pic_apply_argv(pic, mac->proc, 3, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
if (pic->err) { if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic)); printf("macroexpand error: %s\n", pic_errmsg(pic));
abort(); abort();
@ -483,7 +485,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
case PIC_TT_CONT: case PIC_TT_CONT:
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
case PIC_TT_SENV: case PIC_TT_SENV:
case PIC_TT_SYNTAX: case PIC_TT_MACRO:
case PIC_TT_LIB: case PIC_TT_LIB:
case PIC_TT_VAR: case PIC_TT_VAR:
case PIC_TT_IREP: case PIC_TT_IREP:
@ -661,7 +663,7 @@ er_macro_rename(pic_state *pic)
mac_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 1)); mac_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 1));
v = macroexpand(pic, pic_symbol_value(sym), mac_env); v = macroexpand(pic, pic_symbol_value(sym), mac_env);
if (pic_syntax_p(v)) { if (pic_macro_p(v)) {
return pic_symbol_value(sym); return pic_symbol_value(sym);
} }
else { else {
@ -744,7 +746,7 @@ ir_macro_inject(pic_state *pic)
use_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0)); use_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
v = macroexpand(pic, pic_symbol_value(sym), use_env); v = macroexpand(pic, pic_symbol_value(sym), use_env);
if (pic_syntax_p(v)) { if (pic_macro_p(v)) {
return pic_symbol_value(sym); return pic_symbol_value(sym);
} }
else { else {
@ -793,13 +795,13 @@ ir_macro_wrap(pic_state *pic, pic_value expr, struct pic_senv *use_env, pic_valu
static pic_value static pic_value
ir_macro_unwrap(pic_state *pic, pic_value expr, struct pic_senv *mac_env, pic_value *assoc) ir_macro_unwrap(pic_state *pic, pic_value expr, struct pic_senv *mac_env, pic_value *assoc)
{ {
if (pic_sym_p(expr) || pic_syntax_p(expr)) { if (pic_sym_p(expr) || pic_macro_p(expr)) {
pic_value r; pic_value r;
if (pic_test(r = pic_assq(pic, expr, *assoc))) { if (pic_test(r = pic_assq(pic, expr, *assoc))) {
return pic_cdr(pic, r); return pic_cdr(pic, r);
} }
r = macroexpand(pic, expr, mac_env); r = macroexpand(pic, expr, mac_env);
if (pic_syntax_p(r)) { if (pic_macro_p(r)) {
return expr; return expr;
} }
else { else {

4
src/write.c
View File

@ -134,8 +134,8 @@ write(pic_state *pic, pic_value obj, XFILE *file)
case PIC_TT_SENV: case PIC_TT_SENV:
xfprintf(file, "#<senv %p>", pic_ptr(obj)); xfprintf(file, "#<senv %p>", pic_ptr(obj));
break; break;
case PIC_TT_SYNTAX: case PIC_TT_MACRO:
xfprintf(file, "#<syntax %p>", pic_ptr(obj)); xfprintf(file, "#<macro %p>", pic_ptr(obj));
break; break;
case PIC_TT_SC: case PIC_TT_SC:
xfprintf(file, "#<sc %p: ", pic_ptr(obj)); xfprintf(file, "#<sc %p: ", pic_ptr(obj));