add pic_null_syntactic_env and pic_minimal_syntactic_env

This commit is contained in:
Yuichi Nishiwaki 2013-12-07 07:04:26 -08:00
parent b70aa8a21c
commit 1ac5b6458c
2 changed files with 25 additions and 1 deletions

View File

@ -46,6 +46,8 @@ struct pic_sc {
#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)
struct pic_senv *pic_null_syntactic_env(pic_state *pic);
struct pic_senv *pic_minimal_syntactic_env(pic_state *pic);
struct pic_senv *pic_core_syntactic_env(pic_state *pic); struct pic_senv *pic_core_syntactic_env(pic_state *pic);
struct pic_syntax *pic_syntax_new(pic_state *, int kind, pic_sym sym); struct pic_syntax *pic_syntax_new(pic_state *, int kind, pic_sym sym);

View File

@ -31,7 +31,7 @@ new_uniq_sym(pic_state *pic, pic_sym base)
} }
struct pic_senv * struct pic_senv *
pic_core_syntactic_env(pic_state *pic) pic_null_syntactic_env(pic_state *pic)
{ {
struct pic_senv *senv; struct pic_senv *senv;
@ -42,12 +42,32 @@ pic_core_syntactic_env(pic_state *pic)
senv->xlen = 0; senv->xlen = 0;
senv->xcapa = PIC_MACROS_SIZE; senv->xcapa = PIC_MACROS_SIZE;
return senv;
}
#define register_core_syntax(pic,senv,kind,name) do { \ #define register_core_syntax(pic,senv,kind,name) do { \
senv->stx[senv->xlen] = pic_syntax_new(pic, kind, pic_intern_cstr(pic, name)); \ senv->stx[senv->xlen] = pic_syntax_new(pic, kind, pic_intern_cstr(pic, name)); \
xh_put(senv->tbl, name, ~senv->xlen); \ xh_put(senv->tbl, name, ~senv->xlen); \
senv->xlen++; \ senv->xlen++; \
} while (0) } 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, PIC_STX_DEFLIBRARY, "define-library");
register_core_syntax(pic, senv, PIC_STX_IMPORT, "import");
register_core_syntax(pic, senv, PIC_STX_EXPORT, "export");
return senv;
}
struct pic_senv *
pic_core_syntactic_env(pic_state *pic)
{
struct pic_senv *senv = pic_null_syntactic_env(pic);
register_core_syntax(pic, senv, PIC_STX_DEFINE, "define"); register_core_syntax(pic, senv, PIC_STX_DEFINE, "define");
register_core_syntax(pic, senv, PIC_STX_SET, "set!"); register_core_syntax(pic, senv, PIC_STX_SET, "set!");
register_core_syntax(pic, senv, PIC_STX_QUOTE, "quote"); register_core_syntax(pic, senv, PIC_STX_QUOTE, "quote");
@ -63,6 +83,8 @@ pic_core_syntactic_env(pic_state *pic)
return senv; return senv;
} }
#undef register_core_syntax
static struct pic_senv * static struct pic_senv *
new_global_senv(pic_state *pic) new_global_senv(pic_state *pic)
{ {