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

add make-syntactic-closure function

This commit is contained in:
Yuichi Nishiwaki 2013-11-27 15:04:44 +09:00
parent ab74920a6f
commit 78cafe3db7
3 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
include/picrin/macro.h
View File

@ -37,6 +37,9 @@ struct pic_sc {
#define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v))
#define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX)
#define pic_senv(v) ((struct pic_senv *)pic_ptr(v))
#define pic_senv_p(v) (pic_type(v) == PIC_TT_SENV)
struct pic_syntax *pic_syntax_new(pic_state *, int kind, pic_sym sym);
struct pic_syntax *pic_syntax_new_macro(pic_state *, pic_sym, struct pic_proc *);

2
src/init.c
View File

@ -19,6 +19,7 @@ void pic_init_cont(pic_state *);
void pic_init_char(pic_state *);
void pic_init_error(pic_state *);
void pic_init_str(pic_state *);
void pic_init_macro(pic_state *);
void
pic_load_stdlib(pic_state *pic)
@ -107,6 +108,7 @@ pic_init_core(pic_state *pic)
pic_init_char(pic); DONE;
pic_init_error(pic); DONE;
pic_init_str(pic); DONE;
pic_init_macro(pic); DONE;
pic_load_stdlib(pic); DONE;

34
src/macro.c
View File

@ -89,6 +89,17 @@ pic_syntax_new_macro(pic_state *pic, pic_sym sym, struct pic_proc *macro)
return stx;
}
static struct pic_sc *
sc_new(pic_state *pic, pic_value expr, struct pic_senv *senv)
{
struct pic_sc *sc;
sc = (struct pic_sc *)pic_obj_alloc(pic, sizeof(struct pic_sc), PIC_TT_SC);
sc->expr = expr;
sc->senv = senv;
return sc;
}
void
pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
{
@ -326,3 +337,26 @@ pic_macroexpand(pic_state *pic, pic_value expr)
return v;
}
static pic_value
pic_make_sc(pic_state *pic)
{
pic_value senv, free_vars, expr;
struct pic_sc *sc;
pic_get_args(pic, "ooo", &senv, &free_vars, &expr);
if (! pic_senv_p(senv))
pic_error(pic, "make-syntactic-closure: senv required");
/* just ignore free_vars for now */
sc = sc_new(pic, expr, pic_senv(senv));
return pic_obj_value(sc);
}
void
pic_init_macro(pic_state *pic)
{
pic_defun(pic, "make-syntactic-closure", pic_make_sc);
}