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] 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,