From 73c406ed42febec6809506c8563c4d0a9cd7e61e Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 16:56:39 +0900
Subject: [PATCH 01/12] add translate function

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

diff --git a/src/macro.c b/src/macro.c
index ea200e7d..6edc62b3 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -156,6 +156,33 @@ push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value ass
   return senv;
 }
 
+static pic_sym
+translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, pic_value assoc_box)
+{
+  pic_sym rename;
+  pic_value x;
+
+  if (! pic_interned_p(pic, sym)) {
+    return sym;
+  }
+  while (true) {
+    if (pic_find_rename(pic, senv, sym, &rename)) {
+      return rename;
+    }
+    if (! senv->up)
+      break;
+    senv = senv->up;
+  }
+  x = pic_assq(pic, pic_sym_value(sym), pic_unbox(pic, assoc_box));
+  if (pic_test(x)) {
+    return pic_sym(pic_cdr(pic, x));
+  } else {
+    rename = pic_gensym(pic, sym);
+    pic_set_box(pic, assoc_box, pic_acons(pic, pic_sym_value(sym), pic_sym_value(rename), pic_unbox(pic, assoc_box)));
+    return rename;
+  }
+}
+
 static pic_value
 macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_value assoc_box)
 {
@@ -191,31 +218,10 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_valu
   return list;
 }
 
-static pic_sym
+static pic_value
 macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, pic_value assoc_box)
 {
-  pic_sym rename;
-  pic_value x;
-
-  if (! pic_interned_p(pic, sym)) {
-    return sym;
-  }
-  while (true) {
-    if (pic_find_rename(pic, senv, sym, &rename)) {
-      return rename;
-    }
-    if (! senv->up)
-      break;
-    senv = senv->up;
-  }
-  x = pic_assq(pic, pic_sym_value(sym), pic_unbox(pic, assoc_box));
-  if (pic_test(x)) {
-    return pic_sym(pic_cdr(pic, x));
-  } else {
-    rename = pic_gensym(pic, sym);
-    pic_set_box(pic, assoc_box, pic_acons(pic, pic_sym_value(sym), pic_sym_value(rename), pic_unbox(pic, assoc_box)));
-    return rename;
-  }
+  return pic_sym_value(translate(pic, sym, senv, assoc_box));
 }
 
 static pic_value
@@ -499,7 +505,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
     return macroexpand(pic, pic_sc_ptr(expr)->expr, pic_sc_ptr(expr)->senv, assoc_box);
   }
   case PIC_TT_SYMBOL: {
-    return pic_sym_value(macroexpand_symbol(pic, pic_sym(expr), senv, assoc_box));
+    return macroexpand_symbol(pic, pic_sym(expr), senv, assoc_box);
   }
   case PIC_TT_PAIR: {
     pic_value car;
@@ -720,7 +726,7 @@ er_macro_rename(pic_state *pic)
   mac_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 1));
   assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
 
-  return pic_sym_value(macroexpand_symbol(pic, sym, mac_env, assoc_box));
+  return pic_sym_value(translate(pic, sym, mac_env, assoc_box));
 }
 
 static pic_value
@@ -739,8 +745,8 @@ er_macro_compare(pic_state *pic)
   use_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
   assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
 
-  m = macroexpand_symbol(pic, pic_sym(a), use_env, assoc_box);
-  n = macroexpand_symbol(pic, pic_sym(b), use_env, assoc_box);
+  m = translate(pic, pic_sym(a), use_env, assoc_box);
+  n = translate(pic, pic_sym(b), use_env, assoc_box);
 
   return pic_bool_value(m == n);
 }
@@ -805,7 +811,7 @@ ir_macro_inject(pic_state *pic)
   use_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
   assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
 
-  return pic_sym_value(macroexpand_symbol(pic, sym, use_env, assoc_box));
+  return pic_sym_value(translate(pic, sym, use_env, assoc_box));
 }
 
 static pic_value
@@ -824,8 +830,8 @@ ir_macro_compare(pic_state *pic)
   mac_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 1));
   assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
 
-  m = macroexpand_symbol(pic, pic_sym(a), mac_env, assoc_box);
-  n = macroexpand_symbol(pic, pic_sym(b), mac_env, assoc_box);
+  m = translate(pic, pic_sym(a), mac_env, assoc_box);
+  n = translate(pic, pic_sym(b), mac_env, assoc_box);
 
   return pic_bool_value(m == n);
 }
@@ -835,7 +841,7 @@ ir_macro_wrap(pic_state *pic, pic_value expr, struct pic_senv *use_env, pic_valu
 {
   if (pic_sym_p(expr)) {
     pic_value r;
-    r = pic_sym_value(macroexpand_symbol(pic, pic_sym(expr), use_env, assoc_box));
+    r = pic_sym_value(translate(pic, pic_sym(expr), use_env, assoc_box));
     *ir = pic_acons(pic, r, expr, *ir);
     return r;
   }
@@ -857,7 +863,7 @@ ir_macro_unwrap(pic_state *pic, pic_value expr, struct pic_senv *mac_env, pic_va
     if (pic_test(r = pic_assq(pic, expr, *ir))) {
       return pic_cdr(pic, r);
     }
-    return pic_sym_value(macroexpand_symbol(pic, pic_sym(expr), mac_env, assoc_box));
+    return pic_sym_value(translate(pic, pic_sym(expr), mac_env, assoc_box));
   }
   else if (pic_pair_p(expr)) {
     return pic_cons(pic,

From 54d50d57a19570608cab7f7ecc9ac6260d054956 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 17:01:55 +0900
Subject: [PATCH 02/12] add pic_dict_has

---
 include/picrin/dict.h | 1 +
 src/dict.c            | 8 ++++++++
 2 files changed, 9 insertions(+)

diff --git a/include/picrin/dict.h b/include/picrin/dict.h
index ae118e13..8bc58ad8 100644
--- a/include/picrin/dict.h
+++ b/include/picrin/dict.h
@@ -23,6 +23,7 @@ pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_sym);
 void pic_dict_set(pic_state *, struct pic_dict *, pic_sym, pic_value);
 void pic_dict_del(pic_state *, struct pic_dict *, pic_sym);
 size_t pic_dict_size(pic_state *, struct pic_dict *);
+bool pic_dict_has(pic_state *, struct pic_dict *, pic_sym);
 
 #if defined(__cplusplus)
 }
diff --git a/src/dict.c b/src/dict.c
index e9fd5e80..d3eb895b 100644
--- a/src/dict.c
+++ b/src/dict.c
@@ -44,6 +44,14 @@ pic_dict_size(pic_state *pic, struct pic_dict *dict)
   return dict->hash.count;
 }
 
+bool
+pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_sym key)
+{
+  UNUSED(pic);
+
+  return xh_get_int(&dict->hash, key) != NULL;
+}
+
 void
 pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym key)
 {

From e1cba4b48e38f295dd0e365e7d200544569563cb Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 17:07:27 +0900
Subject: [PATCH 03/12] refactor translate to use pic_dict instead of boxes

---
 src/macro.c | 162 ++++++++++++++++++++++++++--------------------------
 1 file changed, 80 insertions(+), 82 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 6edc62b3..0cb7349f 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -9,7 +9,7 @@
 #include "picrin/macro.h"
 #include "picrin/lib.h"
 #include "picrin/error.h"
-#include "picrin/box.h"
+#include "picrin/dict.h"
 
 struct pic_senv *
 pic_null_syntactic_environment(pic_state *pic)
@@ -108,15 +108,15 @@ pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
   pic_export(pic, sym);
 }
 
-static pic_value macroexpand_node(pic_state *, pic_value, struct pic_senv *, pic_value);
+static pic_value macroexpand_node(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
 
 static pic_value
-macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value assoc_box)
+macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
   size_t ai = pic_gc_arena_preserve(pic);
   pic_value v;
 
-  v = macroexpand_node(pic, expr, senv, assoc_box);
+  v = macroexpand_node(pic, expr, senv, cxt);
 
   pic_gc_arena_restore(pic, ai);
   pic_gc_protect(pic, v);
@@ -124,7 +124,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value ass
 }
 
 static struct pic_senv *
-push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value assoc_box)
+push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, struct pic_dict *cxt)
 {
   struct pic_senv *senv;
   pic_value a;
@@ -137,7 +137,7 @@ push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value ass
     pic_value v = pic_car(pic, a);
 
     if (! pic_sym_p(v)) {
-      v = macroexpand(pic, v, up, assoc_box);
+      v = macroexpand(pic, v, up, cxt);
     }
     if (! pic_sym_p(v)) {
       pic_error(pic, "syntax error");
@@ -145,7 +145,7 @@ push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value ass
     pic_add_rename(pic, senv, pic_sym(v));
   }
   if (! pic_sym_p(a)) {
-    a = macroexpand(pic, a, up, assoc_box);
+    a = macroexpand(pic, a, up, cxt);
   }
   if (pic_sym_p(a)) {
     pic_add_rename(pic, senv, pic_sym(a));
@@ -157,10 +157,9 @@ push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value ass
 }
 
 static pic_sym
-translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, pic_value assoc_box)
+translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
 {
   pic_sym rename;
-  pic_value x;
 
   if (! pic_interned_p(pic, sym)) {
     return sym;
@@ -173,18 +172,17 @@ translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, pic_value assoc_bo
       break;
     senv = senv->up;
   }
-  x = pic_assq(pic, pic_sym_value(sym), pic_unbox(pic, assoc_box));
-  if (pic_test(x)) {
-    return pic_sym(pic_cdr(pic, x));
+  if (pic_dict_has(pic, cxt, sym)) {
+    return pic_sym(pic_dict_ref(pic, cxt, sym));
   } else {
     rename = pic_gensym(pic, sym);
-    pic_set_box(pic, assoc_box, pic_acons(pic, pic_sym_value(sym), pic_sym_value(rename), pic_unbox(pic, assoc_box)));
+    pic_dict_set(pic, cxt, sym, pic_sym_value(rename));
     return rename;
   }
 }
 
 static pic_value
-macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, struct pic_dict *cxt)
 {
   size_t ai = pic_gc_arena_preserve(pic);
   pic_value v, vs;
@@ -194,7 +192,7 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_valu
   while (pic_pair_p(list)) {
     v = pic_car(pic, list);
 
-    vs = pic_cons(pic, macroexpand(pic, v, senv, assoc_box), vs);
+    vs = pic_cons(pic, macroexpand(pic, v, senv, cxt), vs);
     list = pic_cdr(pic, list);
 
     pic_gc_arena_restore(pic, ai);
@@ -202,7 +200,7 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_valu
     pic_gc_protect(pic, list);
   }
 
-  list = macroexpand(pic, list, senv, assoc_box);
+  list = macroexpand(pic, list, senv, cxt);
 
   /* reverse the result */
   pic_for_each (v, vs) {
@@ -219,9 +217,9 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_valu
 }
 
 static pic_value
-macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
 {
-  return pic_sym_value(translate(pic, sym, senv, assoc_box));
+  return pic_sym_value(translate(pic, sym, senv, cxt));
 }
 
 static pic_value
@@ -307,7 +305,7 @@ macroexpand_export(pic_state *pic, pic_value expr)
 }
 
 static pic_value
-macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
   pic_value var, val;
   pic_sym sym, rename;
@@ -318,7 +316,7 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, pic
 
   var = pic_cadr(pic, expr);
   if (! pic_sym_p(var)) {
-    var = macroexpand(pic, var, senv, assoc_box);
+    var = macroexpand(pic, var, senv, cxt);
   }
   if (! pic_sym_p(var)) {
     pic_error(pic, "binding to non-symbol object");
@@ -393,7 +391,7 @@ macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_senv *senv)
 }
 
 static pic_value
-macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
   pic_sym sym;
   pic_value formals;
@@ -404,13 +402,13 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_va
 
   formals = pic_cadr(pic, expr);
   if (pic_pair_p(formals)) {
-    struct pic_senv *in = push_scope(pic, pic_cdr(pic, formals), senv, assoc_box);
+    struct pic_senv *in = push_scope(pic, pic_cdr(pic, formals), senv, cxt);
     pic_value a;
 
     /* defined symbol */
     a = pic_car(pic, formals);
     if (! pic_sym_p(a)) {
-      a = macroexpand(pic, a, senv, assoc_box);
+      a = macroexpand(pic, a, senv, cxt);
     }
     if (! pic_sym_p(a)) {
       pic_error(pic, "binding to non-symbol object");
@@ -423,12 +421,12 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_va
     /* binding value */
     return pic_cons(pic, pic_sym_value(pic->sDEFINE),
                     pic_cons(pic,
-                             macroexpand_list(pic, pic_cadr(pic, expr), in, assoc_box),
-                             macroexpand_list(pic, pic_cddr(pic, expr), in, assoc_box)));
+                             macroexpand_list(pic, pic_cadr(pic, expr), in, cxt),
+                             macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)));
   }
 
   if (! pic_sym_p(formals)) {
-    formals = macroexpand(pic, formals, senv, assoc_box);
+    formals = macroexpand(pic, formals, senv, cxt);
   }
   if (! pic_sym_p(formals)) {
     pic_error(pic, "binding to non-symbol object");
@@ -438,18 +436,18 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_va
     pic_add_rename(pic, senv, sym);
   }
 
-  return pic_cons(pic, pic_sym_value(pic->sDEFINE), macroexpand_list(pic, pic_cdr(pic, expr), senv, assoc_box));
+  return pic_cons(pic, pic_sym_value(pic->sDEFINE), macroexpand_list(pic, pic_cdr(pic, expr), senv, cxt));
 }
 
 static pic_value
-macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
-  struct pic_senv *in = push_scope(pic, pic_cadr(pic, expr), senv, assoc_box);
+  struct pic_senv *in = push_scope(pic, pic_cadr(pic, expr), senv, cxt);
 
   return pic_cons(pic, pic_sym_value(pic->sLAMBDA),
                   pic_cons(pic,
-                           macroexpand_list(pic, pic_cadr(pic, expr), in, assoc_box),
-                           macroexpand_list(pic, pic_cddr(pic, expr), in, assoc_box)));
+                           macroexpand_list(pic, pic_cadr(pic, expr), in, cxt),
+                           macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)));
 }
 
 static pic_value
@@ -459,7 +457,7 @@ macroexpand_quote(pic_state *pic, pic_value expr)
 }
 
 static pic_value
-macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
   pic_value v, args;
 
@@ -488,11 +486,11 @@ macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct
   puts("");
 #endif
 
-  return macroexpand(pic, v, senv, assoc_box);
+  return macroexpand(pic, v, senv, cxt);
 }
 
 static pic_value
-macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value assoc_box)
+macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
 #if DEBUG
   printf("[macroexpand] expanding... ");
@@ -502,10 +500,10 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
 
   switch (pic_type(expr)) {
   case PIC_TT_SC: {
-    return macroexpand(pic, pic_sc_ptr(expr)->expr, pic_sc_ptr(expr)->senv, assoc_box);
+    return macroexpand(pic, pic_sc_ptr(expr)->expr, pic_sc_ptr(expr)->senv, cxt);
   }
   case PIC_TT_SYMBOL: {
-    return macroexpand_symbol(pic, pic_sym(expr), senv, assoc_box);
+    return macroexpand_symbol(pic, pic_sym(expr), senv, cxt);
   }
   case PIC_TT_PAIR: {
     pic_value car;
@@ -515,7 +513,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
       pic_errorf(pic, "cannot macroexpand improper list: ~s", expr);
     }
 
-    car = macroexpand(pic, pic_car(pic, expr), senv, assoc_box);
+    car = macroexpand(pic, pic_car(pic, expr), senv, cxt);
     if (pic_sym_p(car)) {
       pic_sym tag = pic_sym(car);
 
@@ -529,27 +527,27 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
         return macroexpand_export(pic, expr);
       }
       else if (tag == pic->sDEFINE_SYNTAX) {
-        return macroexpand_defsyntax(pic, expr, senv, assoc_box);
+        return macroexpand_defsyntax(pic, expr, senv, cxt);
       }
       else if (tag == pic->sDEFINE_MACRO) {
         return macroexpand_defmacro(pic, expr, senv);
       }
       else if (tag == pic->sLAMBDA) {
-        return macroexpand_lambda(pic, expr, senv, assoc_box);
+        return macroexpand_lambda(pic, expr, senv, cxt);
       }
       else if (tag == pic->sDEFINE) {
-        return macroexpand_define(pic, expr, senv, assoc_box);
+        return macroexpand_define(pic, expr, senv, cxt);
       }
       else if (tag == pic->sQUOTE) {
         return macroexpand_quote(pic, expr);
       }
 
       if ((mac = find_macro(pic, tag)) != NULL) {
-        return macroexpand_macro(pic, mac, expr, senv, assoc_box);
+        return macroexpand_macro(pic, mac, expr, senv, cxt);
       }
     }
 
-    return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv, assoc_box));
+    return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv, cxt));
   }
   case PIC_TT_EOF:
   case PIC_TT_NIL:
@@ -584,7 +582,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
 pic_value
 pic_macroexpand(pic_state *pic, pic_value expr)
 {
-  pic_value v, box;
+  pic_value v;
 
 #if DEBUG
   puts("before expand:");
@@ -592,9 +590,7 @@ pic_macroexpand(pic_state *pic, pic_value expr)
   puts("");
 #endif
 
-  box = pic_box(pic, pic_nil_value());
-
-  v = macroexpand(pic, expr, pic->lib->senv, box);
+  v = macroexpand(pic, expr, pic->lib->senv, pic_dict_new(pic));
 
 #if DEBUG
   puts("after expand:");
@@ -653,16 +649,16 @@ sc_identifier_p(pic_value obj)
 static bool
 sc_identifier_eq_p(pic_state *pic, struct pic_senv *e1, pic_value x, struct pic_senv *e2, pic_value y)
 {
-  pic_value box;
+  struct pic_dict *cxt;
 
   if (! (sc_identifier_p(x) && sc_identifier_p(y))) {
     return false;
   }
 
-  box = pic_box(pic, pic_nil_value());
+  cxt = pic_dict_new(pic);
 
-  x = macroexpand(pic, x, e1, box);
-  y = macroexpand(pic, y, e2, box);
+  x = macroexpand(pic, x, e1, cxt);
+  y = macroexpand(pic, y, e2, cxt);
 
   return pic_eq_p(x, y);
 }
@@ -719,14 +715,14 @@ er_macro_rename(pic_state *pic)
 {
   pic_sym sym;
   struct pic_senv *mac_env;
-  pic_value assoc_box;
+  struct pic_dict *cxt;
 
   pic_get_args(pic, "m", &sym);
 
   mac_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 1));
-  assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
+  cxt = pic_dict_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 2));
 
-  return pic_sym_value(translate(pic, sym, mac_env, assoc_box));
+  return pic_sym_value(translate(pic, sym, mac_env, cxt));
 }
 
 static pic_value
@@ -735,7 +731,7 @@ er_macro_compare(pic_state *pic)
   pic_value a, b;
   struct pic_senv *use_env;
   pic_sym m, n;
-  pic_value assoc_box;
+  struct pic_dict *cxt;
 
   pic_get_args(pic, "oo", &a, &b);
 
@@ -743,10 +739,10 @@ er_macro_compare(pic_state *pic)
     return pic_false_value();   /* should be an error? */
 
   use_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
-  assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
+  cxt = pic_dict_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 2));
 
-  m = translate(pic, pic_sym(a), use_env, assoc_box);
-  n = translate(pic, pic_sym(b), use_env, assoc_box);
+  m = translate(pic, pic_sym(a), use_env, cxt);
+  n = translate(pic, pic_sym(b), use_env, cxt);
 
   return pic_bool_value(m == n);
 }
@@ -754,8 +750,9 @@ er_macro_compare(pic_state *pic)
 static pic_value
 er_macro_call(pic_state *pic)
 {
-  pic_value expr, use_env, mac_env, box;
+  pic_value expr, use_env, mac_env;
   struct pic_proc *rename, *compare, *cb;
+  struct pic_dict *cxt;
 
   pic_get_args(pic, "ooo", &expr, &use_env, &mac_env);
 
@@ -766,19 +763,19 @@ er_macro_call(pic_state *pic)
     pic_error(pic, "unexpected type of argument 3");
   }
 
-  box = pic_box(pic, pic_nil_value());
+  cxt = pic_dict_new(pic);
 
   rename = pic_proc_new(pic, er_macro_rename, "<er-macro-renamer>");
   pic_proc_cv_init(pic, rename, 3);
   pic_proc_cv_set(pic, rename, 0, use_env);
   pic_proc_cv_set(pic, rename, 1, mac_env);
-  pic_proc_cv_set(pic, rename, 2, box);
+  pic_proc_cv_set(pic, rename, 2, pic_obj_value(cxt));
 
   compare = pic_proc_new(pic, er_macro_compare, "<er-macro-comparator>");
   pic_proc_cv_init(pic, compare, 3);
   pic_proc_cv_set(pic, compare, 0, use_env);
   pic_proc_cv_set(pic, compare, 1, mac_env);
-  pic_proc_cv_set(pic, compare, 2, box);
+  pic_proc_cv_set(pic, compare, 2, pic_obj_value(cxt));
 
   cb = pic_proc_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
 
@@ -804,14 +801,14 @@ ir_macro_inject(pic_state *pic)
 {
   pic_sym sym;
   struct pic_senv *use_env;
-  pic_value assoc_box;
+  struct pic_dict *cxt;
 
   pic_get_args(pic, "m", &sym);
 
   use_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
-  assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
+  cxt = pic_dict_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 2));
 
-  return pic_sym_value(translate(pic, sym, use_env, assoc_box));
+  return pic_sym_value(translate(pic, sym, use_env, cxt));
 }
 
 static pic_value
@@ -820,7 +817,7 @@ ir_macro_compare(pic_state *pic)
   pic_value a, b;
   struct pic_senv *mac_env;
   pic_sym m, n;
-  pic_value assoc_box;
+  struct pic_dict *cxt;
 
   pic_get_args(pic, "oo", &a, &b);
 
@@ -828,27 +825,27 @@ ir_macro_compare(pic_state *pic)
     return pic_false_value();   /* should be an error? */
 
   mac_env = pic_senv_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 1));
-  assoc_box = pic_proc_cv_ref(pic, pic_get_proc(pic), 2);
+  cxt = pic_dict_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 2));
 
-  m = translate(pic, pic_sym(a), mac_env, assoc_box);
-  n = translate(pic, pic_sym(b), mac_env, assoc_box);
+  m = translate(pic, pic_sym(a), mac_env, cxt);
+  n = translate(pic, pic_sym(b), mac_env, cxt);
 
   return pic_bool_value(m == n);
 }
 
 static pic_value
-ir_macro_wrap(pic_state *pic, pic_value expr, struct pic_senv *use_env, pic_value assoc_box, pic_value *ir)
+ir_macro_wrap(pic_state *pic, pic_value expr, struct pic_senv *use_env, struct pic_dict *cxt, pic_value *ir)
 {
   if (pic_sym_p(expr)) {
     pic_value r;
-    r = pic_sym_value(translate(pic, pic_sym(expr), use_env, assoc_box));
+    r = pic_sym_value(translate(pic, pic_sym(expr), use_env, cxt));
     *ir = pic_acons(pic, r, expr, *ir);
     return r;
   }
   else if (pic_pair_p(expr)) {
     return pic_cons(pic,
-                    ir_macro_wrap(pic, pic_car(pic, expr), use_env, assoc_box, ir),
-                    ir_macro_wrap(pic, pic_cdr(pic, expr), use_env, assoc_box, ir));
+                    ir_macro_wrap(pic, pic_car(pic, expr), use_env, cxt, ir),
+                    ir_macro_wrap(pic, pic_cdr(pic, expr), use_env, cxt, ir));
   }
   else {
     return expr;
@@ -856,19 +853,19 @@ ir_macro_wrap(pic_state *pic, pic_value expr, struct pic_senv *use_env, pic_valu
 }
 
 static pic_value
-ir_macro_unwrap(pic_state *pic, pic_value expr, struct pic_senv *mac_env, pic_value assoc_box, pic_value *ir)
+ir_macro_unwrap(pic_state *pic, pic_value expr, struct pic_senv *mac_env, struct pic_dict *cxt, pic_value *ir)
 {
   if (pic_sym_p(expr)) {
     pic_value r;
     if (pic_test(r = pic_assq(pic, expr, *ir))) {
       return pic_cdr(pic, r);
     }
-    return pic_sym_value(translate(pic, pic_sym(expr), mac_env, assoc_box));
+    return pic_sym_value(translate(pic, pic_sym(expr), mac_env, cxt));
   }
   else if (pic_pair_p(expr)) {
     return pic_cons(pic,
-                    ir_macro_unwrap(pic, pic_car(pic, expr), mac_env, assoc_box, ir),
-                    ir_macro_unwrap(pic, pic_cdr(pic, expr), mac_env, assoc_box, ir));
+                    ir_macro_unwrap(pic, pic_car(pic, expr), mac_env, cxt, ir),
+                    ir_macro_unwrap(pic, pic_cdr(pic, expr), mac_env, cxt, ir));
   }
   else {
     return expr;
@@ -878,8 +875,9 @@ ir_macro_unwrap(pic_state *pic, pic_value expr, struct pic_senv *mac_env, pic_va
 static pic_value
 ir_macro_call(pic_state *pic)
 {
-  pic_value expr, use_env, mac_env, box;
+  pic_value expr, use_env, mac_env;
   struct pic_proc *inject, *compare, *cb;
+  struct pic_dict *cxt;
   pic_value ir = pic_nil_value();
 
   pic_get_args(pic, "ooo", &expr, &use_env, &mac_env);
@@ -891,25 +889,25 @@ ir_macro_call(pic_state *pic)
     pic_error(pic, "unexpected type of argument 3");
   }
 
-  box = pic_box(pic, pic_nil_value());
+  cxt = pic_dict_new(pic);
 
   inject = pic_proc_new(pic, ir_macro_inject, "<ir-macro-injecter>");
   pic_proc_cv_init(pic, inject, 3);
   pic_proc_cv_set(pic, inject, 0, use_env);
   pic_proc_cv_set(pic, inject, 1, mac_env);
-  pic_proc_cv_set(pic, inject, 2, box);
+  pic_proc_cv_set(pic, inject, 2, pic_obj_value(cxt));
 
   compare = pic_proc_new(pic, ir_macro_compare, "<ir-macro-comparator>");
   pic_proc_cv_init(pic, compare, 3);
   pic_proc_cv_set(pic, compare, 0, use_env);
   pic_proc_cv_set(pic, compare, 1, mac_env);
-  pic_proc_cv_set(pic, compare, 2, box);
+  pic_proc_cv_set(pic, compare, 2, pic_obj_value(cxt));
 
   cb = pic_proc_ptr(pic_proc_cv_ref(pic, pic_get_proc(pic), 0));
 
-  expr = ir_macro_wrap(pic, expr, pic_senv_ptr(use_env), box, &ir);
+  expr = ir_macro_wrap(pic, expr, pic_senv_ptr(use_env), cxt, &ir);
   expr = pic_apply3(pic, cb, expr, pic_obj_value(inject), pic_obj_value(compare));
-  expr = ir_macro_unwrap(pic, expr, pic_senv_ptr(mac_env), box, &ir);
+  expr = ir_macro_unwrap(pic, expr, pic_senv_ptr(mac_env), cxt, &ir);
 
   return expr;
 }

From 601b54ba1f42c2b15d467c8c025fa055eb00673c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 20:06:08 +0900
Subject: [PATCH 04/12] cosmetic changes

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

diff --git a/src/macro.c b/src/macro.c
index 0cb7349f..3181dd22 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -11,31 +11,7 @@
 #include "picrin/error.h"
 #include "picrin/dict.h"
 
-struct pic_senv *
-pic_null_syntactic_environment(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;
-  xh_init_int(&senv->renames, sizeof(pic_sym));
-
-  pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY);
-  pic_define_syntactic_keyword(pic, senv, pic->sIMPORT);
-  pic_define_syntactic_keyword(pic, senv, pic->sEXPORT);
-
-  return senv;
-}
-
-void
-pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym)
-{
-  pic_put_rename(pic, senv, sym, sym);
-
-  if (pic->lib && pic->lib->senv == senv) {
-    pic_export(pic, sym);
-  }
-}
+static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
 
 pic_sym
 pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
@@ -94,35 +70,6 @@ find_macro(pic_state *pic, pic_sym rename)
   return xh_val(e, struct pic_macro *);
 }
 
-void
-pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
-{
-  pic_sym sym, rename;
-
-  /* symbol registration */
-  sym = pic_intern_cstr(pic, name);
-  rename = pic_add_rename(pic, pic->lib->senv, sym);
-  define_macro(pic, rename, macro, NULL);
-
-  /* auto export! */
-  pic_export(pic, sym);
-}
-
-static pic_value macroexpand_node(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
-
-static pic_value
-macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
-{
-  size_t ai = pic_gc_arena_preserve(pic);
-  pic_value v;
-
-  v = macroexpand_node(pic, expr, senv, cxt);
-
-  pic_gc_arena_restore(pic, ai);
-  pic_gc_protect(pic, v);
-  return v;
-}
-
 static struct pic_senv *
 push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, struct pic_dict *cxt)
 {
@@ -579,6 +526,19 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct p
   UNREACHABLE();
 }
 
+static pic_value
+macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  size_t ai = pic_gc_arena_preserve(pic);
+  pic_value v;
+
+  v = macroexpand_node(pic, expr, senv, cxt);
+
+  pic_gc_arena_restore(pic, ai);
+  pic_gc_protect(pic, v);
+  return v;
+}
+
 pic_value
 pic_macroexpand(pic_state *pic, pic_value expr)
 {
@@ -601,6 +561,46 @@ pic_macroexpand(pic_state *pic, pic_value expr)
   return v;
 }
 
+struct pic_senv *
+pic_null_syntactic_environment(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;
+  xh_init_int(&senv->renames, sizeof(pic_sym));
+
+  pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY);
+  pic_define_syntactic_keyword(pic, senv, pic->sIMPORT);
+  pic_define_syntactic_keyword(pic, senv, pic->sEXPORT);
+
+  return senv;
+}
+
+void
+pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym sym)
+{
+  pic_put_rename(pic, senv, sym, sym);
+
+  if (pic->lib && pic->lib->senv == senv) {
+    pic_export(pic, sym);
+  }
+}
+
+void
+pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
+{
+  pic_sym sym, rename;
+
+  /* symbol registration */
+  sym = pic_intern_cstr(pic, name);
+  rename = pic_add_rename(pic, pic->lib->senv, sym);
+  define_macro(pic, rename, macro, NULL);
+
+  /* auto export! */
+  pic_export(pic, sym);
+}
+
 static pic_value
 pic_macro_gensym(pic_state *pic)
 {

From 6d20c0e3e01f78a4da09890503563b87268df0a7 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 20:09:42 +0900
Subject: [PATCH 05/12] cosmetic changes again

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

diff --git a/src/macro.c b/src/macro.c
index 3181dd22..5259a198 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -389,12 +389,15 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
 static pic_value
 macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
-  struct pic_senv *in = push_scope(pic, pic_cadr(pic, expr), senv, cxt);
+  pic_value formal, body;
+  struct pic_senv *in;
 
-  return pic_cons(pic, pic_sym_value(pic->sLAMBDA),
-                  pic_cons(pic,
-                           macroexpand_list(pic, pic_cadr(pic, expr), in, cxt),
-                           macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)));
+  in = push_scope(pic, pic_cadr(pic, expr), senv, cxt);
+
+  formal = macroexpand_list(pic, pic_cadr(pic, expr), in, cxt);
+  body = macroexpand_list(pic, pic_cddr(pic, expr), in, cxt);
+
+  return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body));
 }
 
 static pic_value

From 631926aa96596d83e1b3b1923cb83dcbbde59c49 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 20:19:45 +0900
Subject: [PATCH 06/12] function reorder

---
 src/macro.c | 207 ++++++++++++++++++++++++++--------------------------
 1 file changed, 103 insertions(+), 104 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index 5259a198..683c429b 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -128,41 +128,6 @@ translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *c
   }
 }
 
-static pic_value
-macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, struct pic_dict *cxt)
-{
-  size_t ai = pic_gc_arena_preserve(pic);
-  pic_value v, vs;
-
-  /* macroexpand in order */
-  vs = pic_nil_value();
-  while (pic_pair_p(list)) {
-    v = pic_car(pic, list);
-
-    vs = pic_cons(pic, macroexpand(pic, v, senv, cxt), vs);
-    list = pic_cdr(pic, list);
-
-    pic_gc_arena_restore(pic, ai);
-    pic_gc_protect(pic, vs);
-    pic_gc_protect(pic, list);
-  }
-
-  list = macroexpand(pic, list, senv, cxt);
-
-  /* reverse the result */
-  pic_for_each (v, vs) {
-    list = pic_cons(pic, v, list);
-
-    pic_gc_arena_restore(pic, ai);
-    pic_gc_protect(pic, vs);
-    pic_gc_protect(pic, list);
-  }
-
-  pic_gc_arena_restore(pic, ai);
-  pic_gc_protect(pic, list);
-  return list;
-}
-
 static pic_value
 macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -170,37 +135,9 @@ macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pi
 }
 
 static pic_value
-macroexpand_deflibrary(pic_state *pic, pic_value expr)
+macroexpand_quote(pic_state *pic, pic_value expr)
 {
-  struct pic_lib *prev = pic->lib;
-  pic_value v;
-
-  if (pic_length(pic, expr) < 2) {
-    pic_error(pic, "syntax error");
-  }
-
-  pic_make_library(pic, pic_cadr(pic, expr));
-
-  pic_try {
-    pic_in_library(pic, pic_cadr(pic, expr));
-
-    pic_for_each (v, pic_cddr(pic, expr)) {
-      size_t ai = pic_gc_arena_preserve(pic);
-
-      pic_eval(pic, v);
-
-      pic_gc_arena_restore(pic, ai);
-    }
-
-    pic_in_library(pic, prev->name);
-  }
-  pic_catch {
-    /* restores pic->lib even if an error occurs */
-    pic_in_library(pic, prev->name);
-    pic_throw_error(pic, pic->err);
-  }
-
-  return pic_none_value();
+  return pic_cons(pic, pic_sym_value(pic->sQUOTE), pic_cdr(pic, expr));
 }
 
 static pic_value
@@ -251,6 +188,39 @@ macroexpand_export(pic_state *pic, pic_value expr)
   return pic_none_value();
 }
 
+static pic_value
+macroexpand_deflibrary(pic_state *pic, pic_value expr)
+{
+  struct pic_lib *prev = pic->lib;
+  pic_value v;
+
+  if (pic_length(pic, expr) < 2) {
+    pic_error(pic, "syntax error");
+  }
+
+  pic_make_library(pic, pic_cadr(pic, expr));
+
+  pic_try {
+    pic_in_library(pic, pic_cadr(pic, expr));
+
+    pic_for_each (v, pic_cddr(pic, expr)) {
+      size_t ai = pic_gc_arena_preserve(pic);
+
+      pic_eval(pic, v);
+
+      pic_gc_arena_restore(pic, ai);
+    }
+
+    pic_in_library(pic, prev->name);
+  }
+  pic_catch {
+    pic_in_library(pic, prev->name);    /* restores pic->lib even if an error occurs */
+    pic_throw_error(pic, pic->err);
+  }
+
+  return pic_none_value();
+}
+
 static pic_value
 macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -337,6 +307,74 @@ macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_senv *senv)
   return pic_none_value();
 }
 
+static pic_value
+macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  pic_value v, args;
+
+#if DEBUG
+  puts("before expand-1:");
+  pic_debug(pic, expr);
+  puts("");
+#endif
+
+  if (mac->senv == NULL) { /* legacy macro */
+    args = pic_cdr(pic, expr);
+  }
+  else {
+    args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
+  }
+
+  pic_try {
+    v = pic_apply(pic, mac->proc, args);
+  } pic_catch {
+    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+  }
+
+#if DEBUG
+  puts("after expand-1:");
+  pic_debug(pic, v);
+  puts("");
+#endif
+
+  return macroexpand(pic, v, senv, cxt);
+}
+
+static pic_value
+macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  size_t ai = pic_gc_arena_preserve(pic);
+  pic_value v, vs;
+
+  /* macroexpand in order */
+  vs = pic_nil_value();
+  while (pic_pair_p(list)) {
+    v = pic_car(pic, list);
+
+    vs = pic_cons(pic, macroexpand(pic, v, senv, cxt), vs);
+    list = pic_cdr(pic, list);
+
+    pic_gc_arena_restore(pic, ai);
+    pic_gc_protect(pic, vs);
+    pic_gc_protect(pic, list);
+  }
+
+  list = macroexpand(pic, list, senv, cxt);
+
+  /* reverse the result */
+  pic_for_each (v, vs) {
+    list = pic_cons(pic, v, list);
+
+    pic_gc_arena_restore(pic, ai);
+    pic_gc_protect(pic, vs);
+    pic_gc_protect(pic, list);
+  }
+
+  pic_gc_arena_restore(pic, ai);
+  pic_gc_protect(pic, list);
+  return list;
+}
+
 static pic_value
 macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -400,45 +438,6 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
   return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body));
 }
 
-static pic_value
-macroexpand_quote(pic_state *pic, pic_value expr)
-{
-  return pic_cons(pic, pic_sym_value(pic->sQUOTE), pic_cdr(pic, expr));
-}
-
-static pic_value
-macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
-{
-  pic_value v, args;
-
-#if DEBUG
-  puts("before expand-1:");
-  pic_debug(pic, expr);
-  puts("");
-#endif
-
-  if (mac->senv == NULL) { /* legacy macro */
-    args = pic_cdr(pic, expr);
-  }
-  else {
-    args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
-  }
-
-  pic_try {
-    v = pic_apply(pic, mac->proc, args);
-  } pic_catch {
-    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
-  }
-
-#if DEBUG
-  puts("after expand-1:");
-  pic_debug(pic, v);
-  puts("");
-#endif
-
-  return macroexpand(pic, v, senv, cxt);
-}
-
 static pic_value
 macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {

From c57f8a5016c962c5da702f6943434e62ac44e6f5 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 20:20:04 +0900
Subject: [PATCH 07/12] add pic_void macro

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

diff --git a/include/picrin.h b/include/picrin.h
index 2bf9f9fd..e6846994 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -127,6 +127,13 @@ void pic_gc_run(pic_state *);
 pic_value pic_gc_protect(pic_state *, pic_value);
 size_t pic_gc_arena_preserve(pic_state *);
 void pic_gc_arena_restore(pic_state *, size_t);
+#define pic_void(exec)                          \
+  pic_void_(GENSYM(ai), exec)
+#define pic_void_(ai,exec) do {                 \
+    size_t ai = pic_gc_arena_preserve(pic);     \
+    exec;                                       \
+    pic_gc_arena_restore(pic, ai);              \
+  } while (0)
 
 pic_state *pic_open(int argc, char *argv[], char **envp);
 void pic_close(pic_state *);
diff --git a/src/macro.c b/src/macro.c
index 683c429b..1328581f 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -204,17 +204,13 @@ macroexpand_deflibrary(pic_state *pic, pic_value expr)
     pic_in_library(pic, pic_cadr(pic, expr));
 
     pic_for_each (v, pic_cddr(pic, expr)) {
-      size_t ai = pic_gc_arena_preserve(pic);
-
-      pic_eval(pic, v);
-
-      pic_gc_arena_restore(pic, ai);
+      pic_void(pic_eval(pic, v));
     }
 
     pic_in_library(pic, prev->name);
   }
   pic_catch {
-    pic_in_library(pic, prev->name);    /* restores pic->lib even if an error occurs */
+    pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */
     pic_throw_error(pic, pic->err);
   }
 

From 6cf4fe942a99f1a4806d30b5a45dbaaff1be308a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 20:32:26 +0900
Subject: [PATCH 08/12] rewrite iteration with recursion. since we have
 variable-length arena now, it is no longer required to avoid big arena
 consumption.

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

diff --git a/src/macro.c b/src/macro.c
index 1328581f..541e0c92 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -337,38 +337,22 @@ macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct
 }
 
 static pic_value
-macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, struct pic_dict *cxt)
+macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv, struct pic_dict *cxt)
 {
   size_t ai = pic_gc_arena_preserve(pic);
-  pic_value v, vs;
+  pic_value x, head, tail;
 
-  /* macroexpand in order */
-  vs = pic_nil_value();
-  while (pic_pair_p(list)) {
-    v = pic_car(pic, list);
-
-    vs = pic_cons(pic, macroexpand(pic, v, senv, cxt), vs);
-    list = pic_cdr(pic, list);
-
-    pic_gc_arena_restore(pic, ai);
-    pic_gc_protect(pic, vs);
-    pic_gc_protect(pic, list);
-  }
-
-  list = macroexpand(pic, list, senv, cxt);
-
-  /* reverse the result */
-  pic_for_each (v, vs) {
-    list = pic_cons(pic, v, list);
-
-    pic_gc_arena_restore(pic, ai);
-    pic_gc_protect(pic, vs);
-    pic_gc_protect(pic, list);
+  if (pic_pair_p(obj)) {
+    head = macroexpand(pic, pic_car(pic, obj), senv, cxt);
+    tail = macroexpand_list(pic, pic_cdr(pic, obj), senv, cxt);
+    x = pic_cons(pic, head, tail);
+  } else {
+    x = macroexpand(pic, obj, senv, cxt);
   }
 
   pic_gc_arena_restore(pic, ai);
-  pic_gc_protect(pic, list);
-  return list;
+  pic_gc_protect(pic, x);
+  return x;
 }
 
 static pic_value

From e08ec23a9fca75d8a1f19b955cc9e19aa6dee91a Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 20:39:34 +0900
Subject: [PATCH 09/12] s/formals/formal/g

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

diff --git a/src/macro.c b/src/macro.c
index 541e0c92..2c800cc3 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -359,19 +359,19 @@ static pic_value
 macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
   pic_sym sym;
-  pic_value formals;
+  pic_value formal;
 
   if (pic_length(pic, expr) < 2) {
     pic_error(pic, "syntax error");
   }
 
-  formals = pic_cadr(pic, expr);
-  if (pic_pair_p(formals)) {
-    struct pic_senv *in = push_scope(pic, pic_cdr(pic, formals), senv, cxt);
+  formal = pic_cadr(pic, expr);
+  if (pic_pair_p(formal)) {
+    struct pic_senv *in = push_scope(pic, pic_cdr(pic, formal), senv, cxt);
     pic_value a;
 
     /* defined symbol */
-    a = pic_car(pic, formals);
+    a = pic_car(pic, formal);
     if (! pic_sym_p(a)) {
       a = macroexpand(pic, a, senv, cxt);
     }
@@ -390,13 +390,13 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
                              macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)));
   }
 
-  if (! pic_sym_p(formals)) {
-    formals = macroexpand(pic, formals, senv, cxt);
+  if (! pic_sym_p(formal)) {
+    formal = macroexpand(pic, formal, senv, cxt);
   }
-  if (! pic_sym_p(formals)) {
+  if (! pic_sym_p(formal)) {
     pic_error(pic, "binding to non-symbol object");
   }
-  sym = pic_sym(formals);
+  sym = pic_sym(formal);
   if (! pic_find_rename(pic, senv, sym, NULL)) {
     pic_add_rename(pic, senv, sym);
   }

From 1989a972cbd537e31df90690837fa6c910647b27 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 21:01:30 +0900
Subject: [PATCH 10/12] refactor macroexpand_define. make use of
 macroexpand_lambda function

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

diff --git a/src/macro.c b/src/macro.c
index 2c800cc3..d9782f60 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -355,55 +355,6 @@ macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv, struct pi
   return x;
 }
 
-static pic_value
-macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
-{
-  pic_sym sym;
-  pic_value formal;
-
-  if (pic_length(pic, expr) < 2) {
-    pic_error(pic, "syntax error");
-  }
-
-  formal = pic_cadr(pic, expr);
-  if (pic_pair_p(formal)) {
-    struct pic_senv *in = push_scope(pic, pic_cdr(pic, formal), senv, cxt);
-    pic_value a;
-
-    /* defined symbol */
-    a = pic_car(pic, formal);
-    if (! pic_sym_p(a)) {
-      a = macroexpand(pic, a, senv, cxt);
-    }
-    if (! pic_sym_p(a)) {
-      pic_error(pic, "binding to non-symbol object");
-    }
-    sym = pic_sym(a);
-    if (! pic_find_rename(pic, senv, sym, NULL)) {
-      pic_add_rename(pic, senv, sym);
-    }
-
-    /* binding value */
-    return pic_cons(pic, pic_sym_value(pic->sDEFINE),
-                    pic_cons(pic,
-                             macroexpand_list(pic, pic_cadr(pic, expr), in, cxt),
-                             macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)));
-  }
-
-  if (! pic_sym_p(formal)) {
-    formal = macroexpand(pic, formal, senv, cxt);
-  }
-  if (! pic_sym_p(formal)) {
-    pic_error(pic, "binding to non-symbol object");
-  }
-  sym = pic_sym(formal);
-  if (! pic_find_rename(pic, senv, sym, NULL)) {
-    pic_add_rename(pic, senv, sym);
-  }
-
-  return pic_cons(pic, pic_sym_value(pic->sDEFINE), macroexpand_list(pic, pic_cdr(pic, expr), senv, cxt));
-}
-
 static pic_value
 macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -418,6 +369,44 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
   return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body));
 }
 
+static pic_value
+macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  pic_sym sym;
+  pic_value formal, body, var, val;
+
+  if (pic_length(pic, expr) < 2) {
+    pic_error(pic, "syntax error");
+  }
+
+  formal = pic_cadr(pic, expr);
+  if (pic_pair_p(formal)) {
+    var = pic_car(pic, formal);
+  } else {
+    if (pic_length(pic, expr) != 3) {
+      pic_error(pic, "syntax error");
+    }
+    var = formal;
+  }
+  if (! pic_sym_p(var)) {
+    var = macroexpand(pic, var, senv, cxt);
+  }
+  if (! pic_sym_p(var)) {
+    pic_error(pic, "binding to non-symbol object");
+  }
+  sym = pic_sym(var);
+  if (! pic_find_rename(pic, senv, sym, NULL)) {
+    pic_add_rename(pic, senv, sym);
+  }
+  body = pic_cddr(pic, expr);
+  if (pic_pair_p(formal)) {
+    val = macroexpand_lambda(pic, pic_cons(pic, pic_false_value(), pic_cons(pic, pic_cdr(pic, formal), body)), senv, cxt);
+  } else {
+    val = macroexpand(pic, pic_car(pic, body), senv, cxt);
+  }
+  return pic_list3(pic, pic_sym_value(pic->sDEFINE), macroexpand_symbol(pic, sym, senv, cxt), val);
+}
+
 static pic_value
 macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {

From 730cfc860147e3bd6c943467c88807c3e3104244 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 21:05:57 +0900
Subject: [PATCH 11/12] refactor macroexpand_lambda

---
 src/macro.c | 67 +++++++++++++++++++++++++----------------------------
 1 file changed, 31 insertions(+), 36 deletions(-)

diff --git a/src/macro.c b/src/macro.c
index d9782f60..6af79e51 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -11,8 +11,6 @@
 #include "picrin/error.h"
 #include "picrin/dict.h"
 
-static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
-
 pic_sym
 pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
 {
@@ -70,39 +68,6 @@ find_macro(pic_state *pic, pic_sym rename)
   return xh_val(e, struct pic_macro *);
 }
 
-static struct pic_senv *
-push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, struct pic_dict *cxt)
-{
-  struct pic_senv *senv;
-  pic_value a;
-
-  senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-  senv->up = up;
-  xh_init_int(&senv->renames, sizeof(pic_sym));
-
-  for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
-    pic_value v = pic_car(pic, a);
-
-    if (! pic_sym_p(v)) {
-      v = macroexpand(pic, v, up, cxt);
-    }
-    if (! pic_sym_p(v)) {
-      pic_error(pic, "syntax error");
-    }
-    pic_add_rename(pic, senv, pic_sym(v));
-  }
-  if (! pic_sym_p(a)) {
-    a = macroexpand(pic, a, up, cxt);
-  }
-  if (pic_sym_p(a)) {
-    pic_add_rename(pic, senv, pic_sym(a));
-  }
-  else if (! pic_nil_p(a)) {
-    pic_error(pic, "syntax error");
-  }
-  return senv;
-}
-
 static pic_sym
 translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -128,6 +93,8 @@ translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *c
   }
 }
 
+static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
+
 static pic_value
 macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -360,8 +327,36 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
 {
   pic_value formal, body;
   struct pic_senv *in;
+  pic_value a;
 
-  in = push_scope(pic, pic_cadr(pic, expr), senv, cxt);
+  if (pic_length(pic, expr) < 2) {
+    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->renames, sizeof(pic_sym));
+
+  for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
+    pic_value v = pic_car(pic, a);
+
+    if (! pic_sym_p(v)) {
+      v = macroexpand(pic, v, senv, cxt);
+    }
+    if (! pic_sym_p(v)) {
+      pic_error(pic, "syntax error");
+    }
+    pic_add_rename(pic, in, pic_sym(v));
+  }
+  if (! pic_sym_p(a)) {
+    a = macroexpand(pic, a, senv, cxt);
+  }
+  if (pic_sym_p(a)) {
+    pic_add_rename(pic, in, pic_sym(a));
+  }
+  else if (! pic_nil_p(a)) {
+    pic_error(pic, "syntax error");
+  }
 
   formal = macroexpand_list(pic, pic_cadr(pic, expr), in, cxt);
   body = macroexpand_list(pic, pic_cddr(pic, expr), in, cxt);

From 6c45bb3c5d2c777760c146154de96193a8fd3b00 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 13 Jul 2014 22:36:30 +0900
Subject: [PATCH 12/12] support let-syntax

---
 include/picrin.h |   1 +
 src/init.c       |   2 +
 src/macro.c      | 284 +++++++++++++++++++++++++++--------------------
 src/state.c      |   2 +
 4 files changed, 170 insertions(+), 119 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index e6846994..6b6629a5 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -81,6 +81,7 @@ typedef struct {
   pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
   pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
   pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO;
+  pic_sym sLET_SYNTAX, sLETREC_SYNTAX;
   pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT;
   pic_sym sCONS, sCAR, sCDR, sNILP;
   pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
diff --git a/src/init.c b/src/init.c
index 5770d819..b6051a3f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -75,6 +75,8 @@ pic_init_core(pic_state *pic)
     pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sIF);
     pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sBEGIN);
     pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sDEFINE_SYNTAX);
+    pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLET_SYNTAX);
+    pic_define_syntactic_keyword(pic, pic->lib->senv, pic->sLETREC_SYNTAX);
 
     pic_init_bool(pic); DONE;
     pic_init_pair(pic); DONE;
diff --git a/src/macro.c b/src/macro.c
index 6af79e51..c9da6aee 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -184,125 +184,6 @@ macroexpand_deflibrary(pic_state *pic, pic_value expr)
   return pic_none_value();
 }
 
-static pic_value
-macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
-{
-  pic_value var, val;
-  pic_sym sym, rename;
-
-  if (pic_length(pic, expr) != 3) {
-    pic_error(pic, "syntax error");
-  }
-
-  var = pic_cadr(pic, expr);
-  if (! pic_sym_p(var)) {
-    var = macroexpand(pic, var, senv, cxt);
-  }
-  if (! pic_sym_p(var)) {
-    pic_error(pic, "binding to non-symbol object");
-  }
-  sym = pic_sym(var);
-  if (! pic_find_rename(pic, senv, sym, &rename)) {
-    rename = pic_add_rename(pic, senv, sym);
-  }
-
-  val = pic_cadr(pic, pic_cdr(pic, expr));
-
-  pic_try {
-    val = pic_eval(pic, val);
-  } pic_catch {
-    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
-  }
-
-  if (! pic_proc_p(val)) {
-    pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
-  }
-
-  define_macro(pic, rename, pic_proc_ptr(val), senv);
-
-  return pic_none_value();
-}
-
-static pic_value
-macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_senv *senv)
-{
-  pic_value var, val;
-  pic_sym sym, rename;
-
-  if (pic_length(pic, expr) < 2) {
-    pic_error(pic, "syntax error");
-  }
-
-  var = pic_car(pic, pic_cdr(pic, expr));
-  if (pic_pair_p(var)) {
-    /* FIXME: unhygienic */
-    val = pic_cons(pic, pic_sym_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_sym_p(var)) {
-    pic_error(pic, "syntax error");
-  }
-  sym = pic_sym(var);
-  if (! pic_find_rename(pic, senv, sym, &rename)) {
-    rename = pic_add_rename(pic, senv, sym);
-  }
-
-  pic_try {
-    val = pic_eval(pic, val);
-  } pic_catch {
-    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
-  }
-
-  if (! pic_proc_p(val)) {
-    pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
-  }
-
-  define_macro(pic, rename, pic_proc_ptr(val), NULL);
-
-  return pic_none_value();
-}
-
-static pic_value
-macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
-{
-  pic_value v, args;
-
-#if DEBUG
-  puts("before expand-1:");
-  pic_debug(pic, expr);
-  puts("");
-#endif
-
-  if (mac->senv == NULL) { /* legacy macro */
-    args = pic_cdr(pic, expr);
-  }
-  else {
-    args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
-  }
-
-  pic_try {
-    v = pic_apply(pic, mac->proc, args);
-  } pic_catch {
-    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
-  }
-
-#if DEBUG
-  puts("after expand-1:");
-  pic_debug(pic, v);
-  puts("");
-#endif
-
-  return macroexpand(pic, v, senv, cxt);
-}
-
 static pic_value
 macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -402,6 +283,165 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
   return pic_list3(pic, pic_sym_value(pic->sDEFINE), macroexpand_symbol(pic, sym, senv, cxt), val);
 }
 
+static pic_value
+macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  pic_value var, val;
+  pic_sym sym, rename;
+
+  if (pic_length(pic, expr) != 3) {
+    pic_error(pic, "syntax error");
+  }
+
+  var = pic_cadr(pic, expr);
+  if (! pic_sym_p(var)) {
+    var = macroexpand(pic, var, senv, cxt);
+  }
+  if (! pic_sym_p(var)) {
+    pic_error(pic, "binding to non-symbol object");
+  }
+  sym = pic_sym(var);
+  if (! pic_find_rename(pic, senv, sym, &rename)) {
+    rename = pic_add_rename(pic, senv, sym);
+  }
+
+  val = pic_cadr(pic, pic_cdr(pic, expr));
+
+  pic_try {
+    val = pic_eval(pic, val);
+  } pic_catch {
+    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+  }
+
+  if (! pic_proc_p(val)) {
+    pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
+  }
+
+  define_macro(pic, rename, pic_proc_ptr(val), senv);
+
+  return pic_none_value();
+}
+
+static pic_value
+macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_senv *senv)
+{
+  pic_value var, val;
+  pic_sym sym, rename;
+
+  if (pic_length(pic, expr) < 2) {
+    pic_error(pic, "syntax error");
+  }
+
+  var = pic_car(pic, pic_cdr(pic, expr));
+  if (pic_pair_p(var)) {
+    /* FIXME: unhygienic */
+    val = pic_cons(pic, pic_sym_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_sym_p(var)) {
+    pic_error(pic, "syntax error");
+  }
+  sym = pic_sym(var);
+  if (! pic_find_rename(pic, senv, sym, &rename)) {
+    rename = pic_add_rename(pic, senv, sym);
+  }
+
+  pic_try {
+    val = pic_eval(pic, val);
+  } pic_catch {
+    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+  }
+
+  if (! pic_proc_p(val)) {
+    pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
+  }
+
+  define_macro(pic, rename, pic_proc_ptr(val), NULL);
+
+  return pic_none_value();
+}
+
+static pic_value
+macroexpand_let_syntax(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  struct pic_senv *in;
+  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->renames, sizeof(pic_sym));
+
+  if (pic_length(pic, expr) < 2) {
+    pic_error(pic, "syntax error");
+  }
+
+  formal = pic_cadr(pic, expr);
+  if (! pic_list_p(formal)) {
+    pic_error(pic, "syntax error");
+  }
+  pic_for_each (v, formal) {
+    var = pic_car(pic, v);
+    if (! pic_sym_p(var)) {
+      var = macroexpand(pic, var, senv, cxt);
+    }
+    if (! pic_sym_p(var)) {
+      pic_error(pic, "binding to non-symbol object");
+    }
+    sym = pic_sym(var);
+    if (! pic_find_rename(pic, in, sym, &rename)) {
+      rename = pic_add_rename(pic, in, sym);
+    }
+    val = pic_eval(pic, pic_cadr(pic, v));
+    if (! pic_proc_p(val)) {
+      pic_errorf(pic, "macro definition \"~s\" evaluated to non-procedure object", var);
+    }
+    define_macro(pic, rename, pic_proc_ptr(val), senv);
+  }
+  return pic_cons(pic, pic_sym_value(pic->sBEGIN), macroexpand_list(pic, pic_cddr(pic, expr), in, cxt));
+}
+
+static pic_value
+macroexpand_macro(pic_state *pic, struct pic_macro *mac, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
+{
+  pic_value v, args;
+
+#if DEBUG
+  puts("before expand-1:");
+  pic_debug(pic, expr);
+  puts("");
+#endif
+
+  if (mac->senv == NULL) { /* legacy macro */
+    args = pic_cdr(pic, expr);
+  }
+  else {
+    args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
+  }
+
+  pic_try {
+    v = pic_apply(pic, mac->proc, args);
+  } pic_catch {
+    pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
+  }
+
+#if DEBUG
+  puts("after expand-1:");
+  pic_debug(pic, v);
+  puts("");
+#endif
+
+  return macroexpand(pic, v, senv, cxt);
+}
+
 static pic_value
 macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
 {
@@ -445,6 +485,12 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct p
       else if (tag == pic->sDEFINE_MACRO) {
         return macroexpand_defmacro(pic, expr, senv);
       }
+      else if (tag == pic->sLET_SYNTAX) {
+        return macroexpand_let_syntax(pic, expr, senv, cxt);
+      }
+      /* else if (tag == pic->sLETREC_SYNTAX) { */
+      /*   return macroexpand_letrec_syntax(pic, expr, senv, cxt); */
+      /* } */
       else if (tag == pic->sLAMBDA) {
         return macroexpand_lambda(pic, expr, senv, cxt);
       }
diff --git a/src/state.c b/src/state.c
index 63a25254..9db4986b 100644
--- a/src/state.c
+++ b/src/state.c
@@ -96,6 +96,8 @@ pic_open(int argc, char *argv[], char **envp)
   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, sLET_SYNTAX, "let-syntax");
+  register_core_symbol(pic, sLETREC_SYNTAX, "letrec-syntax");
   register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
   register_core_symbol(pic, sIMPORT, "import");
   register_core_symbol(pic, sEXPORT, "export");