From 8781b9a6aaa7ecc50d15b8f9418b315723d1005c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 17 Jul 2014 13:58:45 +0900
Subject: [PATCH] publish pic_identifier_p and pic_identifier_eq_p

---
 include/picrin/macro.h |  3 +++
 src/macro.c            | 57 ++++++++++++++++++------------------------
 2 files changed, 27 insertions(+), 33 deletions(-)

diff --git a/include/picrin/macro.h b/include/picrin/macro.h
index b733a5fe..31fe5983 100644
--- a/include/picrin/macro.h
+++ b/include/picrin/macro.h
@@ -38,6 +38,9 @@ struct pic_sc {
 
 struct pic_senv *pic_null_syntactic_environment(pic_state *);
 
+bool pic_identifier_p(pic_state *pic, pic_value obj);
+bool pic_identifier_eq_p(pic_state *, struct pic_senv *, pic_sym, struct pic_senv *, pic_sym);
+
 pic_sym pic_add_rename(pic_state *, struct pic_senv *, pic_sym);
 bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym * /* = NULL */);
 void pic_put_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym);
diff --git a/src/macro.c b/src/macro.c
index c6a5c286..859bdeb5 100644
--- a/src/macro.c
+++ b/src/macro.c
@@ -615,6 +615,25 @@ pic_defmacro(pic_state *pic, const char *name, struct pic_proc *macro)
   pic_export(pic, sym);
 }
 
+bool
+pic_identifier_p(pic_state *pic, pic_value obj)
+{
+  return pic_sym_p(obj) && ! pic_interned_p(pic, pic_sym(obj));
+}
+
+bool
+pic_identifier_eq_p(pic_state *pic, struct pic_senv *e1, pic_sym x, struct pic_senv *e2, pic_sym y)
+{
+  struct pic_dict *cxt;
+
+  cxt = pic_dict_new(pic);
+
+  x = make_identifier(pic, x, e1, cxt);
+  y = make_identifier(pic, y, e2, cxt);
+
+  return x == y;
+}
+
 static pic_value
 pic_macro_gensym(pic_state *pic)
 {
@@ -637,35 +656,6 @@ pic_macro_macroexpand(pic_state *pic)
   return pic_macroexpand(pic, expr);
 }
 
-static bool
-sc_identifier_p(pic_value obj)
-{
-  if (pic_sym_p(obj)) {
-    return true;
-  }
-  if (pic_sc_p(obj)) {
-    return sc_identifier_p(pic_sc_ptr(obj)->expr);
-  }
-  return false;
-}
-
-static bool
-sc_identifier_eq_p(pic_state *pic, struct pic_senv *e1, pic_value x, struct pic_senv *e2, pic_value y)
-{
-  struct pic_dict *cxt;
-
-  if (! (sc_identifier_p(x) && sc_identifier_p(y))) {
-    return false;
-  }
-
-  cxt = pic_dict_new(pic);
-
-  x = macroexpand(pic, x, e1, cxt);
-  y = macroexpand(pic, y, e2, cxt);
-
-  return pic_eq_p(x, y);
-}
-
 static pic_value
 pic_macro_identifier_p(pic_state *pic)
 {
@@ -673,16 +663,17 @@ pic_macro_identifier_p(pic_state *pic)
 
   pic_get_args(pic, "o", &obj);
 
-  return pic_bool_value(sc_identifier_p(obj));
+  return pic_bool_value(pic_identifier_p(pic, obj));
 }
 
 static pic_value
 pic_macro_identifier_eq_p(pic_state *pic)
 {
-  pic_value e, x, f, y;
+  pic_sym x, y;
+  pic_value e, f;
   struct pic_senv *e1, *e2;
 
-  pic_get_args(pic, "oooo", &e, &x, &f, &y);
+  pic_get_args(pic, "omom", &e, &x, &f, &y);
 
   if (! pic_senv_p(e)) {
     pic_error(pic, "unexpected type of argument 1");
@@ -693,7 +684,7 @@ pic_macro_identifier_eq_p(pic_state *pic)
   }
   e2 = pic_senv_ptr(f);
 
-  return pic_bool_value(sc_identifier_eq_p(pic, e1, x, e2, y));
+  return pic_bool_value(pic_identifier_eq_p(pic, e1, x, e2, y));
 }
 
 static pic_value