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

more preinterned symbols

This commit is contained in:
Yuichi Nishiwaki 2014-09-16 15:02:47 +09:00
parent ec0e5439af
commit 8729a98af7
3 changed files with 68 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
include/picrin.h
View File

@ -76,7 +76,8 @@ typedef struct {
pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_sym sDEFINE_SYNTAX, sIMPORT, sEXPORT; pic_sym sDEFINE_SYNTAX, sIMPORT, sEXPORT;
pic_sym sDEFINE_LIBRARY, sIN_LIBRARY; 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 sCONS, sCAR, sCDR, sNILP;
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS; pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT; pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;

34
lib.c
View File

@ -67,27 +67,26 @@ pic_find_library(pic_state *pic, pic_value spec)
static void static void
import_table(pic_state *pic, pic_value spec, xhash *imports) 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; struct pic_lib *lib;
xhash table; xhash table;
pic_value val; pic_value val;
pic_sym sym, id; pic_sym sym, id, tag;
xh_iter it; xh_iter it;
xh_init_int(&table, sizeof(pic_sym)); xh_init_int(&table, sizeof(pic_sym));
if (pic_list_p(spec)) { if (pic_pair_p(spec) && pic_sym_p(pic_car(pic, spec))) {
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sONLY))) {
tag = pic_sym(pic_car(pic, spec));
if (tag == pic->sONLY) {
import_table(pic, pic_cadr(pic, spec), &table); import_table(pic, pic_cadr(pic, spec), &table);
pic_for_each (val, pic_cddr(pic, spec)) { 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)); xh_put_int(imports, pic_sym(val), &xh_val(xh_get_int(&table, pic_sym(val)), pic_sym));
} }
goto exit; 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); import_table(pic, pic_cadr(pic, spec), imports);
pic_for_each (val, pic_cddr(pic, spec)) { pic_for_each (val, pic_cddr(pic, spec)) {
id = xh_val(xh_get_int(imports, pic_sym(pic_car(pic, val))), pic_sym); 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; 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); import_table(pic, pic_cadr(pic, spec), &table);
xh_begin(&it, &table); xh_begin(&it, &table);
while (xh_next(&it)) { while (xh_next(&it)) {
@ -106,7 +105,7 @@ import_table(pic_state *pic, pic_value spec, xhash *imports)
} }
goto exit; 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); import_table(pic, pic_cadr(pic, spec), imports);
pic_for_each (val, pic_cddr(pic, spec)) { pic_for_each (val, pic_cddr(pic, spec)) {
xh_del_int(imports, pic_sym(val)); xh_del_int(imports, pic_sym(val));
@ -209,15 +208,10 @@ pic_export(pic_state *pic, pic_sym sym)
static bool static bool
condexpand(pic_state *pic, pic_value clause) 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_sym tag;
pic_value c, feature; 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; return true;
} }
if (pic_sym_p(clause)) { if (pic_sym_p(clause)) {
@ -234,20 +228,20 @@ condexpand(pic_state *pic, pic_value clause)
tag = pic_sym(pic_car(pic, 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; 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)); return ! condexpand(pic, pic_list_ref(pic, clause, 1));
} }
if (tag == sAND) { if (tag == pic->sAND) {
pic_for_each (c, pic_cdr(pic, clause)) { pic_for_each (c, pic_cdr(pic, clause)) {
if (! condexpand(pic, c)) if (! condexpand(pic, c))
return false; return false;
} }
return true; return true;
} }
if (tag == sOR) { if (tag == pic->sOR) {
pic_for_each (c, pic_cdr(pic, clause)) { pic_for_each (c, pic_cdr(pic, clause)) {
if (condexpand(pic, c)) if (condexpand(pic, c))
return true; return true;

100
state.c
View File

@ -90,60 +90,64 @@ pic_open(int argc, char *argv[], char **envp)
/* native stack marker */ /* native stack marker */
pic->native_stack_start = &t; pic->native_stack_start = &t;
#define register_core_symbol(pic,slot,name) do { \ #define S(slot,name) pic->slot = pic_intern_cstr(pic, name);
pic->slot = pic_intern_cstr(pic, name); \
} while (0)
ai = pic_gc_arena_preserve(pic); ai = pic_gc_arena_preserve(pic);
register_core_symbol(pic, sDEFINE, "define"); S(sDEFINE, "define");
register_core_symbol(pic, sLAMBDA, "lambda"); S(sLAMBDA, "lambda");
register_core_symbol(pic, sIF, "if"); S(sIF, "if");
register_core_symbol(pic, sBEGIN, "begin"); S(sBEGIN, "begin");
register_core_symbol(pic, sSETBANG, "set!"); S(sSETBANG, "set!");
register_core_symbol(pic, sQUOTE, "quote"); S(sQUOTE, "quote");
register_core_symbol(pic, sQUASIQUOTE, "quasiquote"); S(sQUASIQUOTE, "quasiquote");
register_core_symbol(pic, sUNQUOTE, "unquote"); S(sUNQUOTE, "unquote");
register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing"); S(sUNQUOTE_SPLICING, "unquote-splicing");
register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax"); S(sDEFINE_SYNTAX, "define-syntax");
register_core_symbol(pic, sIMPORT, "import"); S(sIMPORT, "import");
register_core_symbol(pic, sEXPORT, "export"); S(sEXPORT, "export");
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library"); S(sDEFINE_LIBRARY, "define-library");
register_core_symbol(pic, sIN_LIBRARY, "in-library"); S(sIN_LIBRARY, "in-library");
register_core_symbol(pic, sCOND_EXPAND, "cond-expand"); S(sCOND_EXPAND, "cond-expand");
register_core_symbol(pic, sCONS, "cons"); S(sAND, "and");
register_core_symbol(pic, sCAR, "car"); S(sOR, "or");
register_core_symbol(pic, sCDR, "cdr"); S(sELSE, "else");
register_core_symbol(pic, sNILP, "null?"); S(sLIBRARY, "library");
register_core_symbol(pic, sADD, "+"); S(sONLY, "only");
register_core_symbol(pic, sSUB, "-"); S(sRENAME, "rename");
register_core_symbol(pic, sMUL, "*"); S(sPREFIX, "prefix");
register_core_symbol(pic, sDIV, "/"); S(sEXCEPT, "except");
register_core_symbol(pic, sMINUS, "minus"); S(sCONS, "cons");
register_core_symbol(pic, sEQ, "="); S(sCAR, "car");
register_core_symbol(pic, sLT, "<"); S(sCDR, "cdr");
register_core_symbol(pic, sLE, "<="); S(sNILP, "null?");
register_core_symbol(pic, sGT, ">"); S(sADD, "+");
register_core_symbol(pic, sGE, ">="); S(sSUB, "-");
register_core_symbol(pic, sNOT, "not"); 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); pic_gc_arena_restore(pic, ai);
#define register_renamed_symbol(pic,slot,name) do { \ #define R(slot,name) pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name));
pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name)); \
} while (0)
ai = pic_gc_arena_preserve(pic); ai = pic_gc_arena_preserve(pic);
register_renamed_symbol(pic, rDEFINE, "define"); R(rDEFINE, "define");
register_renamed_symbol(pic, rLAMBDA, "lambda"); R(rLAMBDA, "lambda");
register_renamed_symbol(pic, rIF, "if"); R(rIF, "if");
register_renamed_symbol(pic, rBEGIN, "begin"); R(rBEGIN, "begin");
register_renamed_symbol(pic, rSETBANG, "set!"); R(rSETBANG, "set!");
register_renamed_symbol(pic, rQUOTE, "quote"); R(rQUOTE, "quote");
register_renamed_symbol(pic, rDEFINE_SYNTAX, "define-syntax"); R(rDEFINE_SYNTAX, "define-syntax");
register_renamed_symbol(pic, rIMPORT, "import"); R(rIMPORT, "import");
register_renamed_symbol(pic, rEXPORT, "export"); R(rEXPORT, "export");
register_renamed_symbol(pic, rDEFINE_LIBRARY, "define-library"); R(rDEFINE_LIBRARY, "define-library");
register_renamed_symbol(pic, rIN_LIBRARY, "in-library"); R(rIN_LIBRARY, "in-library");
register_renamed_symbol(pic, rCOND_EXPAND, "cond-expand"); R(rCOND_EXPAND, "cond-expand");
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
/* root block */ /* root block */