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] 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)
 {