From 78cafe3db7878d0bbf914d25162df8d315ab62bd Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 27 Nov 2013 15:04:44 +0900
Subject: [PATCH] add make-syntactic-closure function

---
 include/picrin/macro.h |  3 +++
 src/init.c             |  2 ++
 src/macro.c            | 34 ++++++++++++++++++++++++++++++++++
 3 files changed, 39 insertions(+)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index b6d33f68..038422de 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -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 *);
 
diff --git a/src/init.c b/src/init.c
index ae4f66b1..59b4bdd4 100644
--- a/src/init.c
+++ b/src/init.c
@@ -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;
 
diff --git a/src/macro.c b/src/macro.c
index e046acca..60843841 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -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);
+}