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

remove internal defmacro expander

This commit is contained in:
Yuichi Nishiwaki 2014-07-20 11:15:12 +09:00
parent 240c5d9ac4
commit c43120077c
3 changed files with 2 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
include/picrin.h
View File

@ -80,14 +80,14 @@ typedef struct {
pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO, sLET_SYNTAX;
pic_sym sDEFINE_SYNTAX, sLET_SYNTAX;
pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT;
pic_sym sCONS, sCAR, sCDR, sNILP;
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
pic_sym rDEFINE, rLAMBDA, rIF, rBEGIN, rQUOTE, rSETBANG;
pic_sym rDEFINE_SYNTAX, rDEFINE_MACRO, rLET_SYNTAX;
pic_sym rDEFINE_SYNTAX, rLET_SYNTAX;
pic_sym rDEFINE_LIBRARY, rIMPORT, rEXPORT;
xhash syms; /* name to symbol */

54
src/macro.c
View File

@ -316,53 +316,6 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
return pic_none_value();
}
static pic_value
macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_senv *senv)
{
pic_value var, val;
pic_sym sym, rename;
if (pic_length(pic, expr) < 2) {
pic_error(pic, "syntax error");
}
var = pic_car(pic, pic_cdr(pic, expr));
if (pic_pair_p(var)) {
/* FIXME: unhygienic */
val = pic_cons(pic, pic_sym_value(pic->sLAMBDA),
pic_cons(pic, pic_cdr(pic, var),
pic_cdr(pic, pic_cdr(pic, expr))));
var = pic_car(pic, var);
}
else {
if (pic_length(pic, expr) != 3) {
pic_error(pic, "syntax_error");
}
val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, expr)));
}
if (! pic_sym_p(var)) {
pic_error(pic, "syntax error");
}
sym = pic_sym(var);
if (! pic_find_rename(pic, senv, sym, &rename)) {
rename = pic_add_rename(pic, senv, sym);
}
pic_try {
val = pic_eval(pic, val);
} pic_catch {
pic_errorf(pic, "macroexpand error while definition: %s", pic_errmsg(pic));
}
if (! pic_proc_p(val)) {
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
}
define_macro(pic, rename, pic_proc_ptr(val), NULL);
return pic_none_value();
}
static pic_value
macroexpand_let_syntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
{
@ -471,9 +424,6 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
else if (tag == pic->rDEFINE_SYNTAX) {
return macroexpand_defsyntax(pic, expr, senv);
}
else if (tag == pic->rDEFINE_MACRO) {
return macroexpand_defmacro(pic, expr, senv);
}
else if (tag == pic->rLET_SYNTAX) {
return macroexpand_let_syntax(pic, expr, senv);
}
@ -693,10 +643,6 @@ void
pic_init_macro(pic_state *pic)
{
pic_deflibrary ("(picrin macro)") {
/* export define-macro syntax */
pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_MACRO, pic->rDEFINE_MACRO);
pic_defun(pic, "gensym", pic_macro_gensym);
pic_defun(pic, "macroexpand", pic_macro_macroexpand);
pic_defun(pic, "identifier?", pic_macro_identifier_p);

2
src/state.c
View File

@ -95,7 +95,6 @@ pic_open(int argc, char *argv[], char **envp)
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, sDEFINE_MACRO, "define-macro");
register_core_symbol(pic, sLET_SYNTAX, "let-syntax");
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
register_core_symbol(pic, sIMPORT, "import");
@ -129,7 +128,6 @@ pic_open(int argc, char *argv[], char **envp)
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, rDEFINE_LIBRARY, "define-library");
register_renamed_symbol(pic, rIMPORT, "import");