From 72cf45d4eabd2716143b8399dc9082359a35d7f2 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 25 Nov 2013 23:38:39 -0800
Subject: [PATCH 01/34] add `new_uniq_sym` function

---
 include/picrin.h |  1 +
 src/macro.c      | 17 +++++++++++++++++
 src/state.c      |  1 +
 3 files changed, 19 insertions(+)

diff --git a/include/picrin.h b/include/picrin.h
index 7588ec61..b9a2190a 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -50,6 +50,7 @@ typedef struct {
   struct xhash *sym_tbl;
   const char **sym_pool;
   size_t slen, scapa;
+  int uniq_sym_count;
 
   /* positive for variables, negative for macros (bitwise-not) */
   struct xhash *global_tbl;
diff --git a/src/macro.c b/src/macro.c
index ff716c42..f3d0262b 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -1,5 +1,7 @@
 #include <stdio.h>
 #include <assert.h>
+#include <string.h>
+#include <math.h>
 
 #include "picrin.h"
 #include "picrin/pair.h"
@@ -190,3 +192,18 @@ pic_macroexpand(pic_state *pic, pic_value obj)
 
   return v;
 }
+
+static pic_sym
+new_uniq_sym(pic_state *pic, pic_sym base)
+{
+  int s = pic->uniq_sym_count++;
+  char *str;
+  pic_sym uniq;
+
+  str = (char *)pic_alloc(pic, strlen(pic_symbol_name(pic, base)), + (int)log10(s) + 2);
+  sprintf(str, "%s@%d", pic_symbol_name(pic, base), s);
+  uniq = pic_intern_cstr(pic, str);
+
+  pic_free(pic, str);
+  return uniq;
+}
diff --git a/src/state.c b/src/state.c
index d8db2f75..ea212174 100644
--- a/src/state.c
+++ b/src/state.c
@@ -51,6 +51,7 @@ pic_open(int argc, char *argv[], char **envp)
   pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *));
   pic->slen = 0;
   pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
+  pic->uniq_sym_count = 0;
 
   /* irep */
   pic->irep = (struct pic_irep **)calloc(PIC_IREP_SIZE, sizeof(struct pic_irep *));

From bf6a337a5f943ed69e3f7f3ba0890c28365b0c64 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 02:42:13 -0800
Subject: [PATCH 02/34] add pic_cxxr functions

---
 include/picrin/pair.h |  5 +++++
 src/pair.c            | 24 ++++++++++++++++++++++++
 2 files changed, 29 insertions(+)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index 28c722bf..5fd18e62 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -15,4 +15,9 @@ pic_value pic_reverse(pic_state *, pic_value);
 pic_value pic_assq(pic_state *, pic_value key, pic_value assoc);
 pic_value pic_acons(pic_state *, pic_value key, pic_value val, pic_value assoc);
 
+pic_value pic_caar(pic_state *, pic_value);
+pic_value pic_cadr(pic_state *, pic_value);
+pic_value pic_cdar(pic_state *, pic_value);
+pic_value pic_cddr(pic_state *, pic_value);
+
 #endif
diff --git a/src/pair.c b/src/pair.c
index c1c78af1..193d4c77 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -134,6 +134,30 @@ pic_acons(pic_state *pic, pic_value key, pic_value val, pic_value assoc)
   return pic_cons(pic, pic_cons(pic, key, val), assoc);
 }
 
+pic_value
+pic_caar(pic_state *pic, pic_value v)
+{
+  return pic_car(pic, pic_car(pic, v));
+}
+
+pic_value
+pic_cadr(pic_state *pic, pic_value v)
+{
+  return pic_car(pic, pic_cdr(pic, v));
+}
+
+pic_value
+pic_cdar(pic_state *pic, pic_value v)
+{
+  return pic_cdr(pic, pic_car(pic, v));
+}
+
+pic_value
+pic_cddr(pic_state *pic, pic_value v)
+{
+  return pic_cdr(pic, pic_cdr(pic, v));
+}
+
 static pic_value
 pic_pair_pair_p(pic_state *pic)
 {

From 3c65025394525ac2e7789997a478502705078d1f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 04:03:52 -0800
Subject: [PATCH 03/34] add macro.h

---
 include/picrin/macro.h | 27 +++++++++++++++++++++++++++
 src/macro.c            |  1 +
 2 files changed, 28 insertions(+)
 create mode 100644 include/picrin/macro.h

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
new file mode 100644
index 00000000..0167631c
--- /dev/null
+++ b/include/picrin/macro.h
@@ -0,0 +1,27 @@
+#ifndef MACRO_H__
+#define MACRO_H__
+
+struct pic_senv {
+  PIC_OBJECT_HEADER
+  struct pic_senv *up;
+  struct xhash *tbl;
+  struct pic_syntax **stx;
+};
+
+struct pic_syntax {
+  PIC_OBJECT_HEADER
+  enum {
+    PIC_STX_DEFINE,
+    PIC_STX_SET,
+    PIC_STX_QUOTE,
+    PIC_STX_LAMBDA,
+    PIC_STX_IF,
+    PIC_STX_BEGIN
+  } kind;
+  pic_sym sym;
+};
+
+#define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v))
+#define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX)
+
+#endif
diff --git a/src/macro.c b/src/macro.c
index f3d0262b..72f4caa1 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -6,6 +6,7 @@
 #include "picrin.h"
 #include "picrin/pair.h"
 #include "picrin/proc.h"
+#include "picrin/macro.h"
 #include "xhash/xhash.h"
 
 #define FALLTHROUGH ((void)0)

From c59d8f601b9e5c412837dee76f0118a8c057a0ae Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 04:05:02 -0800
Subject: [PATCH 04/34] add PIC_TT_SENV and PIC_TT_SYNTAX

---
 include/picrin/value.h |  4 +++-
 src/codegen.c          |  4 +++-
 src/gc.c               | 30 ++++++++++++++++++++++++++++++
 src/macro.c            |  2 ++
 src/port.c             |  6 ++++++
 5 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/include/picrin/value.h b/include/picrin/value.h
index 42354c78..d14b8a51 100644
--- a/include/picrin/value.h
+++ b/include/picrin/value.h
@@ -89,7 +89,9 @@ enum pic_tt {
   PIC_TT_PORT,
   PIC_TT_ERROR,
   PIC_TT_ENV,
-  PIC_TT_CONT
+  PIC_TT_CONT,
+  PIC_TT_SENV,
+  PIC_TT_SYNTAX
 };
 
 #define PIC_OBJECT_HEADER			\
diff --git a/src/codegen.c b/src/codegen.c
index 6aac14b5..57340867 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -658,7 +658,9 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
   case PIC_TT_UNDEF:
   case PIC_TT_EOF:
   case PIC_TT_PORT:
-  case PIC_TT_ERROR: {
+  case PIC_TT_ERROR:
+  case PIC_TT_SENV:
+  case PIC_TT_SYNTAX: {
     pic_error(pic, "invalid expression given");
   }
   }
diff --git a/src/gc.c b/src/gc.c
index 1c9fddef..23aa1560 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -8,6 +8,8 @@
 #include "picrin/blob.h"
 #include "picrin/cont.h"
 #include "picrin/error.h"
+#include "picrin/macro.h"
+#include "xhash/xhash.h"
 
 #if GC_DEBUG
 # include <stdio.h>
@@ -273,6 +275,24 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     gc_mark(pic, cont->result);
     break;
   }
+  case PIC_TT_SYNTAX: {
+    break;
+  }
+  case PIC_TT_SENV: {
+    struct pic_senv *senv = (struct pic_senv *)obj;
+
+    if (senv->up) {
+      gc_mark_object(pic, (struct pic_object *)senv->up);
+    }
+    if (senv->stx) {
+      int i;
+
+      for (i = 0; i < 6; ++i) {
+	gc_mark_object(pic, (struct pic_object *)senv->stx[i]);
+      }
+    }
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
@@ -397,6 +417,16 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     PIC_BLK_DECREF(pic, cont->blk);
     break;
   }
+  case PIC_TT_SENV: {
+    struct pic_senv *senv = (struct pic_senv *)obj;
+    xh_destory(senv->tbl);
+    if (senv->stx)
+      pic_free(pic, senv->stx);
+    break;
+  }
+  case PIC_TT_SYNTAX: {
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
diff --git a/src/macro.c b/src/macro.c
index 72f4caa1..dca9b8bc 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -162,6 +162,8 @@ expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
   case PIC_TT_ENV:
   case PIC_TT_CONT:
   case PIC_TT_UNDEF:
+  case PIC_TT_SENV:
+  case PIC_TT_SYNTAX:
     pic_error(pic, "unexpected value type");
     return pic_undef_value();	/* unreachable */
   }
diff --git a/src/port.c b/src/port.c
index 0c3709fd..06a2f5f9 100644
--- a/src/port.c
+++ b/src/port.c
@@ -97,6 +97,12 @@ write(pic_state *pic, pic_value obj)
   case PIC_TT_CONT:
     printf("#<cont %p>", pic_ptr(obj));
     break;
+  case PIC_TT_SENV:
+    printf("#<senv %p>", pic_ptr(obj));
+    break;
+  case PIC_TT_SYNTAX:
+    printf("#<senv %p>", pic_ptr(obj));
+    break;
   }
 }
 

From b7f0f3dfb33c91933748c8e736e3d1af32a9f545 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 04:05:37 -0800
Subject: [PATCH 05/34] [bugfix] get rid of a comma

---
 src/macro.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index dca9b8bc..0c930eea 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -203,7 +203,7 @@ new_uniq_sym(pic_state *pic, pic_sym base)
   char *str;
   pic_sym uniq;
 
-  str = (char *)pic_alloc(pic, strlen(pic_symbol_name(pic, base)), + (int)log10(s) + 2);
+  str = (char *)pic_alloc(pic, strlen(pic_symbol_name(pic, base)) + (int)log10(s) + 2);
   sprintf(str, "%s@%d", pic_symbol_name(pic, base), s);
   uniq = pic_intern_cstr(pic, str);
 

From 573ba797827b41b5fa021a049aa7cc4972fa0972 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 04:06:03 -0800
Subject: [PATCH 06/34] [bugfix] log10 must not be given 0

---
 src/macro.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index 0c930eea..0ce04855 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -199,7 +199,7 @@ pic_macroexpand(pic_state *pic, pic_value obj)
 static pic_sym
 new_uniq_sym(pic_state *pic, pic_sym base)
 {
-  int s = pic->uniq_sym_count++;
+  int s = ++pic->uniq_sym_count;
   char *str;
   pic_sym uniq;
 

From 1ad562f1a8485e2aea651b3d52044222beb1db0b Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 04:06:46 -0800
Subject: [PATCH 07/34] [wip] add renamer

---
 src/macro.c | 196 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 196 insertions(+)

diff --git a/src/macro.c b/src/macro.c
index 0ce04855..05bb585d 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -210,3 +210,199 @@ new_uniq_sym(pic_state *pic, pic_sym base)
   pic_free(pic, str);
   return uniq;
 }
+
+static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *);
+
+static pic_value
+macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
+{
+  int ai = pic_gc_arena_preserve(pic);
+
+  switch (pic_type(expr)) {
+  case PIC_TT_SYMBOL: {
+    struct xh_entry *e;
+    while (senv) {
+      if ((e = xh_get(senv->tbl, pic_symbol_name(pic, pic_sym(expr)))) != NULL) {
+	if (e->val >= 0)
+	  return pic_symbol_value((pic_sym)e->val);
+	else
+	  return pic_obj_value(senv->stx[~e->val]);
+      }
+      senv = senv->up;
+    }
+    return expr;
+  }
+  case PIC_TT_PAIR: {
+    pic_value car, v;
+
+    if (! pic_list_p(pic, expr))
+      return expr;
+
+    car = macroexpand(pic, pic_car(pic, expr), senv);
+    if (pic_syntax_p(car)) {
+      switch (pic_syntax(car)->kind) {
+      case PIC_STX_LAMBDA: {
+	struct pic_senv *in;
+	pic_value a;
+
+	in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
+	in->up = senv;
+	in->tbl = xh_new();
+	in->stx = NULL;
+
+	for (a = pic_cadr(pic, expr); ! pic_nil_p(a); a = pic_cdr(pic, a)) {
+	  pic_sym gen, orig;
+
+	  orig = pic_sym(pic_car(pic, a));
+	  gen = new_uniq_sym(pic, orig);
+	  xh_put(senv->tbl, pic_symbol_name(pic, orig), (int)gen);
+	}
+
+	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
+		     pic_cons(pic,
+			      macroexpand_list(pic, pic_cadr(pic, expr), in),
+			      macroexpand_list(pic, pic_cddr(pic, expr), in)));
+
+	pic_gc_arena_restore(pic, ai);
+	pic_gc_protect(pic, v);
+	return v;
+      }
+      case PIC_STX_DEFINE: {
+	pic_sym uniq;
+	pic_value var;
+	struct pic_senv *in = senv;
+
+	if (pic_length(pic, expr) < 2) {
+	  pic_error(pic, "syntax error");
+	}
+
+	var = pic_car(pic, pic_cdr(pic, expr));
+	if (pic_pair_p(var)) {
+	  pic_value a;
+
+	  in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
+	  in->up = senv;
+	  in->tbl = xh_new();
+	  in->stx = NULL;
+
+	  for (a = var; pic_pair_p(a); a = pic_cdr(pic, a)) {
+	    pic_sym gen, orig;
+
+	    orig = pic_sym(pic_car(pic, a));
+	    gen = new_uniq_sym(pic, orig);
+	    xh_put(senv->tbl, pic_symbol_name(pic, orig), (int)gen);
+	  }
+	  if (pic_symbol_p(a)) {
+	    xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
+	  }
+
+	  v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
+		       pic_cons(pic,
+				macroexpand_list(pic, pic_cadr(pic, expr), in),
+				macroexpand_list(pic, pic_cddr(pic, expr), in)));
+	  pic_gc_arena_restore(pic, ai);
+	  pic_gc_protect(pic, v);
+	  return v;
+	}
+
+	uniq = new_uniq_sym(pic, pic_sym(var));
+	xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(var)), (int)uniq);
+      }
+	FALLTHROUGH;
+      case PIC_STX_SET:
+      case PIC_STX_IF:
+      case PIC_STX_BEGIN:
+	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), macroexpand_list(pic, pic_cdr(pic, expr), senv));
+	pic_gc_arena_restore(pic, ai);
+	pic_gc_protect(pic, v);
+	return v;
+      case PIC_STX_QUOTE:
+	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), pic_cdr(pic, expr));
+	pic_gc_arena_restore(pic, ai);
+	pic_gc_protect(pic, v);
+	return v;
+      }
+    }
+
+    v = pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv));
+    pic_gc_arena_restore(pic, ai);
+    pic_gc_protect(pic, v);
+    return v;
+  }
+  case PIC_TT_EOF:
+  case PIC_TT_NIL:
+  case PIC_TT_BOOL:
+  case PIC_TT_FLOAT:
+  case PIC_TT_INT:
+  case PIC_TT_CHAR:
+  case PIC_TT_STRING:
+  case PIC_TT_VECTOR:
+  case PIC_TT_BLOB: {
+    return expr;
+  }
+  case PIC_TT_PROC:
+  case PIC_TT_PORT:
+  case PIC_TT_ERROR:
+  case PIC_TT_ENV:
+  case PIC_TT_CONT:
+  case PIC_TT_UNDEF:
+  case PIC_TT_SENV:
+  case PIC_TT_SYNTAX:
+    pic_error(pic, "unexpected value type");
+    return pic_undef_value();	/* unreachable */
+  }
+  /* suppress warnings, never be called */
+  abort();
+}
+
+static pic_value
+macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv)
+{
+  pic_value v;
+
+  if (pic_nil_p(list))
+    return list;
+
+  v = macroexpand(pic, pic_car(pic, list), senv);
+  return pic_cons(pic, v, macroexpand_list(pic, pic_cdr(pic, list), senv));
+}
+
+static struct pic_syntax *
+pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
+{
+  struct pic_syntax *stx;
+
+  stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
+  stx->kind = kind;
+  stx->sym = sym;
+  return stx;
+}
+
+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);
+
+  return macroexpand(pic, expr, senv);
+}

From ad3c268f81e5379cdf56367eec198706688de5cf Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 04:08:46 -0800
Subject: [PATCH 08/34] insert renamer pass after old macroexpansion phase

---
 src/macro.c | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/src/macro.c b/src/macro.c
index 05bb585d..8f769d64 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -171,6 +171,8 @@ expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
   abort();
 }
 
+pic_value pic_macroexpand_2(pic_state *, pic_value);
+
 pic_value
 pic_macroexpand(pic_state *pic, pic_value obj)
 {
@@ -193,6 +195,12 @@ pic_macroexpand(pic_state *pic, pic_value obj)
   puts("");
 #endif
 
+  v = pic_macroexpand_2(pic, v);
+#if DEBUG
+  puts("after expand:");
+  pic_debug(pic, v);
+  puts("");
+#endif
   return v;
 }
 

From 673b66a723ac960831c58852778da27f27a67075 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 06:40:48 -0800
Subject: [PATCH 09/34] use register_core_symbol macro to initialize pic_state

---
 src/state.c | 52 ++++++++++++++++++++++++++++------------------------
 1 file changed, 28 insertions(+), 24 deletions(-)

diff --git a/src/state.c b/src/state.c
index ea212174..a9218430 100644
--- a/src/state.c
+++ b/src/state.c
@@ -82,31 +82,35 @@ pic_open(int argc, char *argv[], char **envp)
   /* native stack marker */
   pic->native_stack_start = &t;
 
+#define register_core_symbol(pic,slot,name) do {	\
+    pic->slot = pic_intern_cstr(pic, name);		\
+  } while (0)
+
   ai = pic_gc_arena_preserve(pic);
-  pic->sDEFINE = pic_intern_cstr(pic, "define");
-  pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
-  pic->sIF = pic_intern_cstr(pic, "if");
-  pic->sBEGIN = pic_intern_cstr(pic, "begin");
-  pic->sSETBANG = pic_intern_cstr(pic, "set!");
-  pic->sQUOTE = pic_intern_cstr(pic, "quote");
-  pic->sQUASIQUOTE = pic_intern_cstr(pic, "quasiquote");
-  pic->sUNQUOTE = pic_intern_cstr(pic, "unquote");
-  pic->sUNQUOTE_SPLICING = pic_intern_cstr(pic, "unquote-splicing");
-  pic->sDEFINE_SYNTAX = pic_intern_cstr(pic, "define-syntax");
-  pic->sDEFINE_MACRO = pic_intern_cstr(pic, "define-macro");
-  pic->sCONS = pic_intern_cstr(pic, "cons");
-  pic->sCAR = pic_intern_cstr(pic, "car");
-  pic->sCDR = pic_intern_cstr(pic, "cdr");
-  pic->sNILP = pic_intern_cstr(pic, "null?");
-  pic->sADD = pic_intern_cstr(pic, "+");
-  pic->sSUB = pic_intern_cstr(pic, "-");
-  pic->sMUL = pic_intern_cstr(pic, "*");
-  pic->sDIV = pic_intern_cstr(pic, "/");
-  pic->sEQ = pic_intern_cstr(pic, "=");
-  pic->sLT = pic_intern_cstr(pic, "<");
-  pic->sLE = pic_intern_cstr(pic, "<=");
-  pic->sGT = pic_intern_cstr(pic, ">");
-  pic->sGE = pic_intern_cstr(pic, ">=");
+  register_core_symbol(pic, sDEFINE, "define");
+  register_core_symbol(pic, sLAMBDA, "lambda");
+  register_core_symbol(pic, sIF, "if");
+  register_core_symbol(pic, sBEGIN, "begin");
+  register_core_symbol(pic, sSETBANG, "set!");
+  register_core_symbol(pic, sQUOTE, "quote");
+  register_core_symbol(pic, sQUASIQUOTE, "quasiquote");
+  register_core_symbol(pic, sUNQUOTE, "unquote");
+  register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing");
+  register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax");
+  register_core_symbol(pic, sCONS, "cons");
+  register_core_symbol(pic, sCAR, "car");
+  register_core_symbol(pic, sCDR, "cdr");
+  register_core_symbol(pic, sNILP, "null?");
+  register_core_symbol(pic, sADD, "+");
+  register_core_symbol(pic, sSUB, "-");
+  register_core_symbol(pic, sMUL, "*");
+  register_core_symbol(pic, sDIV, "/");
+  register_core_symbol(pic, sEQ, "=");
+  register_core_symbol(pic, sLT, "<");
+  register_core_symbol(pic, sLE, "<=");
+  register_core_symbol(pic, sGT, ">");
+  register_core_symbol(pic, sGE, ">=");
+  pic_gc_arena_restore(pic, ai);
   pic_gc_arena_restore(pic, ai);
 
   pic_init_core(pic);

From bfa8b84b0ec4a0d1e70495b5d210f56d103fdf31 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:23:45 -0800
Subject: [PATCH 10/34] [xhash] use strdup if possible

---
 extlib/xhash/xhash.h | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/extlib/xhash/xhash.h b/extlib/xhash/xhash.h
index 3566e5d9..038d4027 100644
--- a/extlib/xhash/xhash.h
+++ b/extlib/xhash/xhash.h
@@ -62,8 +62,7 @@ xh_get(struct xhash *x, const char *key)
 static inline struct xh_entry *
 xh_put(struct xhash *x, const char *key, int val)
 {
-  int idx, len;
-  char *new_key;
+  int idx;
   struct xh_entry *e;
 
   if ((e = xh_get(x, key))) {
@@ -71,14 +70,10 @@ xh_put(struct xhash *x, const char *key, int val)
     return e;
   }
 
-  len = strlen(key);
-  new_key = (char *)malloc(len+1);
-  strcpy(new_key, key);
-
   idx = xh_hash(key) % x->size;
   e = (struct xh_entry *)malloc(sizeof(struct xh_entry));
   e->next = x->buckets[idx];
-  e->key = new_key;
+  e->key = strdup(key);
   e->val = val;
 
   return x->buckets[idx] = e;

From ce3e2b939c893668f6ed844328def91509f2bd82 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:23:58 -0800
Subject: [PATCH 11/34] [xhash] cleanpu

---
 extlib/xhash/xhash.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extlib/xhash/xhash.h b/extlib/xhash/xhash.h
index 038d4027..b20af2c3 100644
--- a/extlib/xhash/xhash.h
+++ b/extlib/xhash/xhash.h
@@ -53,7 +53,7 @@ xh_get(struct xhash *x, const char *key)
 
   idx = xh_hash(key) % x->size;
   for (e = x->buckets[idx]; e; e = e->next) {
-    if (! strcmp(key, e->key))
+    if (strcmp(key, e->key) == 0)
       return e;
   }
   return NULL;

From a2e1f21b2960b728033d35adf97fa5d249918c84 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:30:30 -0800
Subject: [PATCH 12/34] add global identifier table

---
 include/picrin.h | 6 +++++-
 src/gc.c         | 2 ++
 src/state.c      | 7 +++++++
 3 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/include/picrin.h b/include/picrin.h
index b9a2190a..f71fae63 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -52,13 +52,17 @@ typedef struct {
   size_t slen, scapa;
   int uniq_sym_count;
 
-  /* positive for variables, negative for macros (bitwise-not) */
   struct xhash *global_tbl;
   pic_value *globals;
   size_t glen, gcapa;
   struct pic_proc **macros;
   size_t mlen, mcapa;
 
+  /* positive for variables, negative for macros (bitwise-not) */
+  struct xhash *var_tbl;
+  struct pic_syntax **stx;
+  size_t xlen, xcapa;
+
   struct pic_irep **irep;
   size_t ilen, icapa;
   pic_value *pool;
diff --git a/src/gc.c b/src/gc.c
index 23aa1560..fc2f38f2 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -357,6 +357,8 @@ gc_mark_phase(pic_state *pic)
   /* macros */
   for (i = 0; i < pic->mlen; ++i) {
     gc_mark_object(pic, (struct pic_object *)pic->macros[i]);
+  for (i = 0; i < pic->xlen; ++i) {
+    gc_mark_object(pic, (struct pic_object *)pic->stx[i]);
   }
 
   /* pool */
diff --git a/src/state.c b/src/state.c
index a9218430..80367cab 100644
--- a/src/state.c
+++ b/src/state.c
@@ -3,6 +3,7 @@
 #include "picrin.h"
 #include "picrin/gc.h"
 #include "picrin/proc.h"
+#include "picrin/macro.h"
 #include "xhash/xhash.h"
 
 void pic_init_core(pic_state *);
@@ -67,6 +68,12 @@ pic_open(int argc, char *argv[], char **envp)
   pic->mlen = 0;
   pic->mcapa = PIC_MACROS_SIZE;
 
+  /* identifier table */
+  pic->var_tbl = xh_new();
+  pic->stx = (struct pic_syntax **)calloc(PIC_MACROS_SIZE, sizeof(struct pic_syntax *));
+  pic->xlen = 0;
+  pic->xcapa = PIC_MACROS_SIZE;
+
   /* pool */
   pic->pool = (pic_value *)calloc(PIC_POOL_SIZE, sizeof(pic_value));
   pic->plen = 0;

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 13/34] 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);

From f6bc51d16de097baa8352e1f300901a181cd1f36 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:36:58 -0800
Subject: [PATCH 14/34] add xlen/xcapa member to pic_senv

---
 include/picrin/macro.h | 1 +
 src/gc.c               | 2 +-
 src/macro.c            | 4 ++++
 3 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index 75257708..5dcf2c5d 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -6,6 +6,7 @@ struct pic_senv {
   struct pic_senv *up;
   struct xhash *tbl;
   struct pic_syntax **stx;
+  size_t xlen, xcapa;
 };
 
 struct pic_syntax {
diff --git a/src/gc.c b/src/gc.c
index fc2f38f2..2264d5bc 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -287,7 +287,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     if (senv->stx) {
       int i;
 
-      for (i = 0; i < 6; ++i) {
+      for (i = 0; i < senv->xlen; ++i) {
 	gc_mark_object(pic, (struct pic_object *)senv->stx[i]);
       }
     }
diff --git a/src/macro.c b/src/macro.c
index 84552119..cac35c3d 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -292,6 +292,8 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	  in->up = senv;
 	  in->tbl = xh_new();
 	  in->stx = NULL;
+	  in->xlen = 0;
+	  in->xcapa = 0;
 
 	  for (a = var; pic_pair_p(a); a = pic_cdr(pic, a)) {
 	    pic_sym gen, orig;
@@ -395,6 +397,8 @@ pic_macroexpand_2(pic_state *pic, pic_value expr)
   senv->up = NULL;
   senv->tbl = pic->var_tbl;
   senv->stx = pic->stx;
+  senv->xlen = pic->xlen;
+  senv->xcapa = pic->xcapa;
 
   return macroexpand(pic, expr, senv);
 }

From 3009473d52017f363eec4630a04677ec114e2ee9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:38:26 -0800
Subject: [PATCH 15/34] debug prints for macroexpand

---
 src/macro.c | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index cac35c3d..b379aed0 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -392,6 +392,7 @@ pic_value
 pic_macroexpand_2(pic_state *pic, pic_value expr)
 {
   struct pic_senv *senv;
+  pic_value v;
 
   senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
   senv->up = NULL;
@@ -400,5 +401,19 @@ pic_macroexpand_2(pic_state *pic, pic_value expr)
   senv->xlen = pic->xlen;
   senv->xcapa = pic->xcapa;
 
-  return macroexpand(pic, expr, senv);
+#if DEBUG
+  puts("before expand:");
+  pic_debug(pic, expr);
+  puts("");
+#endif
+
+  v = macroexpand(pic, expr, senv);
+
+#if DEBUG
+  puts("after expand:");
+  pic_debug(pic, v);
+  puts("");
+#endif
+
+  return v;
 }

From ddbc2c83a2fb2151866150b08812c0dd5d261e95 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:39:37 -0800
Subject: [PATCH 16/34] add missing core symbol registration

---
 src/state.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/state.c b/src/state.c
index 5525bf90..fe6c7695 100644
--- a/src/state.c
+++ b/src/state.c
@@ -104,6 +104,7 @@ pic_open(int argc, char *argv[], char **envp)
   register_core_symbol(pic, sUNQUOTE, "unquote");
   register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing");
   register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax");
+  register_core_symbol(pic, sDEFINE_MACRO, "define-macro");
   register_core_symbol(pic, sCONS, "cons");
   register_core_symbol(pic, sCAR, "car");
   register_core_symbol(pic, sCDR, "cdr");

From 3d1f74d8f5e7b912d9b2124ca66acdf80b7c850c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:41:01 -0800
Subject: [PATCH 17/34] add 'define-macro' core syntax

---
 include/picrin/macro.h | 3 ++-
 src/state.c            | 1 +
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index 5dcf2c5d..1dd6cd81 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -17,7 +17,8 @@ struct pic_syntax {
     PIC_STX_QUOTE,
     PIC_STX_LAMBDA,
     PIC_STX_IF,
-    PIC_STX_BEGIN
+    PIC_STX_BEGIN,
+    PIC_STX_DEFMACRO
   } kind;
   pic_sym sym;
 };
diff --git a/src/state.c b/src/state.c
index fe6c7695..68d9c891 100644
--- a/src/state.c
+++ b/src/state.c
@@ -132,6 +132,7 @@ pic_open(int argc, char *argv[], char **envp)
   register_core_syntax(pic, PIC_STX_LAMBDA, "lambda");
   register_core_syntax(pic, PIC_STX_IF, "if");
   register_core_syntax(pic, PIC_STX_BEGIN, "begin");
+  register_core_syntax(pic, PIC_STX_DEFMACRO, "define-macro");
   pic_gc_arena_restore(pic, ai);
 
   pic_init_core(pic);

From 1f3f7c99a2890fde5febffe81bf47d51f6f929f8 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:42:13 -0800
Subject: [PATCH 18/34] save macro procesures in each syntax object

---
 include/picrin/macro.h |  3 +++
 src/gc.c               |  5 +++++
 src/macro.c            | 13 +++++++++++++
 3 files changed, 21 insertions(+)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index 1dd6cd81..672feb73 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -18,14 +18,17 @@ struct pic_syntax {
     PIC_STX_LAMBDA,
     PIC_STX_IF,
     PIC_STX_BEGIN,
+    PIC_STX_MACRO,
     PIC_STX_DEFMACRO
   } kind;
   pic_sym sym;
+  struct pic_proc *macro;
 };
 
 #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);
+struct pic_syntax *pic_syntax_new_macro(pic_state *, pic_sym, struct pic_proc *);
 
 #endif
diff --git a/src/gc.c b/src/gc.c
index 2264d5bc..c12a1633 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -276,6 +276,11 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_SYNTAX: {
+    struct pic_syntax *stx = (struct pic_syntax *)obj;
+
+    if (stx->macro) {
+      gc_mark_object(pic, (struct pic_object *)stx->macro);
+    }
     break;
   }
   case PIC_TT_SENV: {
diff --git a/src/macro.c b/src/macro.c
index b379aed0..e4825e39 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -385,6 +385,19 @@ pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
   stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
   stx->kind = kind;
   stx->sym = sym;
+  stx->macro = NULL;
+  return stx;
+}
+
+struct pic_syntax *
+pic_syntax_new_macro(pic_state *pic, pic_sym sym, struct pic_proc *macro)
+{
+  struct pic_syntax *stx;
+
+  stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
+  stx->kind = PIC_STX_MACRO;
+  stx->sym = sym;
+  stx->macro = macro;
   return stx;
 }
 

From be311cb96fb953ab0e0311c98fbc94ab4407b399 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:43:58 -0800
Subject: [PATCH 19/34] replace old macroexpand facility with new renamer
 implementation

---
 include/picrin.h |   2 -
 src/gc.c         |   2 -
 src/macro.c      | 242 +++++++++++------------------------------------
 src/state.c      |   3 -
 4 files changed, 57 insertions(+), 192 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index f71fae63..40c27b36 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -55,8 +55,6 @@ typedef struct {
   struct xhash *global_tbl;
   pic_value *globals;
   size_t glen, gcapa;
-  struct pic_proc **macros;
-  size_t mlen, mcapa;
 
   /* positive for variables, negative for macros (bitwise-not) */
   struct xhash *var_tbl;
diff --git a/src/gc.c b/src/gc.c
index c12a1633..5f9c32da 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -360,8 +360,6 @@ gc_mark_phase(pic_state *pic)
   }
 
   /* macros */
-  for (i = 0; i < pic->mlen; ++i) {
-    gc_mark_object(pic, (struct pic_object *)pic->macros[i]);
   for (i = 0; i < pic->xlen; ++i) {
     gc_mark_object(pic, (struct pic_object *)pic->stx[i]);
   }
diff --git a/src/macro.c b/src/macro.c
index e4825e39..56c69af7 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -11,199 +11,19 @@
 
 #define FALLTHROUGH ((void)0)
 
-struct syntactic_env {
-  struct syntactic_env *up;
-
-  struct xhash *tbl;
-};
-
 static void
 define_macro(pic_state *pic, const char *name, struct pic_proc *macro)
 {
   int idx;
 
-  idx = pic->mlen++;
-  if (idx >= pic->mcapa) {
+  idx = pic->xlen++;
+  if (idx >= pic->xcapa) {
     pic_abort(pic, "macro table overflow");
   }
-  pic->macros[idx] = macro;
+  pic->stx[idx] = pic_syntax_new_macro(pic, pic_intern_cstr(pic, name), macro);
   xh_put(pic->global_tbl, name, ~idx);
 }
 
-static struct pic_proc *
-lookup_macro(pic_state *pic, struct syntactic_env *env, const char *name)
-{
-  struct xh_entry *e;
-
-  e = xh_get(env->tbl, name);
-  if (! e)
-    return NULL;
-
-  if (e->val >= 0)
-    return NULL;
-
-  return pic->macros[~e->val];
-}
-
-pic_value
-expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
-{
-  int ai = pic_gc_arena_preserve(pic);
-
-#if DEBUG
-  printf("current ai = %d\n", ai);
-
-  printf("expanding...");
-  pic_debug(pic, obj);
-  puts("");
-#endif
-
-  switch (pic_type(obj)) {
-  case PIC_TT_SYMBOL: {
-    return obj;
-  }
-  case PIC_TT_PAIR: {
-    pic_value v;
-
-    if (! pic_list_p(pic, obj))
-      return obj;
-
-    if (pic_symbol_p(pic_car(pic, obj))) {
-      struct pic_proc *macro;
-      pic_sym sym;
-
-      sym = pic_sym(pic_car(pic, obj));
-      if (sym == pic->sDEFINE_MACRO) {
-	pic_value var, val;
-	struct pic_proc *proc;
-
-	if (pic_length(pic, obj) < 2) {
-	  pic_error(pic, "syntax error");
-	}
-
-	var = pic_car(pic, pic_cdr(pic, obj));
-	if (pic_pair_p(var)) {
-	  val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA),
-			 pic_cons(pic, pic_cdr(pic, var),
-				  pic_cdr(pic, pic_cdr(pic, obj))));
-	  var = pic_car(pic, var);
-	}
-	else {
-	  if (pic_length(pic, obj) != 3) {
-	    pic_error(pic, "syntax_error");
-	  }
-	  val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)));
-	}
-	if (! pic_symbol_p(var)) {
-	  pic_error(pic, "syntax error");
-	}
-
-	proc = pic_codegen(pic, val);
-	if (pic->errmsg) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
-	  abort();
-	}
-	v = pic_apply(pic, proc, pic_nil_value());
-	if (pic->errmsg) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
-	  abort();
-	}
-	assert(pic_proc_p(v));
-	define_macro(pic, pic_symbol_name(pic, pic_sym(var)), pic_proc_ptr(v));
-
-	pic_gc_arena_restore(pic, ai);
-	return pic_false_value();
-      }
-      macro = lookup_macro(pic, env, pic_symbol_name(pic, sym));
-      if (macro) {
-	v = pic_apply(pic, macro, pic_cdr(pic, obj));
-	if (pic->errmsg) {
-	  printf("macroexpand error: %s\n", pic->errmsg);
-	  abort();
-	}
-	pic_gc_arena_restore(pic, ai);
-	pic_gc_protect(pic, v);
-
-	v = expand(pic, v, env);
-	pic_gc_arena_restore(pic, ai);
-	pic_gc_protect(pic, v);
-	return v;
-      }
-    }
-
-    v = pic_nil_value();
-    while (! pic_nil_p(obj)) {
-      v = pic_cons(pic, expand(pic, pic_car(pic, obj), env), v);
-      obj = pic_cdr(pic, obj);
-
-      pic_gc_arena_restore(pic, ai);
-      pic_gc_protect(pic, v);
-    }
-    v = pic_reverse(pic, v);
-
-    pic_gc_arena_restore(pic, ai);
-    pic_gc_protect(pic, v);
-    return v;
-  }
-  case PIC_TT_NIL:
-  case PIC_TT_BOOL:
-  case PIC_TT_FLOAT:
-  case PIC_TT_INT:
-  case PIC_TT_CHAR:
-  case PIC_TT_EOF:
-  case PIC_TT_STRING:
-  case PIC_TT_VECTOR:
-  case PIC_TT_BLOB: {
-    return obj;
-  }
-  case PIC_TT_PROC:
-  case PIC_TT_PORT:
-  case PIC_TT_ERROR:
-  case PIC_TT_ENV:
-  case PIC_TT_CONT:
-  case PIC_TT_UNDEF:
-  case PIC_TT_SENV:
-  case PIC_TT_SYNTAX:
-    pic_error(pic, "unexpected value type");
-    return pic_undef_value();	/* unreachable */
-  }
-  /* logic flaw (suppress warnings gcc will emit) */
-  abort();
-}
-
-pic_value pic_macroexpand_2(pic_state *, pic_value);
-
-pic_value
-pic_macroexpand(pic_state *pic, pic_value obj)
-{
-  struct syntactic_env env;
-  pic_value v;
-
-  env.tbl = pic->global_tbl;
-
-#if DEBUG
-  puts("before expand:");
-  pic_debug(pic, obj);
-  puts("");
-#endif
-
-  v = expand(pic, obj, &env);
-
-#if DEBUG
-  puts("after expand:");
-  pic_debug(pic, v);
-  puts("");
-#endif
-
-  v = pic_macroexpand_2(pic, v);
-#if DEBUG
-  puts("after expand:");
-  pic_debug(pic, v);
-  puts("");
-#endif
-  return v;
-}
-
 static pic_sym
 new_uniq_sym(pic_state *pic, pic_sym base)
 {
@@ -249,6 +69,58 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
     car = macroexpand(pic, pic_car(pic, expr), senv);
     if (pic_syntax_p(car)) {
       switch (pic_syntax(car)->kind) {
+      case PIC_STX_DEFMACRO: {
+	pic_value var, val;
+	struct pic_proc *proc;
+
+	if (pic_length(pic, expr) < 2) {
+	  pic_error(pic, "syntax error");
+	}
+
+	var = pic_car(pic, pic_cdr(pic, expr));
+	if (pic_pair_p(var)) {
+	  val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA),
+			 pic_cons(pic, pic_cdr(pic, var),
+				  pic_cdr(pic, pic_cdr(pic, expr))));
+	  var = pic_car(pic, var);
+	}
+	else {
+	  if (pic_length(pic, expr) != 3) {
+	    pic_error(pic, "syntax_error");
+	  }
+	  val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, expr)));
+	}
+	if (! pic_symbol_p(var)) {
+	  pic_error(pic, "syntax error");
+	}
+
+	proc = pic_codegen(pic, val);
+	if (pic->errmsg) {
+	  printf("macroexpand error: %s\n", pic->errmsg);
+	  abort();
+	}
+	v = pic_apply(pic, proc, pic_nil_value());
+	if (pic->errmsg) {
+	  printf("macroexpand error: %s\n", pic->errmsg);
+	  abort();
+	}
+	assert(pic_proc_p(v));
+	define_macro(pic, pic_symbol_name(pic, pic_sym(var)), pic_proc_ptr(v));
+
+	pic_gc_arena_restore(pic, ai);
+	return pic_false_value();
+      }
+      case PIC_STX_MACRO: {
+	v = pic_apply(pic, pic_syntax(car)->macro, pic_cdr(pic, expr));
+	if (pic->errmsg) {
+	  printf("macroexpand error: %s\n", pic->errmsg);
+	  abort();
+	}
+	pic_gc_arena_restore(pic, ai);
+	pic_gc_protect(pic, v);
+
+	return macroexpand(pic, v, senv);
+      }
       case PIC_STX_LAMBDA: {
 	struct pic_senv *in;
 	pic_value a;
@@ -284,7 +156,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	  pic_error(pic, "syntax error");
 	}
 
-	var = pic_car(pic, pic_cdr(pic, expr));
+	var = pic_cadr(pic, expr);
 	if (pic_pair_p(var)) {
 	  pic_value a;
 
@@ -402,7 +274,7 @@ pic_syntax_new_macro(pic_state *pic, pic_sym sym, struct pic_proc *macro)
 }
 
 pic_value
-pic_macroexpand_2(pic_state *pic, pic_value expr)
+pic_macroexpand(pic_state *pic, pic_value expr)
 {
   struct pic_senv *senv;
   pic_value v;
diff --git a/src/state.c b/src/state.c
index 68d9c891..50dedf77 100644
--- a/src/state.c
+++ b/src/state.c
@@ -64,9 +64,6 @@ pic_open(int argc, char *argv[], char **envp)
   pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value));
   pic->glen = 0;
   pic->gcapa = PIC_GLOBALS_SIZE;
-  pic->macros = (struct pic_proc **)calloc(PIC_MACROS_SIZE, sizeof(struct pic_proc *));
-  pic->mlen = 0;
-  pic->mcapa = PIC_MACROS_SIZE;
 
   /* identifier table */
   pic->var_tbl = xh_new();

From e7673c65bddcc2da51de3227590c1b8c8a7fab1a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 08:59:16 -0800
Subject: [PATCH 20/34] [bugfix] syntaces should be registered to var_tbl, not
 global_tbl

---
 src/state.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/state.c b/src/state.c
index 50dedf77..9b7e2eae 100644
--- a/src/state.c
+++ b/src/state.c
@@ -119,7 +119,7 @@ pic_open(int argc, char *argv[], char **envp)
 
 #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);				\
+    xh_put(pic->var_tbl, name, ~pic->xlen);				\
     pic->xlen++;							\
   } while (0)
 

From cbd636e0a7ef42f950566fa2ebd6dbcc9a70bdf7 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 09:00:16 -0800
Subject: [PATCH 21/34] [bugfix] do not release pic->var_tbl when a senv
 holding it is dead

---
 src/gc.c | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/gc.c b/src/gc.c
index 5f9c32da..919bc453 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -424,9 +424,11 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   }
   case PIC_TT_SENV: {
     struct pic_senv *senv = (struct pic_senv *)obj;
-    xh_destory(senv->tbl);
-    if (senv->stx)
-      pic_free(pic, senv->stx);
+    if (senv->up) {
+      xh_destory(senv->tbl);
+      if (senv->stx)
+	pic_free(pic, senv->stx);
+    }
     break;
   }
   case PIC_TT_SYNTAX: {

From 43d449d2aae304761398bb645440c0ce1b998d1e Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 09:07:06 -0800
Subject: [PATCH 22/34] s/define_macro/pic_defmacro/g

---
 src/macro.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 56c69af7..01825e7a 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -12,7 +12,7 @@
 #define FALLTHROUGH ((void)0)
 
 static void
-define_macro(pic_state *pic, const char *name, struct pic_proc *macro)
+pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
 {
   int idx;
 
@@ -105,7 +105,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	  abort();
 	}
 	assert(pic_proc_p(v));
-	define_macro(pic, pic_symbol_name(pic, pic_sym(var)), pic_proc_ptr(v));
+	pic_defmacro(pic, pic_symbol_name(pic, pic_sym(var)), pic_proc_ptr(v));
 
 	pic_gc_arena_restore(pic, ai);
 	return pic_false_value();

From 2dee30a0b5bbcb5461632a47576ebb5cee4885b3 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 09:07:57 -0800
Subject: [PATCH 23/34] macroexpand_list supports improper list

---
 src/macro.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 01825e7a..3576ec3b 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -242,8 +242,8 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv)
 {
   pic_value v;
 
-  if (pic_nil_p(list))
-    return list;
+  if (! pic_pair_p(list))
+    return macroexpand(pic, list, senv);
 
   v = macroexpand(pic, pic_car(pic, list), senv);
   return pic_cons(pic, v, macroexpand_list(pic, pic_cdr(pic, list), senv));

From c336a354e41391f4a78b06eaf7e4ba525cd3d9d4 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 09:09:15 -0800
Subject: [PATCH 24/34] publish pic_defmacro as a public API

---
 include/picrin.h | 1 +
 src/macro.c      | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/include/picrin.h b/include/picrin.h
index 40c27b36..c69b2d46 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -101,6 +101,7 @@ void pic_close(pic_state *);
 struct pic_proc *pic_get_proc(pic_state *);
 int pic_get_args(pic_state *, const char *, ...);
 void pic_defun(pic_state *, const char *, pic_func_t);
+void pic_defmacro(pic_state *, const char *, struct pic_proc *);
 
 pic_sym pic_intern_cstr(pic_state *, const char *);
 const char *pic_symbol_name(pic_state *, pic_sym);
diff --git a/src/macro.c b/src/macro.c
index 3576ec3b..79cc83cd 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -11,7 +11,7 @@
 
 #define FALLTHROUGH ((void)0)
 
-static void
+void
 pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
 {
   int idx;

From b2704fb123b33a7d52ef24da01845048161cc925 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 16:50:38 -0800
Subject: [PATCH 25/34] increment xlen in the end

---
 src/macro.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index 79cc83cd..da7b3acf 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -16,12 +16,13 @@ pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
 {
   int idx;
 
-  idx = pic->xlen++;
+  idx = pic->xlen;
   if (idx >= pic->xcapa) {
     pic_abort(pic, "macro table overflow");
   }
   pic->stx[idx] = pic_syntax_new_macro(pic, pic_intern_cstr(pic, name), macro);
   xh_put(pic->global_tbl, name, ~idx);
+  pic->xlen++;
 }
 
 static pic_sym

From 3710d5feea6d157015cb22a79591c1dc4ae9cff4 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 16:51:17 -0800
Subject: [PATCH 26/34] support varg lambda

---
 src/macro.c | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index da7b3acf..9ec7f484 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -131,12 +131,14 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	in->tbl = xh_new();
 	in->stx = NULL;
 
-	for (a = pic_cadr(pic, expr); ! pic_nil_p(a); a = pic_cdr(pic, a)) {
+	for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
 	  pic_sym gen, orig;
 
 	  orig = pic_sym(pic_car(pic, a));
 	  gen = new_uniq_sym(pic, orig);
 	  xh_put(senv->tbl, pic_symbol_name(pic, orig), (int)gen);
+	if (pic_symbol_p(a)) {
+	  xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
 	}
 
 	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),

From 38ab43d7fce9673d2b08d80d4732aedeaf74660c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 16:51:48 -0800
Subject: [PATCH 27/34] [bugfix] binding leak

---
 src/macro.c | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 9ec7f484..15b30c1f 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -136,9 +136,10 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
 	  orig = pic_sym(pic_car(pic, a));
 	  gen = new_uniq_sym(pic, orig);
-	  xh_put(senv->tbl, pic_symbol_name(pic, orig), (int)gen);
+	  xh_put(in->tbl, pic_symbol_name(pic, orig), (int)gen);
+	}
 	if (pic_symbol_p(a)) {
-	  xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
+	  xh_put(in->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
 	}
 
 	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
@@ -170,15 +171,20 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	  in->xlen = 0;
 	  in->xcapa = 0;
 
+	  /* defined symbol */
+	  a = pic_car(pic, var);
+	  xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
+	  var = pic_cdr(pic, var);
+
 	  for (a = var; pic_pair_p(a); a = pic_cdr(pic, a)) {
 	    pic_sym gen, orig;
 
 	    orig = pic_sym(pic_car(pic, a));
 	    gen = new_uniq_sym(pic, orig);
-	    xh_put(senv->tbl, pic_symbol_name(pic, orig), (int)gen);
+	    xh_put(in->tbl, pic_symbol_name(pic, orig), (int)gen);
 	  }
 	  if (pic_symbol_p(a)) {
-	    xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
+	    xh_put(in->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
 	  }
 
 	  v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),

From d7f8d67bf26b1fbce3ccdcc873550cc6110ebeef Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 16:52:30 -0800
Subject: [PATCH 28/34] debug-print when unbound symbol is found

---
 src/codegen.c | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/codegen.c b/src/codegen.c
index 57340867..98320508 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -201,7 +201,10 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
     name = pic_symbol_name(pic, pic_sym(obj));
     s = scope_lookup(state, name, &depth, &idx);
     if (! s) {
-      pic_error(pic, "unbound variable");
+#if DEBUG
+      printf("%s\n", name);
+#endif
+      pic_error(pic, "symbol: unbound variable");
     }
 
     switch (depth) {

From d2af692280fa56a0ac4cad39f271a004c6309406 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 17:43:49 -0800
Subject: [PATCH 29/34] add a fixme comment

---
 src/macro.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/macro.c b/src/macro.c
index 15b30c1f..3ef78e87 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -80,6 +80,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
 	var = pic_car(pic, pic_cdr(pic, expr));
 	if (pic_pair_p(var)) {
+	  /* FIXME: unhygienic */
 	  val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA),
 			 pic_cons(pic, pic_cdr(pic, var),
 				  pic_cdr(pic, pic_cdr(pic, expr))));

From 94aac37443dd10c8c5c05bf52f6ad0041ad07de2 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 26 Nov 2013 17:43:59 -0800
Subject: [PATCH 30/34] macros must be added to var_tbl

---
 src/macro.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index 3ef78e87..46357ed2 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -21,7 +21,7 @@ pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
     pic_abort(pic, "macro table overflow");
   }
   pic->stx[idx] = pic_syntax_new_macro(pic, pic_intern_cstr(pic, name), macro);
-  xh_put(pic->global_tbl, name, ~idx);
+  xh_put(pic->var_tbl, name, ~idx);
   pic->xlen++;
 }
 

From 73831283b6ecfa6c5fc36fd953ec03308d6a4ec2 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 27 Nov 2013 13:51:24 +0900
Subject: [PATCH 31/34] cleanup

---
 src/macro.c | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/macro.c b/src/macro.c
index 46357ed2..175eeca5 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -252,7 +252,10 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv)
 {
   pic_value v;
 
-  if (! pic_pair_p(list))
+  if (pic_nil_p(list))
+    return pic_nil_value();
+
+  if (pic_symbol_p(list))
     return macroexpand(pic, list, senv);
 
   v = macroexpand(pic, pic_car(pic, list), senv);

From 0f127917e87c5051c6116aab0f2e9ccba49c62d9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 27 Nov 2013 13:52:16 +0900
Subject: [PATCH 32/34] primitive overridings may cause circular reference at
 the stage of variable renaming

---
 piclib/built-in.scm | 12 ------------
 1 file changed, 12 deletions(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index ca27563d..23392f82 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -314,18 +314,6 @@
 
 ;;; 6.2. Numbers
 
-(define (+ . args)
-  (do ((acc 0)
-       (nums args (cdr nums)))
-      ((pair? nums) acc)
-    (set! acc (+ acc (car nums)))))
-
-(define (* . args)
-  (do ((acc 1)
-       (nums args (cdr nums)))
-      ((pair? nums) acc)
-    (set! acc (* acc (car nums)))))
-
 (define (min x . args)
   (let loop ((pivot x) (rest args))
     (if (null? rest)

From b4218a7a03c9ed6bbed5b4afc8e6bfa16c91c957 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 27 Nov 2013 14:00:23 +0900
Subject: [PATCH 33/34] cosmetic changes

---
 src/macro.c | 76 ++++++++++++++++++++++++++---------------------------
 1 file changed, 38 insertions(+), 38 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 175eeca5..b294d66c 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -11,20 +11,6 @@
 
 #define FALLTHROUGH ((void)0)
 
-void
-pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
-{
-  int idx;
-
-  idx = pic->xlen;
-  if (idx >= pic->xcapa) {
-    pic_abort(pic, "macro table overflow");
-  }
-  pic->stx[idx] = pic_syntax_new_macro(pic, pic_intern_cstr(pic, name), macro);
-  xh_put(pic->var_tbl, name, ~idx);
-  pic->xlen++;
-}
-
 static pic_sym
 new_uniq_sym(pic_state *pic, pic_sym base)
 {
@@ -40,6 +26,44 @@ new_uniq_sym(pic_state *pic, pic_sym base)
   return uniq;
 }
 
+struct pic_syntax *
+pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
+{
+  struct pic_syntax *stx;
+
+  stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
+  stx->kind = kind;
+  stx->sym = sym;
+  stx->macro = NULL;
+  return stx;
+}
+
+struct pic_syntax *
+pic_syntax_new_macro(pic_state *pic, pic_sym sym, struct pic_proc *macro)
+{
+  struct pic_syntax *stx;
+
+  stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
+  stx->kind = PIC_STX_MACRO;
+  stx->sym = sym;
+  stx->macro = macro;
+  return stx;
+}
+
+void
+pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
+{
+  int idx;
+
+  idx = pic->xlen;
+  if (idx >= pic->xcapa) {
+    pic_abort(pic, "macro table overflow");
+  }
+  pic->stx[idx] = pic_syntax_new_macro(pic, pic_intern_cstr(pic, name), macro);
+  xh_put(pic->var_tbl, name, ~idx);
+  pic->xlen++;
+}
+
 static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *);
 
 static pic_value
@@ -262,30 +286,6 @@ 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));
 }
 
-struct pic_syntax *
-pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
-{
-  struct pic_syntax *stx;
-
-  stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
-  stx->kind = kind;
-  stx->sym = sym;
-  stx->macro = NULL;
-  return stx;
-}
-
-struct pic_syntax *
-pic_syntax_new_macro(pic_state *pic, pic_sym sym, struct pic_proc *macro)
-{
-  struct pic_syntax *stx;
-
-  stx = (struct pic_syntax *)pic_obj_alloc(pic, sizeof(struct pic_syntax), PIC_TT_SYNTAX);
-  stx->kind = PIC_STX_MACRO;
-  stx->sym = sym;
-  stx->macro = macro;
-  return stx;
-}
-
 pic_value
 pic_macroexpand(pic_state *pic, pic_value expr)
 {

From a7a3bfc2701869170537e974516814375021aeb9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 27 Nov 2013 14:19:46 +0900
Subject: [PATCH 34/34] [CSE] add new_global_senv and new_local_senv

---
 src/macro.c | 93 ++++++++++++++++++++++++++++-------------------------
 1 file changed, 49 insertions(+), 44 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index b294d66c..ce7c7b69 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -26,6 +26,45 @@ new_uniq_sym(pic_state *pic, pic_sym base)
   return uniq;
 }
 
+static struct pic_senv *
+new_global_senv(pic_state *pic)
+{
+  struct pic_senv *senv;
+
+  senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
+  senv->up = NULL;
+  senv->tbl = pic->var_tbl;
+  senv->stx = pic->stx;
+  senv->xlen = pic->xlen;
+  senv->xcapa = pic->xcapa;
+  return senv;
+}
+
+static struct pic_senv *
+new_local_senv(pic_state *pic, pic_value formals, struct pic_senv *up)
+{
+  struct pic_senv *senv;
+  pic_value a;
+  pic_sym sym;
+
+  senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
+  senv->up = up;
+  senv->tbl = xh_new();
+  senv->stx = NULL;
+  senv->xlen = 0;
+  senv->xcapa = 0;
+
+  for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
+    sym = pic_sym(pic_car(pic, a));
+    xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)new_uniq_sym(pic, sym));
+  }
+  if (pic_symbol_p(a)) {
+    sym = pic_sym(a);
+    xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)new_uniq_sym(pic, sym));
+  }
+  return senv;
+}
+
 struct pic_syntax *
 pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
 {
@@ -148,24 +187,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	return macroexpand(pic, v, senv);
       }
       case PIC_STX_LAMBDA: {
-	struct pic_senv *in;
-	pic_value a;
-
-	in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-	in->up = senv;
-	in->tbl = xh_new();
-	in->stx = NULL;
-
-	for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
-	  pic_sym gen, orig;
-
-	  orig = pic_sym(pic_car(pic, a));
-	  gen = new_uniq_sym(pic, orig);
-	  xh_put(in->tbl, pic_symbol_name(pic, orig), (int)gen);
-	}
-	if (pic_symbol_p(a)) {
-	  xh_put(in->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
-	}
+	struct pic_senv *in = new_local_senv(pic, pic_cadr(pic, expr), senv);
 
 	v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
 		     pic_cons(pic,
@@ -179,7 +201,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
       case PIC_STX_DEFINE: {
 	pic_sym uniq;
 	pic_value var;
-	struct pic_senv *in = senv;
 
 	if (pic_length(pic, expr) < 2) {
 	  pic_error(pic, "syntax error");
@@ -187,35 +208,24 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
 	var = pic_cadr(pic, expr);
 	if (pic_pair_p(var)) {
+	  struct pic_senv *in = new_local_senv(pic, pic_cdr(pic, var), senv);
 	  pic_value a;
-
-	  in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-	  in->up = senv;
-	  in->tbl = xh_new();
-	  in->stx = NULL;
-	  in->xlen = 0;
-	  in->xcapa = 0;
+	  pic_sym sym;
 
 	  /* defined symbol */
 	  a = pic_car(pic, var);
-	  xh_put(senv->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
-	  var = pic_cdr(pic, var);
-
-	  for (a = var; pic_pair_p(a); a = pic_cdr(pic, a)) {
-	    pic_sym gen, orig;
-
-	    orig = pic_sym(pic_car(pic, a));
-	    gen = new_uniq_sym(pic, orig);
-	    xh_put(in->tbl, pic_symbol_name(pic, orig), (int)gen);
-	  }
-	  if (pic_symbol_p(a)) {
-	    xh_put(in->tbl, pic_symbol_name(pic, pic_sym(a)), (int)new_uniq_sym(pic, pic_sym(a)));
+	  if (! pic_symbol_p(a)) {
+	    pic_error(pic, "binding to non-symbol object");
 	  }
+	  sym = pic_sym(a);
+	  xh_put(senv->tbl, pic_symbol_name(pic, sym), (int)new_uniq_sym(pic, sym));
 
+	  /* binding value */
 	  v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
 		       pic_cons(pic,
 				macroexpand_list(pic, pic_cadr(pic, expr), in),
 				macroexpand_list(pic, pic_cddr(pic, expr), in)));
+
 	  pic_gc_arena_restore(pic, ai);
 	  pic_gc_protect(pic, v);
 	  return v;
@@ -292,12 +302,7 @@ pic_macroexpand(pic_state *pic, pic_value expr)
   struct pic_senv *senv;
   pic_value v;
 
-  senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-  senv->up = NULL;
-  senv->tbl = pic->var_tbl;
-  senv->stx = pic->stx;
-  senv->xlen = pic->xlen;
-  senv->xcapa = pic->xcapa;
+  senv = new_global_senv(pic);
 
 #if DEBUG
   puts("before expand:");