more preinterned symbols
This commit is contained in:
Yuichi Nishiwaki
parent
ec0e5439af
commit
8729a98af7
|
|
@ -76,7 +76,8 @@ typedef struct {
|
|||
pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
|
||||
pic_sym sDEFINE_SYNTAX, sIMPORT, sEXPORT;
|
||||
pic_sym sDEFINE_LIBRARY, sIN_LIBRARY;
|
||||
pic_sym sCOND_EXPAND;
|
||||
pic_sym sCOND_EXPAND, sAND, sOR, sELSE, sLIBRARY;
|
||||
pic_sym sONLY, sRENAME, sPREFIX, sEXCEPT;
|
||||
pic_sym sCONS, sCAR, sCDR, sNILP;
|
||||
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
|
||||
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
|
||||
|
|
|
|||
34
lib.c
34
lib.c
|
|
@ -67,27 +67,26 @@ pic_find_library(pic_state *pic, pic_value spec)
|
|||
static void
|
||||
import_table(pic_state *pic, pic_value spec, xhash *imports)
|
||||
{
|
||||
const pic_sym sONLY = pic_intern_cstr(pic, "only");
|
||||
const pic_sym sRENAME = pic_intern_cstr(pic, "rename");
|
||||
const pic_sym sPREFIX = pic_intern_cstr(pic, "prefix");
|
||||
const pic_sym sEXCEPT = pic_intern_cstr(pic, "except");
|
||||
struct pic_lib *lib;
|
||||
xhash table;
|
||||
pic_value val;
|
||||
pic_sym sym, id;
|
||||
pic_sym sym, id, tag;
|
||||
xh_iter it;
|
||||
|
||||
xh_init_int(&table, sizeof(pic_sym));
|
||||
|
||||
if (pic_list_p(spec)) {
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sONLY))) {
|
||||
if (pic_pair_p(spec) && pic_sym_p(pic_car(pic, spec))) {
|
||||
|
||||
tag = pic_sym(pic_car(pic, spec));
|
||||
|
||||
if (tag == pic->sONLY) {
|
||||
import_table(pic, pic_cadr(pic, spec), &table);
|
||||
pic_for_each (val, pic_cddr(pic, spec)) {
|
||||
xh_put_int(imports, pic_sym(val), &xh_val(xh_get_int(&table, pic_sym(val)), pic_sym));
|
||||
}
|
||||
goto exit;
|
||||
}
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
|
||||
if (tag == pic->sRENAME) {
|
||||
import_table(pic, pic_cadr(pic, spec), imports);
|
||||
pic_for_each (val, pic_cddr(pic, spec)) {
|
||||
id = xh_val(xh_get_int(imports, pic_sym(pic_car(pic, val))), pic_sym);
|
||||
|
|
@ -96,7 +95,7 @@ import_table(pic_state *pic, pic_value spec, xhash *imports)
|
|||
}
|
||||
goto exit;
|
||||
}
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sPREFIX))) {
|
||||
if (tag == pic->sPREFIX) {
|
||||
import_table(pic, pic_cadr(pic, spec), &table);
|
||||
xh_begin(&it, &table);
|
||||
while (xh_next(&it)) {
|
||||
|
|
@ -106,7 +105,7 @@ import_table(pic_state *pic, pic_value spec, xhash *imports)
|
|||
}
|
||||
goto exit;
|
||||
}
|
||||
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sEXCEPT))) {
|
||||
if (tag == pic->sEXCEPT) {
|
||||
import_table(pic, pic_cadr(pic, spec), imports);
|
||||
pic_for_each (val, pic_cddr(pic, spec)) {
|
||||
xh_del_int(imports, pic_sym(val));
|
||||
|
|
@ -209,15 +208,10 @@ pic_export(pic_state *pic, pic_sym sym)
|
|||
static bool
|
||||
condexpand(pic_state *pic, pic_value clause)
|
||||
{
|
||||
const pic_sym sELSE = pic_intern_cstr(pic, "else");
|
||||
const pic_sym sLIBRARY = pic_intern_cstr(pic, "library");
|
||||
const pic_sym sOR = pic_intern_cstr(pic, "or");
|
||||
const pic_sym sAND = pic_intern_cstr(pic, "and");
|
||||
const pic_sym sNOT = pic_intern_cstr(pic, "not");
|
||||
pic_sym tag;
|
||||
pic_value c, feature;
|
||||
|
||||
if (pic_eq_p(clause, pic_sym_value(sELSE))) {
|
||||
if (pic_eq_p(clause, pic_sym_value(pic->sELSE))) {
|
||||
return true;
|
||||
}
|
||||
if (pic_sym_p(clause)) {
|
||||
|
|
@ -234,20 +228,20 @@ condexpand(pic_state *pic, pic_value clause)
|
|||
tag = pic_sym(pic_car(pic, clause));
|
||||
}
|
||||
|
||||
if (tag == sLIBRARY) {
|
||||
if (tag == pic->sLIBRARY) {
|
||||
return pic_find_library(pic, pic_list_ref(pic, clause, 1)) != NULL;
|
||||
}
|
||||
if (tag == sNOT) {
|
||||
if (tag == pic->sNOT) {
|
||||
return ! condexpand(pic, pic_list_ref(pic, clause, 1));
|
||||
}
|
||||
if (tag == sAND) {
|
||||
if (tag == pic->sAND) {
|
||||
pic_for_each (c, pic_cdr(pic, clause)) {
|
||||
if (! condexpand(pic, c))
|
||||
return false;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
if (tag == sOR) {
|
||||
if (tag == pic->sOR) {
|
||||
pic_for_each (c, pic_cdr(pic, clause)) {
|
||||
if (condexpand(pic, c))
|
||||
return true;
|
||||
|
|
|
|||
100
state.c
100
state.c
|
|
@ -90,60 +90,64 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
/* native stack marker */
|
||||
pic->native_stack_start = &t;
|
||||
|
||||
#define register_core_symbol(pic,slot,name) do { \
|
||||
pic->slot = pic_intern_cstr(pic, name); \
|
||||
} while (0)
|
||||
#define S(slot,name) pic->slot = pic_intern_cstr(pic, name);
|
||||
|
||||
ai = pic_gc_arena_preserve(pic);
|
||||
register_core_symbol(pic, sDEFINE, "define");
|
||||
register_core_symbol(pic, sLAMBDA, "lambda");
|
||||
register_core_symbol(pic, sIF, "if");
|
||||
register_core_symbol(pic, sBEGIN, "begin");
|
||||
register_core_symbol(pic, sSETBANG, "set!");
|
||||
register_core_symbol(pic, sQUOTE, "quote");
|
||||
register_core_symbol(pic, sQUASIQUOTE, "quasiquote");
|
||||
register_core_symbol(pic, sUNQUOTE, "unquote");
|
||||
register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing");
|
||||
register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax");
|
||||
register_core_symbol(pic, sIMPORT, "import");
|
||||
register_core_symbol(pic, sEXPORT, "export");
|
||||
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
|
||||
register_core_symbol(pic, sIN_LIBRARY, "in-library");
|
||||
register_core_symbol(pic, sCOND_EXPAND, "cond-expand");
|
||||
register_core_symbol(pic, sCONS, "cons");
|
||||
register_core_symbol(pic, sCAR, "car");
|
||||
register_core_symbol(pic, sCDR, "cdr");
|
||||
register_core_symbol(pic, sNILP, "null?");
|
||||
register_core_symbol(pic, sADD, "+");
|
||||
register_core_symbol(pic, sSUB, "-");
|
||||
register_core_symbol(pic, sMUL, "*");
|
||||
register_core_symbol(pic, sDIV, "/");
|
||||
register_core_symbol(pic, sMINUS, "minus");
|
||||
register_core_symbol(pic, sEQ, "=");
|
||||
register_core_symbol(pic, sLT, "<");
|
||||
register_core_symbol(pic, sLE, "<=");
|
||||
register_core_symbol(pic, sGT, ">");
|
||||
register_core_symbol(pic, sGE, ">=");
|
||||
register_core_symbol(pic, sNOT, "not");
|
||||
S(sDEFINE, "define");
|
||||
S(sLAMBDA, "lambda");
|
||||
S(sIF, "if");
|
||||
S(sBEGIN, "begin");
|
||||
S(sSETBANG, "set!");
|
||||
S(sQUOTE, "quote");
|
||||
S(sQUASIQUOTE, "quasiquote");
|
||||
S(sUNQUOTE, "unquote");
|
||||
S(sUNQUOTE_SPLICING, "unquote-splicing");
|
||||
S(sDEFINE_SYNTAX, "define-syntax");
|
||||
S(sIMPORT, "import");
|
||||
S(sEXPORT, "export");
|
||||
S(sDEFINE_LIBRARY, "define-library");
|
||||
S(sIN_LIBRARY, "in-library");
|
||||
S(sCOND_EXPAND, "cond-expand");
|
||||
S(sAND, "and");
|
||||
S(sOR, "or");
|
||||
S(sELSE, "else");
|
||||
S(sLIBRARY, "library");
|
||||
S(sONLY, "only");
|
||||
S(sRENAME, "rename");
|
||||
S(sPREFIX, "prefix");
|
||||
S(sEXCEPT, "except");
|
||||
S(sCONS, "cons");
|
||||
S(sCAR, "car");
|
||||
S(sCDR, "cdr");
|
||||
S(sNILP, "null?");
|
||||
S(sADD, "+");
|
||||
S(sSUB, "-");
|
||||
S(sMUL, "*");
|
||||
S(sDIV, "/");
|
||||
S(sMINUS, "minus");
|
||||
S(sEQ, "=");
|
||||
S(sLT, "<");
|
||||
S(sLE, "<=");
|
||||
S(sGT, ">");
|
||||
S(sGE, ">=");
|
||||
S(sNOT, "not");
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
|
||||
#define register_renamed_symbol(pic,slot,name) do { \
|
||||
pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name)); \
|
||||
} while (0)
|
||||
#define R(slot,name) pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name));
|
||||
|
||||
ai = pic_gc_arena_preserve(pic);
|
||||
register_renamed_symbol(pic, rDEFINE, "define");
|
||||
register_renamed_symbol(pic, rLAMBDA, "lambda");
|
||||
register_renamed_symbol(pic, rIF, "if");
|
||||
register_renamed_symbol(pic, rBEGIN, "begin");
|
||||
register_renamed_symbol(pic, rSETBANG, "set!");
|
||||
register_renamed_symbol(pic, rQUOTE, "quote");
|
||||
register_renamed_symbol(pic, rDEFINE_SYNTAX, "define-syntax");
|
||||
register_renamed_symbol(pic, rIMPORT, "import");
|
||||
register_renamed_symbol(pic, rEXPORT, "export");
|
||||
register_renamed_symbol(pic, rDEFINE_LIBRARY, "define-library");
|
||||
register_renamed_symbol(pic, rIN_LIBRARY, "in-library");
|
||||
register_renamed_symbol(pic, rCOND_EXPAND, "cond-expand");
|
||||
R(rDEFINE, "define");
|
||||
R(rLAMBDA, "lambda");
|
||||
R(rIF, "if");
|
||||
R(rBEGIN, "begin");
|
||||
R(rSETBANG, "set!");
|
||||
R(rQUOTE, "quote");
|
||||
R(rDEFINE_SYNTAX, "define-syntax");
|
||||
R(rIMPORT, "import");
|
||||
R(rEXPORT, "export");
|
||||
R(rDEFINE_LIBRARY, "define-library");
|
||||
R(rIN_LIBRARY, "in-library");
|
||||
R(rCOND_EXPAND, "cond-expand");
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
|
||||
/* root block */
|
||||
|
|
|
|||
Loading…
Reference in New Issue