Merge branch 'refactor-macroexpand2'
This commit is contained in:
commit
716a76c8a0
|
@ -36,14 +36,14 @@ struct pic_sc {
|
|||
#define pic_senv_p(v) (pic_type(v) == PIC_TT_SENV)
|
||||
#define pic_senv_ptr(v) ((struct pic_senv *)pic_ptr(v))
|
||||
|
||||
struct pic_senv *pic_null_syntactic_env(pic_state *);
|
||||
struct pic_senv *pic_minimal_syntactic_env(pic_state *);
|
||||
struct pic_senv *pic_core_syntactic_env(pic_state *);
|
||||
struct pic_senv *pic_null_syntactic_environment(pic_state *);
|
||||
|
||||
pic_sym pic_add_rename(pic_state *, struct pic_senv *, pic_sym);
|
||||
bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym * /* = NULL */);
|
||||
void pic_put_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym);
|
||||
|
||||
void pic_define_syntactic_keyword(pic_state *, struct pic_senv *, pic_sym);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
#endif
|
||||
|
|
16
src/init.c
16
src/init.c
|
@ -85,14 +85,14 @@ pic_init_core(pic_state *pic)
|
|||
pic_deflibrary ("(scheme base)") {
|
||||
|
||||
/* load core syntaces */
|
||||
pic->lib->senv = pic_core_syntactic_env(pic);
|
||||
pic_export(pic, pic_intern_cstr(pic, "define"));
|
||||
pic_export(pic, pic_intern_cstr(pic, "set!"));
|
||||
pic_export(pic, pic_intern_cstr(pic, "quote"));
|
||||
pic_export(pic, pic_intern_cstr(pic, "lambda"));
|
||||
pic_export(pic, pic_intern_cstr(pic, "if"));
|
||||
pic_export(pic, pic_intern_cstr(pic, "begin"));
|
||||
pic_export(pic, pic_intern_cstr(pic, "define-syntax"));
|
||||
pic->lib->senv = pic_null_syntactic_environment(pic);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sSETBANG);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sQUOTE);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLAMBDA);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sIF);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sBEGIN);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_SYNTAX);
|
||||
|
||||
pic_init_bool(pic); DONE;
|
||||
pic_init_pair(pic); DONE;
|
||||
|
|
|
@ -24,7 +24,7 @@ pic_make_library(pic_state *pic, pic_value name)
|
|||
return lib;
|
||||
}
|
||||
|
||||
senv = pic_minimal_syntactic_env(pic);
|
||||
senv = pic_null_syntactic_environment(pic);
|
||||
|
||||
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
|
||||
lib->senv = senv;
|
||||
|
|
103
src/macro.c
103
src/macro.c
|
@ -12,7 +12,7 @@
|
|||
#include "picrin/box.h"
|
||||
|
||||
struct pic_senv *
|
||||
pic_null_syntactic_env(pic_state *pic)
|
||||
pic_null_syntactic_environment(pic_state *pic)
|
||||
{
|
||||
struct pic_senv *senv;
|
||||
|
||||
|
@ -20,70 +20,21 @@ pic_null_syntactic_env(pic_state *pic)
|
|||
senv->up = NULL;
|
||||
xh_init_int(&senv->renames, sizeof(pic_sym));
|
||||
|
||||
return senv;
|
||||
}
|
||||
|
||||
struct pic_senv *
|
||||
pic_minimal_syntactic_env(pic_state *pic)
|
||||
{
|
||||
struct pic_senv *senv = pic_null_syntactic_env(pic);
|
||||
|
||||
pic_put_rename(pic, senv, pic->sDEFINE_LIBRARY, pic->sDEFINE_LIBRARY);
|
||||
pic_put_rename(pic, senv, pic->sIMPORT, pic->sIMPORT);
|
||||
pic_put_rename(pic, senv, pic->sEXPORT, pic->sEXPORT);
|
||||
pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY);
|
||||
pic_define_syntactic_keyword(pic, senv, pic->sIMPORT);
|
||||
pic_define_syntactic_keyword(pic, senv, pic->sEXPORT);
|
||||
|
||||
return senv;
|
||||
}
|
||||
|
||||
struct pic_senv *
|
||||
pic_core_syntactic_env(pic_state *pic)
|
||||
void
|
||||
pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym)
|
||||
{
|
||||
struct pic_senv *senv = pic_minimal_syntactic_env(pic);
|
||||
pic_put_rename(pic, senv, sym, sym);
|
||||
|
||||
pic_put_rename(pic, senv, pic->sDEFINE, pic->sDEFINE);
|
||||
pic_put_rename(pic, senv, pic->sSETBANG, pic->sSETBANG);
|
||||
pic_put_rename(pic, senv, pic->sQUOTE, pic->sQUOTE);
|
||||
pic_put_rename(pic, senv, pic->sLAMBDA, pic->sLAMBDA);
|
||||
pic_put_rename(pic, senv, pic->sIF, pic->sIF);
|
||||
pic_put_rename(pic, senv, pic->sBEGIN, pic->sBEGIN);
|
||||
pic_put_rename(pic, senv, pic->sDEFINE_SYNTAX, pic->sDEFINE_SYNTAX);
|
||||
|
||||
return senv;
|
||||
}
|
||||
|
||||
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, pic_value);
|
||||
|
||||
static struct pic_senv *
|
||||
push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value assoc_box)
|
||||
{
|
||||
struct pic_senv *senv;
|
||||
pic_value a;
|
||||
|
||||
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
|
||||
senv->up = up;
|
||||
xh_init_int(&senv->renames, sizeof(pic_sym));
|
||||
|
||||
for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
|
||||
pic_value v = pic_car(pic, a);
|
||||
|
||||
if (! pic_sym_p(v)) {
|
||||
v = macroexpand(pic, v, up, assoc_box);
|
||||
}
|
||||
if (! pic_sym_p(v)) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
pic_add_rename(pic, senv, pic_sym(v));
|
||||
if (pic->lib && pic->lib->senv == senv) {
|
||||
pic_export(pic, sym);
|
||||
}
|
||||
if (! pic_sym_p(a)) {
|
||||
a = macroexpand(pic, a, up, assoc_box);
|
||||
}
|
||||
if (pic_sym_p(a)) {
|
||||
pic_add_rename(pic, senv, pic_sym(a));
|
||||
}
|
||||
else if (! pic_nil_p(a)) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
return senv;
|
||||
}
|
||||
|
||||
pic_sym
|
||||
|
@ -209,6 +160,39 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value ass
|
|||
return v;
|
||||
}
|
||||
|
||||
static struct pic_senv *
|
||||
push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value assoc_box)
|
||||
{
|
||||
struct pic_senv *senv;
|
||||
pic_value a;
|
||||
|
||||
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
|
||||
senv->up = up;
|
||||
xh_init_int(&senv->renames, sizeof(pic_sym));
|
||||
|
||||
for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
|
||||
pic_value v = pic_car(pic, a);
|
||||
|
||||
if (! pic_sym_p(v)) {
|
||||
v = macroexpand(pic, v, up, assoc_box);
|
||||
}
|
||||
if (! pic_sym_p(v)) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
pic_add_rename(pic, senv, pic_sym(v));
|
||||
}
|
||||
if (! pic_sym_p(a)) {
|
||||
a = macroexpand(pic, a, up, assoc_box);
|
||||
}
|
||||
if (pic_sym_p(a)) {
|
||||
pic_add_rename(pic, senv, pic_sym(a));
|
||||
}
|
||||
else if (! pic_nil_p(a)) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
return senv;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_value assoc_box)
|
||||
{
|
||||
|
@ -995,8 +979,7 @@ pic_init_macro(pic_state *pic)
|
|||
pic_deflibrary ("(picrin macro)") {
|
||||
|
||||
/* export define-macro syntax */
|
||||
pic_put_rename(pic, pic->lib->senv, pic->sDEFINE_MACRO, pic->sDEFINE_MACRO);
|
||||
pic_export(pic, pic->sDEFINE_MACRO);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_MACRO);
|
||||
|
||||
pic_defun(pic, "gensym", pic_macro_gensym);
|
||||
pic_defun(pic, "macroexpand", pic_macro_macroexpand);
|
||||
|
|
Loading…
Reference in New Issue