From 6966cdfa3192e3b22bbc1659039e41381de3ef22 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 26 Jul 2014 13:58:31 +0900
Subject: [PATCH 1/4] change gensym convension: don't rename renamed symbols
 with '@', use '.' instead

---
 src/symbol.c | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/symbol.c b/src/symbol.c
index 1ebbdc3d..7f49ce9d 100644
--- a/src/symbol.c
+++ b/src/symbol.c
@@ -41,12 +41,18 @@ pic_sym
 pic_gensym(pic_state *pic, pic_sym base)
 {
   int uid = pic->uniq_sym_cnt++, len;
-  char *str;
+  char *str, mark;
   pic_sym uniq;
 
-  len = snprintf(NULL, 0, "%s@%d", pic_symbol_name(pic, base), uid);
+  if (pic_interned_p(pic, base)) {
+    mark = '@';
+  } else {
+    mark = '.';
+  }
+
+  len = snprintf(NULL, 0, "%s%c%d", pic_symbol_name(pic, base), mark, uid);
   str = pic_alloc(pic, len + 1);
-  sprintf(str, "%s@%d", pic_symbol_name(pic, base), uid);
+  sprintf(str, "%s%c%d", pic_symbol_name(pic, base), mark, uid);
 
   /* don't put the symbol to pic->syms to keep it uninterned */
   uniq = pic->sym_cnt++;

From 5ba0c563083220fe8cbe77c0e73b128c669b9bfb Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 26 Jul 2014 14:04:34 +0900
Subject: [PATCH 2/4] add pic_ungensym

---
 include/picrin.h |  1 +
 src/symbol.c     | 16 ++++++++++++++++
 2 files changed, 17 insertions(+)

diff --git a/include/picrin.h b/include/picrin.h
index b4036cb5..29640fa7 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -153,6 +153,7 @@ pic_sym pic_intern(pic_state *, const char *, size_t);
 pic_sym pic_intern_cstr(pic_state *, const char *);
 const char *pic_symbol_name(pic_state *, pic_sym);
 pic_sym pic_gensym(pic_state *, pic_sym);
+pic_sym pic_ungensym(pic_state *, pic_sym);
 bool pic_interned_p(pic_state *, pic_sym);
 
 char *pic_strdup(pic_state *, const char *);
diff --git a/src/symbol.c b/src/symbol.c
index 7f49ce9d..2ea530d5 100644
--- a/src/symbol.c
+++ b/src/symbol.c
@@ -61,6 +61,22 @@ pic_gensym(pic_state *pic, pic_sym base)
   return uniq;
 }
 
+pic_sym
+pic_ungensym(pic_state *pic, pic_sym base)
+{
+  const char *name, *occr;
+
+  if (pic_interned_p(pic, base)) {
+    return base;
+  }
+
+  name = pic_symbol_name(pic, base);
+  if ((occr = strrchr(name, '@')) == NULL) {
+    pic_abort(pic, "logic flaw");
+  }
+  return pic_intern(pic, name, occr - name);
+}
+
 bool
 pic_interned_p(pic_state *pic, pic_sym sym)
 {

From b4a0761eb3c724070a7b0eaa36e01f6bbe74df1f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 26 Jul 2014 14:10:17 +0900
Subject: [PATCH 3/4] publish ungensym

---
 docs/libs.rst |  1 +
 src/macro.c   | 11 +++++++++++
 2 files changed, 12 insertions(+)

diff --git a/docs/libs.rst b/docs/libs.rst
index b87d7980..c0631b74 100644
--- a/docs/libs.rst
+++ b/docs/libs.rst
@@ -49,6 +49,7 @@ Utility functions and syntaces for macro definition.
 
 - define-macro
 - gensym
+- ungensym
 - macroexpand
 - macroexpand-1
 
diff --git a/src/macro.c b/src/macro.c
index 14b67d9c..9979db96 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -577,6 +577,16 @@ pic_macro_gensym(pic_state *pic)
   return pic_sym_value(uniq);
 }
 
+static pic_value
+pic_macro_ungensym(pic_state *pic)
+{
+  pic_sym sym;
+
+  pic_get_args(pic, "m", &sym);
+
+  return pic_sym_value(pic_ungensym(pic, sym));
+}
+
 static pic_value
 pic_macro_macroexpand(pic_state *pic)
 {
@@ -652,6 +662,7 @@ pic_init_macro(pic_state *pic)
 {
   pic_deflibrary ("(picrin macro)") {
     pic_defun(pic, "gensym", pic_macro_gensym);
+    pic_defun(pic, "ungensym", pic_macro_ungensym);
     pic_defun(pic, "macroexpand", pic_macro_macroexpand);
     pic_defun(pic, "macroexpand-1", pic_macro_macroexpand_1);
     pic_defun(pic, "identifier?", pic_macro_identifier_p);

From e53472d9cc97faf7810a182409d602e00b7966bd Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 26 Jul 2014 14:13:12 +0900
Subject: [PATCH 4/4] add strip-syntax

---
 docs/libs.rst           | 1 +
 piclib/picrin/macro.scm | 4 ++++
 2 files changed, 5 insertions(+)

diff --git a/docs/libs.rst b/docs/libs.rst
index c0631b74..f8d417c2 100644
--- a/docs/libs.rst
+++ b/docs/libs.rst
@@ -69,6 +69,7 @@ Syntactic closures.
 
 - er-macro-transformer
 - ir-macro-transformer
+- strip-syntax
 
 Explicit renaming macro family.
 
diff --git a/piclib/picrin/macro.scm b/piclib/picrin/macro.scm
index 5682d8ca..96650e2a 100644
--- a/piclib/picrin/macro.scm
+++ b/piclib/picrin/macro.scm
@@ -106,6 +106,9 @@
                   (rename sym)))
             (f (walk inject expr) inject compare))))
 
+  (define (strip-syntax form)
+    (walk ungensym form))
+
   (define-syntax define-macro
     (er-macro-transformer
      (lambda (expr r c)
@@ -127,4 +130,5 @@
           rsc-macro-transformer
           er-macro-transformer
           ir-macro-transformer
+          strip-syntax
           define-macro))