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

reimplement identifier=? in scheme

This commit is contained in:
Yuichi Nishiwaki 2014-07-26 14:54:44 +09:00
parent 317ea10006
commit f922a7a0cd
2 changed files with 6 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
piclib/picrin/macro.scm
View File

@ -30,6 +30,10 @@
(dictionary-set! cache sym val)
val))))
(define (identifier=? env1 sym1 env2 sym2)
(eq? (make-identifier sym1 env1)
(make-identifier sym2 env2)))
(define (make-syntactic-closure env free form)
(define resolve
@ -123,7 +127,8 @@
(cons (cdr formal)
body)))))))
(export make-syntactic-closure
(export identifier=?
make-syntactic-closure
close-syntax
capture-syntactic-environment
sc-macro-transformer

31
src/macro.c
View File

@ -532,15 +532,6 @@ pic_identifier_p(pic_state *pic, pic_value obj)
return pic_sym_p(obj) && ! pic_interned_p(pic, pic_sym(obj));
}
bool
pic_identifier_eq_p(pic_state *pic, struct pic_senv *e1, pic_sym x, struct pic_senv *e2, pic_sym y)
{
x = make_identifier(pic, x, e1);
y = make_identifier(pic, y, e2);
return x == y;
}
static pic_value
pic_macro_gensym(pic_state *pic)
{
@ -599,27 +590,6 @@ pic_macro_identifier_p(pic_state *pic)
return pic_bool_value(pic_identifier_p(pic, obj));
}
static pic_value
pic_macro_identifier_eq_p(pic_state *pic)
{
pic_sym x, y;
pic_value e, f;
struct pic_senv *e1, *e2;
pic_get_args(pic, "omom", &e, &x, &f, &y);
if (! pic_senv_p(e)) {
pic_error(pic, "unexpected type of argument 1");
}
e1 = pic_senv_ptr(e);
if (! pic_senv_p(f)) {
pic_error(pic, "unexpected type of argument 3");
}
e2 = pic_senv_ptr(f);
return pic_bool_value(pic_identifier_eq_p(pic, e1, x, e2, y));
}
static pic_value
pic_macro_make_identifier(pic_state *pic)
{
@ -642,7 +612,6 @@ pic_init_macro(pic_state *pic)
pic_defun(pic, "macroexpand", pic_macro_macroexpand);
pic_defun(pic, "macroexpand-1", pic_macro_macroexpand_1);
pic_defun(pic, "identifier?", pic_macro_identifier_p);
pic_defun(pic, "identifier=?", pic_macro_identifier_eq_p);
pic_defun(pic, "make-identifier", pic_macro_make_identifier);
}
}