From 8729a98af7828db25e1b8c74678f3de0aa1e1fc5 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 16 Sep 2014 15:02:47 +0900 Subject: [PATCH] more preinterned symbols --- include/picrin.h | 3 +- lib.c | 34 +++++++--------- state.c | 100 ++++++++++++++++++++++++----------------------- 3 files changed, 68 insertions(+), 69 deletions(-) diff --git a/include/picrin.h b/include/picrin.h index 01c42da5..e726ee4c 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -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; diff --git a/lib.c b/lib.c index 404b8fcb..f9ccacdd 100644 --- a/lib.c +++ b/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; diff --git a/state.c b/state.c index d98ee2f2..2f859642 100644 --- a/state.c +++ b/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 */