add make-syntactic-closure function

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 *);
 

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;
 

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);
+}