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

add new_senv

This commit is contained in:
Yuichi Nishiwaki 2014-02-12 10:48:44 +09:00
parent 9cf7d72e82
commit c759fee566
1 changed files with 44 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
src/macro.c
View File

@ -13,54 +13,18 @@
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *); static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *); static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *);
struct pic_senv * static struct pic_senv *
pic_null_syntactic_env(pic_state *pic) new_senv(pic_state *pic, struct pic_senv *up)
{ {
struct pic_senv *senv; struct pic_senv *senv;
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV); senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = NULL; senv->up = up;
senv->name = xh_new_int(); senv->name = xh_new_int();
return senv; return senv;
} }
#define register_core_syntax(pic,senv,id) do { \
pic_sym sym = pic_intern_cstr(pic, id); \
xh_put_int(senv->name, sym, sym); \
} while (0)
struct pic_senv *
pic_minimal_syntactic_env(pic_state *pic)
{
struct pic_senv *senv = pic_null_syntactic_env(pic);
register_core_syntax(pic, senv, "define-library");
register_core_syntax(pic, senv, "import");
register_core_syntax(pic, senv, "export");
return senv;
}
struct pic_senv *
pic_core_syntactic_env(pic_state *pic)
{
struct pic_senv *senv = pic_minimal_syntactic_env(pic);
register_core_syntax(pic, senv, "define");
register_core_syntax(pic, senv, "set!");
register_core_syntax(pic, senv, "quote");
register_core_syntax(pic, senv, "lambda");
register_core_syntax(pic, senv, "if");
register_core_syntax(pic, senv, "begin");
register_core_syntax(pic, senv, "define-macro");
register_core_syntax(pic, senv, "define-syntax");
return senv;
}
#undef register_core_syntax
static struct pic_senv * static struct pic_senv *
new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up) new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
{ {
@ -68,9 +32,7 @@ new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
pic_value a; pic_value a;
pic_sym sym; pic_sym sym;
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV); senv = new_senv(pic, up);
senv->up = up;
senv->name = xh_new_int();
for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) { for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
pic_value v = pic_car(pic, a); pic_value v = pic_car(pic, a);
@ -566,6 +528,46 @@ pic_macroexpand(pic_state *pic, pic_value expr)
return v; return v;
} }
struct pic_senv *
pic_null_syntactic_env(pic_state *pic)
{
return new_senv(pic, NULL);
}
#define register_core_syntax(pic,senv,id) do { \
pic_sym sym = pic_intern_cstr(pic, id); \
xh_put_int(senv->name, sym, sym); \
} while (0)
struct pic_senv *
pic_minimal_syntactic_env(pic_state *pic)
{
struct pic_senv *senv = pic_null_syntactic_env(pic);
register_core_syntax(pic, senv, "define-library");
register_core_syntax(pic, senv, "import");
register_core_syntax(pic, senv, "export");
return senv;
}
struct pic_senv *
pic_core_syntactic_env(pic_state *pic)
{
struct pic_senv *senv = pic_minimal_syntactic_env(pic);
register_core_syntax(pic, senv, "define");
register_core_syntax(pic, senv, "set!");
register_core_syntax(pic, senv, "quote");
register_core_syntax(pic, senv, "lambda");
register_core_syntax(pic, senv, "if");
register_core_syntax(pic, senv, "begin");
register_core_syntax(pic, senv, "define-macro");
register_core_syntax(pic, senv, "define-syntax");
return senv;
}
/* once read.c is implemented move there */ /* once read.c is implemented move there */
static pic_value static pic_value
pic_macro_include(pic_state *pic) pic_macro_include(pic_state *pic)