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

leave core syntax keywords renamed

This commit is contained in:
Yuichi Nishiwaki 2014-07-14 10:08:11 +09:00
parent fda89b1604
commit 5faa7cd46d
6 changed files with 62 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
include/picrin.h
View File

@ -87,6 +87,11 @@ typedef struct {
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;
pic_sym rDEFINE, rLAMBDA, rIF, rBEGIN, rQUOTE, rSETBANG;
pic_sym rDEFINE_SYNTAX, rDEFINE_MACRO;
pic_sym rLET_SYNTAX, rLETREC_SYNTAX;
pic_sym rDEFINE_LIBRARY, rIMPORT, rEXPORT;
xhash syms; /* name to symbol */ xhash syms; /* name to symbol */
xhash sym_names; /* symbol to name */ xhash sym_names; /* symbol to name */
int sym_cnt; int sym_cnt;

2
include/picrin/macro.h
View File

@ -42,7 +42,7 @@ pic_sym pic_add_rename(pic_state *, struct pic_senv *, pic_sym);
bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym * /* = NULL */); bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym * /* = NULL */);
void pic_put_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym); void pic_put_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym);
void pic_define_syntactic_keyword(pic_state *, struct pic_senv *, pic_sym); void pic_define_syntactic_keyword(pic_state *, struct pic_senv *, pic_sym, pic_sym);
#if defined(__cplusplus) #if defined(__cplusplus)
} }

16
src/codegen.c
View File

@ -366,7 +366,7 @@ analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_v
: pic_false_value(); : pic_false_value();
/* To know what kind of local variables are defined, analyze body at first. */ /* To know what kind of local variables are defined, analyze body at first. */
body = analyze(state, pic_cons(pic, pic_sym_value(pic->sBEGIN), body_exprs), true); body = analyze(state, pic_cons(pic, pic_sym_value(pic->rBEGIN), body_exprs), true);
locals = pic_nil_value(); locals = pic_nil_value();
for (i = scope->locals.size; i > 0; --i) { for (i = scope->locals.size; i > 0; --i) {
@ -535,7 +535,7 @@ analyze_quote(analyze_state *state, pic_value obj)
if (pic_length(pic, obj) != 2) { if (pic_length(pic, obj) != 2) {
pic_error(pic, "syntax error"); pic_error(pic, "syntax error");
} }
return obj; return pic_list2(pic, pic_sym_value(pic->sQUOTE), pic_list_ref(pic, obj, 1));
} }
#define ARGC_ASSERT_GE(n) do { \ #define ARGC_ASSERT_GE(n) do { \
@ -727,22 +727,22 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
if (pic_sym_p(proc)) { if (pic_sym_p(proc)) {
pic_sym sym = pic_sym(proc); pic_sym sym = pic_sym(proc);
if (sym == pic->sDEFINE) { if (sym == pic->rDEFINE) {
return analyze_define(state, obj); return analyze_define(state, obj);
} }
else if (sym == pic->sLAMBDA) { else if (sym == pic->rLAMBDA) {
return analyze_lambda(state, obj); return analyze_lambda(state, obj);
} }
else if (sym == pic->sIF) { else if (sym == pic->rIF) {
return analyze_if(state, obj, tailpos); return analyze_if(state, obj, tailpos);
} }
else if (sym == pic->sBEGIN) { else if (sym == pic->rBEGIN) {
return analyze_begin(state, obj, tailpos); return analyze_begin(state, obj, tailpos);
} }
else if (sym == pic->sSETBANG) { else if (sym == pic->rSETBANG) {
return analyze_set(state, obj); return analyze_set(state, obj);
} }
else if (sym == pic->sQUOTE) { else if (sym == pic->rQUOTE) {
return analyze_quote(state, obj); return analyze_quote(state, obj);
} }
else if (sym == state->rCONS) { else if (sym == state->rCONS) {

18
src/init.c
View File

@ -68,15 +68,15 @@ pic_init_core(pic_state *pic)
/* load core syntaces */ /* load core syntaces */
pic->lib->senv = pic_null_syntactic_environment(pic); pic->lib->senv = pic_null_syntactic_environment(pic);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE, pic->rDEFINE);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sSETBANG); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sSETBANG, pic->rSETBANG);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sQUOTE); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sQUOTE, pic->rQUOTE);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLAMBDA); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLAMBDA, pic->rLAMBDA);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sIF); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sIF, pic->rIF);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sBEGIN); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sBEGIN, pic->rBEGIN);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_SYNTAX); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_SYNTAX, pic->rDEFINE_SYNTAX);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLET_SYNTAX); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLET_SYNTAX, pic->rLET_SYNTAX);
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLETREC_SYNTAX); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLETREC_SYNTAX, pic->rLETREC_SYNTAX);
pic_init_bool(pic); DONE; pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE; pic_init_pair(pic); DONE;

38
src/macro.c
View File

@ -104,7 +104,7 @@ macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pi
static pic_value static pic_value
macroexpand_quote(pic_state *pic, pic_value expr) macroexpand_quote(pic_state *pic, pic_value expr)
{ {
return pic_cons(pic, pic_sym_value(pic->sQUOTE), pic_cdr(pic, expr)); return pic_cons(pic, pic_sym_value(pic->rQUOTE), pic_cdr(pic, expr));
} }
static pic_value static pic_value
@ -242,7 +242,7 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
formal = macroexpand_list(pic, pic_cadr(pic, expr), in, cxt); formal = macroexpand_list(pic, pic_cadr(pic, expr), in, cxt);
body = macroexpand_list(pic, pic_cddr(pic, expr), in, cxt); body = macroexpand_list(pic, pic_cddr(pic, expr), in, cxt);
return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body)); return pic_cons(pic, pic_sym_value(pic->rLAMBDA), pic_cons(pic, formal, body));
} }
static pic_value static pic_value
@ -280,7 +280,7 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
} else { } else {
val = macroexpand(pic, pic_car(pic, body), senv, cxt); val = macroexpand(pic, pic_car(pic, body), senv, cxt);
} }
return pic_list3(pic, pic_sym_value(pic->sDEFINE), macroexpand_symbol(pic, sym, senv, cxt), val); return pic_list3(pic, pic_sym_value(pic->rDEFINE), macroexpand_symbol(pic, sym, senv, cxt), val);
} }
static pic_value static pic_value
@ -406,7 +406,7 @@ macroexpand_let_syntax(pic_state *pic, pic_value expr, struct pic_senv *senv, st
} }
define_macro(pic, rename, pic_proc_ptr(val), senv); define_macro(pic, rename, pic_proc_ptr(val), senv);
} }
return pic_cons(pic, pic_sym_value(pic->sBEGIN), macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)); return pic_cons(pic, pic_sym_value(pic->rBEGIN), macroexpand_list(pic, pic_cddr(pic, expr), in, cxt));
} }
static pic_value static pic_value
@ -470,34 +470,34 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct p
if (pic_sym_p(car)) { if (pic_sym_p(car)) {
pic_sym tag = pic_sym(car); pic_sym tag = pic_sym(car);
if (tag == pic->sDEFINE_LIBRARY) { if (tag == pic->rDEFINE_LIBRARY) {
return macroexpand_deflibrary(pic, expr); return macroexpand_deflibrary(pic, expr);
} }
else if (tag == pic->sIMPORT) { else if (tag == pic->rIMPORT) {
return macroexpand_import(pic, expr); return macroexpand_import(pic, expr);
} }
else if (tag == pic->sEXPORT) { else if (tag == pic->rEXPORT) {
return macroexpand_export(pic, expr); return macroexpand_export(pic, expr);
} }
else if (tag == pic->sDEFINE_SYNTAX) { else if (tag == pic->rDEFINE_SYNTAX) {
return macroexpand_defsyntax(pic, expr, senv, cxt); return macroexpand_defsyntax(pic, expr, senv, cxt);
} }
else if (tag == pic->sDEFINE_MACRO) { else if (tag == pic->rDEFINE_MACRO) {
return macroexpand_defmacro(pic, expr, senv); return macroexpand_defmacro(pic, expr, senv);
} }
else if (tag == pic->sLET_SYNTAX) { else if (tag == pic->rLET_SYNTAX) {
return macroexpand_let_syntax(pic, expr, senv, cxt); return macroexpand_let_syntax(pic, expr, senv, cxt);
} }
/* else if (tag == pic->sLETREC_SYNTAX) { */ /* else if (tag == pic->sLETREC_SYNTAX) { */
/* return macroexpand_letrec_syntax(pic, expr, senv, cxt); */ /* return macroexpand_letrec_syntax(pic, expr, senv, cxt); */
/* } */ /* } */
else if (tag == pic->sLAMBDA) { else if (tag == pic->rLAMBDA) {
return macroexpand_lambda(pic, expr, senv, cxt); return macroexpand_lambda(pic, expr, senv, cxt);
} }
else if (tag == pic->sDEFINE) { else if (tag == pic->rDEFINE) {
return macroexpand_define(pic, expr, senv, cxt); return macroexpand_define(pic, expr, senv, cxt);
} }
else if (tag == pic->sQUOTE) { else if (tag == pic->rQUOTE) {
return macroexpand_quote(pic, expr); return macroexpand_quote(pic, expr);
} }
@ -582,17 +582,17 @@ pic_null_syntactic_environment(pic_state *pic)
senv->up = NULL; senv->up = NULL;
xh_init_int(&senv->renames, sizeof(pic_sym)); xh_init_int(&senv->renames, sizeof(pic_sym));
pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY); pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY);
pic_define_syntactic_keyword(pic, senv, pic->sIMPORT); pic_define_syntactic_keyword(pic, senv, pic->sIMPORT, pic->rIMPORT);
pic_define_syntactic_keyword(pic, senv, pic->sEXPORT); pic_define_syntactic_keyword(pic, senv, pic->sEXPORT, pic->rEXPORT);
return senv; return senv;
} }
void void
pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym) pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym rsym)
{ {
pic_put_rename(pic, senv, sym, sym); pic_put_rename(pic, senv, sym, rsym);
if (pic->lib && pic->lib->senv == senv) { if (pic->lib && pic->lib->senv == senv) {
pic_export(pic, sym); pic_export(pic, sym);
@ -944,7 +944,7 @@ pic_init_macro(pic_state *pic)
pic_deflibrary ("(picrin macro)") { pic_deflibrary ("(picrin macro)") {
/* export define-macro syntax */ /* export define-macro syntax */
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_MACRO); pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_MACRO, pic->rDEFINE_MACRO);
pic_defun(pic, "gensym", pic_macro_gensym); pic_defun(pic, "gensym", pic_macro_gensym);
pic_defun(pic, "macroexpand", pic_macro_macroexpand); pic_defun(pic, "macroexpand", pic_macro_macroexpand);

20
src/state.c
View File

@ -118,6 +118,26 @@ pic_open(int argc, char *argv[], char **envp)
register_core_symbol(pic, sNOT, "not"); register_core_symbol(pic, sNOT, "not");
pic_gc_arena_restore(pic, ai); 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)
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, rDEFINE_MACRO, "define-macro");
register_renamed_symbol(pic, rLET_SYNTAX, "let-syntax");
register_renamed_symbol(pic, rLETREC_SYNTAX, "letrec-syntax");
register_renamed_symbol(pic, rDEFINE_LIBRARY, "define-library");
register_renamed_symbol(pic, rIMPORT, "import");
register_renamed_symbol(pic, rEXPORT, "export");
pic_gc_arena_restore(pic, ai);
pic_init_core(pic); pic_init_core(pic);
/* set library */ /* set library */