more preinterned symbols
This commit is contained in:
parent
ec0e5439af
commit
8729a98af7
|
@ -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
34
lib.c
|
@ -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
100
state.c
|
@ -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 */
|
||||||
|
|
Loading…
Reference in New Issue