From a32473ae92d1aa8b242d5297b27ac6e22d0bb459 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:32:05 -0800
Subject: [PATCH] add core syntaces in pic_open

---
 include/picrin/macro.h |  2 ++
 src/macro.c            | 22 +++-------------------
 src/state.c            | 13 +++++++++++++
 3 files changed, 18 insertions(+), 19 deletions(-)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index 0167631c..75257708 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -24,4 +24,6 @@ struct pic_syntax {
 #define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v))
 #define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX)
 
+struct pic_syntax *pic_syntax_new(pic_state *, int kind, pic_sym sym);
+
 #endif
diff --git a/src/macro.c b/src/macro.c
index 8f769d64..84552119 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -375,7 +375,7 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv)
   return pic_cons(pic, v, macroexpand_list(pic, pic_cdr(pic, list), senv));
 }
 
-static struct pic_syntax *
+struct pic_syntax *
 pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
 {
   struct pic_syntax *stx;
@@ -390,27 +390,11 @@ pic_value
 pic_macroexpand_2(pic_state *pic, pic_value expr)
 {
   struct pic_senv *senv;
-  struct pic_syntax **stx;
 
   senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
   senv->up = NULL;
-  senv->tbl = xh_new();
-  senv->stx = NULL;
-  stx = (struct pic_syntax **)pic_alloc(pic, sizeof(struct pic_syntax *) * 6);
-  stx[0] = pic_syntax_new(pic, PIC_STX_DEFINE, pic->sDEFINE);
-  stx[1] = pic_syntax_new(pic, PIC_STX_SET, pic->sSETBANG);
-  stx[2] = pic_syntax_new(pic, PIC_STX_QUOTE, pic->sQUOTE);
-  stx[3] = pic_syntax_new(pic, PIC_STX_LAMBDA, pic->sLAMBDA);
-  stx[4] = pic_syntax_new(pic, PIC_STX_IF, pic->sIF);
-  stx[5] = pic_syntax_new(pic, PIC_STX_BEGIN, pic->sBEGIN);
-  senv->stx = stx;
-
-  xh_put(senv->tbl, "define", ~0);
-  xh_put(senv->tbl, "set!", ~1);
-  xh_put(senv->tbl, "quote", ~2);
-  xh_put(senv->tbl, "lambda", ~3);
-  xh_put(senv->tbl, "if", ~4);
-  xh_put(senv->tbl, "begin", ~5);
+  senv->tbl = pic->var_tbl;
+  senv->stx = pic->stx;
 
   return macroexpand(pic, expr, senv);
 }
diff --git a/src/state.c b/src/state.c
index 80367cab..5525bf90 100644
--- a/src/state.c
+++ b/src/state.c
@@ -118,6 +118,19 @@ pic_open(int argc, char *argv[], char **envp)
   register_core_symbol(pic, sGT, ">");
   register_core_symbol(pic, sGE, ">=");
   pic_gc_arena_restore(pic, ai);
+
+#define register_core_syntax(pic,kind,name) do {			\
+    pic->stx[pic->xlen] = pic_syntax_new(pic, kind, pic_intern_cstr(pic, name)); \
+    xh_put(pic->global_tbl, name, ~pic->xlen);				\
+    pic->xlen++;							\
+  } while (0)
+
+  register_core_syntax(pic, PIC_STX_DEFINE, "define");
+  register_core_syntax(pic, PIC_STX_SET, "set!");
+  register_core_syntax(pic, PIC_STX_QUOTE, "quote");
+  register_core_syntax(pic, PIC_STX_LAMBDA, "lambda");
+  register_core_syntax(pic, PIC_STX_IF, "if");
+  register_core_syntax(pic, PIC_STX_BEGIN, "begin");
   pic_gc_arena_restore(pic, ai);
 
   pic_init_core(pic);