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

remove pic_(minimal|core)_syntactic_env

This commit is contained in:
Yuichi Nishiwaki 2014-04-05 03:49:20 +09:00
parent 8ffaf8129c
commit b9125caa3d
4 changed files with 49 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/picrin/macro.h
View File

@ -37,8 +37,6 @@ struct pic_sc {
#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 *);
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 */);

23
src/init.c
View File

@ -85,14 +85,21 @@ 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_env(pic);
pic_put_rename(pic, pic->lib->senv, pic->sDEFINE, pic->sDEFINE);
pic_put_rename(pic, pic->lib->senv, pic->sSETBANG, pic->sSETBANG);
pic_put_rename(pic, pic->lib->senv, pic->sQUOTE, pic->sQUOTE);
pic_put_rename(pic, pic->lib->senv, pic->sLAMBDA, pic->sLAMBDA);
pic_put_rename(pic, pic->lib->senv, pic->sIF, pic->sIF);
pic_put_rename(pic, pic->lib->senv, pic->sBEGIN, pic->sBEGIN);
pic_put_rename(pic, pic->lib->senv, pic->sDEFINE_SYNTAX, pic->sDEFINE_SYNTAX);
pic_export(pic, pic->sDEFINE);
pic_export(pic, pic->sSETBANG);
pic_export(pic, pic->sQUOTE);
pic_export(pic, pic->sLAMBDA);
pic_export(pic, pic->sIF);
pic_export(pic, pic->sBEGIN);
pic_export(pic, pic->sDEFINE_SYNTAX);
pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE;

2
src/lib.c
View File

@ -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_env(pic);
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
lib->senv = senv;

92
src/macro.c
View File

@ -20,14 +20,6 @@ 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);
@ -35,57 +27,6 @@ pic_minimal_syntactic_env(pic_state *pic)
return senv;
}
struct pic_senv *
pic_core_syntactic_env(pic_state *pic)
{
struct pic_senv *senv = pic_minimal_syntactic_env(pic);
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_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
pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
{
@ -209,6 +150,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)
{