From d6b6376408a8fe0cb84723b5cc24fb42757c015d Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 19 Jul 2014 01:40:55 +0900
Subject: [PATCH] add pic_senv_new

---
 include/picrin/macro.h |  2 ++
 src/macro.c            | 22 ++++++++++++++--------
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index 758c6298..d655a735 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -32,6 +32,8 @@ struct pic_senv *pic_null_syntactic_environment(pic_state *);
 bool pic_identifier_p(pic_state *pic, pic_value obj);
 bool pic_identifier_eq_p(pic_state *, struct pic_senv *, pic_sym, struct pic_senv *, pic_sym);
 
+struct pic_senv *pic_senv_new(pic_state *, struct pic_senv *);
+
 pic_sym pic_add_rename(pic_state *, struct pic_senv *, pic_sym);
 bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym * /* = NULL */);
 void pic_put_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym);
diff --git a/src/macro.c b/src/macro.c
index 91da8b00..f0b079b7 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -210,9 +210,7 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
     pic_error(pic, "syntax error");
   }
 
-  in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-  in->up = senv;
-  xh_init_int(&in->map, sizeof(pic_sym));
+  in = pic_senv_new(pic, senv);
 
   for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
     pic_value v = pic_car(pic, a);
@@ -372,9 +370,7 @@ macroexpand_let_syntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
   pic_value formal, v, var, val;
   pic_sym sym, rename;
 
-  in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-  in->up = senv;
-  xh_init_int(&in->map, sizeof(pic_sym));
+  in = pic_senv_new(pic, senv);
 
   if (pic_length(pic, expr) < 2) {
     pic_error(pic, "syntax error");
@@ -563,14 +559,24 @@ pic_macroexpand(pic_state *pic, pic_value expr)
 }
 
 struct pic_senv *
-pic_null_syntactic_environment(pic_state *pic)
+pic_senv_new(pic_state *pic, struct pic_senv *up)
 {
   struct pic_senv *senv;
 
   senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-  senv->up = NULL;
+  senv->up = up;
   xh_init_int(&senv->map, sizeof(pic_sym));
 
+  return senv;
+}
+
+struct pic_senv *
+pic_null_syntactic_environment(pic_state *pic)
+{
+  struct pic_senv *senv;
+
+  senv = pic_senv_new(pic, NULL);
+
   pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY);
   pic_define_syntactic_keyword(pic, senv, pic->sIMPORT, pic->rIMPORT);
   pic_define_syntactic_keyword(pic, senv, pic->sEXPORT, pic->rEXPORT);