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

6
include/picrin/macro.h
View File

@ -15,7 +15,7 @@ struct pic_senv {
struct pic_senv *up;
};
struct pic_syntax {
struct pic_macro {
PIC_OBJECT_HEADER
struct pic_proc *proc;
struct pic_senv *senv;
@ -30,8 +30,8 @@ struct pic_sc {
#define pic_sc(v) ((struct pic_sc *)pic_ptr(v))
#define pic_sc_p(v) (pic_type(v) == PIC_TT_SC)
#define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v))
#define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX)
#define pic_macro(v) ((struct pic_macro *)pic_ptr(v))
#define pic_macro_p(v) (pic_type(v) == PIC_TT_MACRO)
#define pic_senv(v) ((struct pic_senv *)pic_ptr(v))
#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_CONT,
PIC_TT_SENV,
PIC_TT_SYNTAX,
PIC_TT_MACRO,
PIC_TT_SC,
PIC_TT_LIB,
PIC_TT_VAR,
@ -248,8 +248,8 @@ pic_type_repr(enum pic_tt tt)
return "sc";
case PIC_TT_SENV:
return "senv";
case PIC_TT_SYNTAX:
return "syntax";
case PIC_TT_MACRO:
return "macro";
case PIC_TT_LIB:
return "lib";
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_ERROR:
case PIC_TT_SENV:
case PIC_TT_SYNTAX:
case PIC_TT_MACRO:
case PIC_TT_SC:
case PIC_TT_LIB:
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);
break;
}
case PIC_TT_SYNTAX: {
struct pic_syntax *stx = (struct pic_syntax *)obj;
case PIC_TT_MACRO: {
struct pic_macro *mac = (struct pic_macro *)obj;
if (stx->proc) {
gc_mark_object(pic, (struct pic_object *)stx->proc);
if (mac->proc) {
gc_mark_object(pic, (struct pic_object *)mac->proc);
}
if (stx->senv) {
gc_mark_object(pic, (struct pic_object *)stx->senv);
if (mac->senv) {
gc_mark_object(pic, (struct pic_object *)mac->senv);
}
break;
}
@ -567,7 +567,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
xh_destroy(senv->name);
break;
}
case PIC_TT_SYNTAX: {
case PIC_TT_MACRO: {
break;
}
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;
}
struct pic_syntax *
syntax_new(pic_state *pic, struct pic_proc *proc, struct pic_senv *mac_env)
struct pic_macro *
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);
stx->senv = mac_env;
stx->proc = proc;
return stx;
mac = (struct pic_macro *)pic_obj_alloc(pic, sizeof(struct pic_macro), PIC_TT_MACRO);
mac->senv = mac_env;
mac->proc = proc;
return mac;
}
static struct pic_sc *
@ -148,14 +148,14 @@ pic_export(pic_state *pic, pic_sym sym)
static void
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;
stx = syntax_new(pic, macro, mac_env);
mac = macro_new(pic, macro, mac_env);
uniq = pic_gensym(pic, sym);
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
@ -432,16 +432,18 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
/* macro */
if ((e = xh_get_int(pic->macros, tag)) != NULL) {
pic_value v;
struct pic_syntax *stx = (struct pic_syntax *)e->val;
if (stx->senv == NULL) { /* legacy macro */
v = pic_apply(pic, stx->proc, pic_cdr(pic, expr));
struct pic_macro *mac;
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) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
}
}
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) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
@ -483,7 +485,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
case PIC_TT_CONT:
case PIC_TT_UNDEF:
case PIC_TT_SENV:
case PIC_TT_SYNTAX:
case PIC_TT_MACRO:
case PIC_TT_LIB:
case PIC_TT_VAR:
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));
v = macroexpand(pic, pic_symbol_value(sym), mac_env);
if (pic_syntax_p(v)) {
if (pic_macro_p(v)) {
return pic_symbol_value(sym);
}
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));
v = macroexpand(pic, pic_symbol_value(sym), use_env);
if (pic_syntax_p(v)) {
if (pic_macro_p(v)) {
return pic_symbol_value(sym);
}
else {
@ -793,13 +795,13 @@ ir_macro_wrap(pic_state *pic, pic_value expr, struct pic_senv *use_env, pic_valu
static pic_value
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;
if (pic_test(r = pic_assq(pic, expr, *assoc))) {
return pic_cdr(pic, r);
}
r = macroexpand(pic, expr, mac_env);
if (pic_syntax_p(r)) {
if (pic_macro_p(r)) {
return expr;
}
else {

4
src/write.c
View File

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