[WIP] replace macro expander

remove define-syntax, add define-macro instead

saner display when writing identifiers

extlib/benz/gc.c

@@ -411,14 +411,24 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_BLOB: {
     break;
   }
+  case PIC_TT_ID: {
+    struct pic_id *id = (struct pic_id *)obj;
+    gc_mark(pic, id->var);
+    gc_mark_object(pic, (struct pic_object *)id->env);
+    break;
+  }
   case PIC_TT_ENV: {
     struct pic_env *env = (struct pic_env *)obj;
+    xh_entry *it;
 
     if (env->up) {
       gc_mark_object(pic, (struct pic_object *)env->up);
     }
     gc_mark(pic, env->defer);
-    gc_mark_object(pic, (struct pic_object *)env->map);
+    for (it = xh_begin(&env->map); it != NULL; it = xh_next(it)) {
+      gc_mark_object(pic, xh_key(it, struct pic_object *));
+      gc_mark_object(pic, xh_val(it, struct pic_object *));
+    }
     break;
   }
   case PIC_TT_LIB: {
@@ -519,7 +529,7 @@ gc_mark_global_symbols(pic_state *pic)
 {
   M(sDEFINE); M(sLAMBDA); M(sIF); M(sBEGIN); M(sQUOTE); M(sSETBANG);
   M(sQUASIQUOTE); M(sUNQUOTE); M(sUNQUOTE_SPLICING);
-  M(sDEFINE_SYNTAX); M(sIMPORT); M(sEXPORT);
+  M(sDEFINE_MACRO); M(sIMPORT); M(sEXPORT);
   M(sDEFINE_LIBRARY);
   M(sCOND_EXPAND); M(sAND); M(sOR); M(sELSE); M(sLIBRARY);
   M(sONLY); M(sRENAME); M(sPREFIX); M(sEXCEPT);
@@ -532,7 +542,7 @@ gc_mark_global_symbols(pic_state *pic)
   M(sGREF); M(sLREF); M(sCREF); M(sRETURN);
 
   M(uDEFINE); M(uLAMBDA); M(uIF); M(uBEGIN); M(uQUOTE); M(uSETBANG);
-  M(uDEFINE_SYNTAX); M(uIMPORT); M(uEXPORT);
+  M(uDEFINE_MACRO); M(uIMPORT); M(uEXPORT);
   M(uDEFINE_LIBRARY);
   M(uCOND_EXPAND);
   M(uCONS); M(uCAR); M(uCDR); M(uNILP);
@@ -681,7 +691,12 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_ERROR: {
     break;
   }
+  case PIC_TT_ID: {
+    break;
+  }
   case PIC_TT_ENV: {
+    struct pic_env *env = (struct pic_env *)obj;
+    xh_destroy(&env->map);
     break;
   }
   case PIC_TT_LIB: {

extlib/benz/include/picrin.h

@@ -98,7 +98,7 @@ typedef struct {
 
   pic_sym *sDEFINE, *sLAMBDA, *sIF, *sBEGIN, *sQUOTE, *sSETBANG;
   pic_sym *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;
-  pic_sym *sDEFINE_SYNTAX, *sIMPORT, *sEXPORT;
+  pic_sym *sDEFINE_MACRO, *sIMPORT, *sEXPORT;
   pic_sym *sDEFINE_LIBRARY;
   pic_sym *sCOND_EXPAND, *sAND, *sOR, *sELSE, *sLIBRARY;
   pic_sym *sONLY, *sRENAME, *sPREFIX, *sEXCEPT;
@@ -112,7 +112,7 @@ typedef struct {
   pic_sym *sCALL_WITH_VALUES, *sTAILCALL_WITH_VALUES;
 
   pic_sym *uDEFINE, *uLAMBDA, *uIF, *uBEGIN, *uQUOTE, *uSETBANG;
-  pic_sym *uDEFINE_SYNTAX, *uIMPORT, *uEXPORT;
+  pic_sym *uDEFINE_MACRO, *uIMPORT, *uEXPORT;
   pic_sym *uDEFINE_LIBRARY;
   pic_sym *uCOND_EXPAND;
   pic_sym *uCONS, *uCAR, *uCDR, *uNILP;
@@ -127,6 +127,7 @@ typedef struct {
   pic_value features;
 
   xhash syms;                   /* name to symbol */
+  int ucnt;
   struct pic_dict *globals;
   struct pic_dict *macros;
   pic_value libs;
@@ -193,8 +194,6 @@ bool pic_equal_p(pic_state *, pic_value, pic_value);
 pic_sym *pic_intern(pic_state *, pic_str *);
 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 *);
-bool pic_interned_p(pic_state *, pic_sym *);
 
 pic_value pic_read(pic_state *, struct pic_port *);
 pic_value pic_read_cstr(pic_state *, const char *);

extlib/benz/include/picrin/macro.h

@@ -9,24 +9,35 @@
 extern "C" {
 #endif
 
+struct pic_id {
+  PIC_OBJECT_HEADER
+  pic_value var;
+  struct pic_env *env;
+};
+
 struct pic_env {
   PIC_OBJECT_HEADER
-  struct pic_dict *map;
+  xhash map;
   pic_value defer;
   struct pic_env *up;
 };
 
+#define pic_id_p(v) (pic_type(v) == PIC_TT_ID)
+#define pic_id_ptr(v) ((struct pic_id *)pic_ptr(v))
+
 #define pic_env_p(v) (pic_type(v) == PIC_TT_ENV)
 #define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v))
 
-bool pic_identifier_p(pic_state *pic, pic_value obj);
+struct pic_id *pic_make_id(pic_state *, pic_value, struct pic_env *);
-bool pic_identifier_eq_p(pic_state *, struct pic_env *, pic_sym *, struct pic_env *, pic_sym *);
-
 struct pic_env *pic_make_env(pic_state *, struct pic_env *);
 
-pic_sym *pic_add_rename(pic_state *, struct pic_env *, pic_sym *);
+pic_sym *pic_uniq(pic_state *, pic_value);
-pic_sym *pic_find_rename(pic_state *, struct pic_env *, pic_sym *);
+
-void pic_put_rename(pic_state *, struct pic_env *, pic_sym *, pic_sym *);
+pic_sym *pic_add_variable(pic_state *, struct pic_env *, pic_value);
+void pic_put_variable(pic_state *, struct pic_env *, pic_value, pic_sym *);
+pic_sym *pic_find_variable(pic_state *, struct pic_env *, pic_value);
+
+pic_sym *pic_var_name(pic_state *, pic_value);
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/value.h

@@ -157,6 +157,7 @@ enum pic_tt {
   PIC_TT_PROC,
   PIC_TT_PORT,
   PIC_TT_ERROR,
+  PIC_TT_ID,
   PIC_TT_CXT,
   PIC_TT_ENV,
   PIC_TT_LIB,
@@ -314,6 +315,8 @@ pic_type_repr(enum pic_tt tt)
     return "port";
   case PIC_TT_ERROR:
     return "error";
+  case PIC_TT_ID:
+    return "id";
   case PIC_TT_CXT:
     return "cxt";
   case PIC_TT_PROC:

extlib/benz/lib.c

@@ -110,14 +110,14 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
     pic_errorf(pic, "library not found: ~a", spec);
   }
   pic_dict_for_each (nick, lib->exports, iter) {
-    pic_sym *realname, *rename;
+    pic_sym *realname, *uid;
 
     realname = pic_sym_ptr(pic_dict_ref(pic, lib->exports, nick));
 
-    if ((rename = pic_find_rename(pic, lib->env, realname)) == NULL) {
+    if ((uid = pic_find_variable(pic, lib->env, pic_obj_value(realname))) == NULL) {
       pic_errorf(pic, "attempted to export undefined variable '~s'", pic_obj_value(realname));
     }
-    pic_dict_set(pic, imports, nick, pic_obj_value(rename));
+    pic_dict_set(pic, imports, nick, pic_obj_value(uid));
   }
 }
 
@@ -133,7 +133,7 @@ import(pic_state *pic, pic_value spec)
   import_table(pic, spec, imports);
 
   pic_dict_for_each (sym, imports, it) {
-    pic_put_rename(pic, pic->lib->env, sym, pic_sym_ptr(pic_dict_ref(pic, imports, sym)));
+    pic_put_variable(pic, pic->lib->env, pic_obj_value(sym), pic_sym_ptr(pic_dict_ref(pic, imports, sym)));
   }
 }
 

extlib/benz/macro.c

@@ -4,74 +4,155 @@
 
 #include "picrin.h"
 
-pic_sym *
+static bool
-pic_add_rename(pic_state *pic, struct pic_env *env, pic_sym *sym)
+pic_var_p(pic_value obj)
 {
-  pic_sym *rename = pic_gensym(pic, sym);
+  return pic_sym_p(obj) || pic_id_p(obj);
-
-  pic_put_rename(pic, env, sym, rename);
-
-  return rename;
 }
 
-void
+struct pic_id *
-pic_put_rename(pic_state *pic, struct pic_env *env, pic_sym *sym, pic_sym *rename)
+pic_make_id(pic_state *pic, pic_value var, struct pic_env *env)
 {
-  pic_dict_set(pic, env->map, sym, pic_obj_value(rename));
+  struct pic_id *id;
+
+  assert(pic_var_p(var));
+
+  id = (struct pic_id *)pic_obj_alloc(pic, sizeof(struct pic_id), PIC_TT_ID);
+  id->var = var;
+  id->env = env;
+  return id;
+}
+
+struct pic_env *
+pic_make_env(pic_state *pic, struct pic_env *up)
+{
+  struct pic_env *env;
+
+  env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
+  env->up = up;
+  env->defer = pic_nil_value();
+  xh_init_ptr(&env->map, sizeof(pic_sym *));
+  return env;
 }
 
 pic_sym *
-pic_find_rename(pic_state *pic, struct pic_env *env, pic_sym *sym)
+pic_var_name(pic_state PIC_UNUSED(*pic), pic_value var)
 {
-  if (! pic_dict_has(pic, env->map, sym)) {
+  assert(pic_var_p(var));
-    return NULL;
+
+  while (pic_id_p(var)) {
+    var = pic_id_ptr(var)->var;
   }
-  return pic_sym_ptr(pic_dict_ref(pic, env->map, sym));
+  return pic_sym_ptr(var);
 }
 
-static void
+pic_sym *
-define_macro(pic_state *pic, pic_sym *rename, struct pic_proc *mac)
+pic_uniq(pic_state *pic, pic_value var)
 {
-  pic_dict_set(pic, pic->macros, rename, pic_obj_value(mac));
+  pic_str *str;
-}
 
-static struct pic_proc *
+  assert(pic_var_p(var));
-find_macro(pic_state *pic, pic_sym *rename)
+
-{
+  str = pic_format(pic, "%s.%d", pic_symbol_name(pic, pic_var_name(pic, var)), pic->ucnt++);
-  if (! pic_dict_has(pic, pic->macros, rename)) {
+
-    return NULL;
+  return pic_intern(pic, str);
-  }
-  return pic_proc_ptr(pic_dict_ref(pic, pic->macros, rename));
 }
 
 static pic_sym *
-make_identifier(pic_state *pic, pic_sym *sym, struct pic_env *env)
+lookup(pic_state PIC_UNUSED(*pic), pic_value var, struct pic_env *env)
 {
-  pic_sym *rename;
+  xh_entry *e;
 
-  while (true) {
+  assert(pic_var_p(var));
-    if ((rename = pic_find_rename(pic, env, sym)) != NULL) {
+
-      return rename;
+  while (env != NULL) {
+    if ((e = xh_get_ptr(&env->map, pic_ptr(var))) != NULL) {
+      return xh_val(e, pic_sym *);
     }
-    if (! env->up)
-      break;
     env = env->up;
   }
-  if (! pic_interned_p(pic, sym)) {
+  return NULL;
-    return sym;
+}
+
+static pic_sym *
+resolve(pic_state *pic, pic_value var, struct pic_env *env)
+{
+  pic_sym *uid;
+
+  assert(pic_var_p(var));
+
+  while ((uid = lookup(pic, var, env)) == NULL) {
+    if (pic_sym_p(var)) {
+      return NULL;
+    }
+    env = pic_id_ptr(var)->env;
+    var = pic_id_ptr(var)->var;
   }
-  else {
+  return uid;
-    return pic_gensym(pic, sym);
+}
+
+pic_sym *
+pic_add_variable(pic_state *pic, struct pic_env *env, pic_value var)
+{
+  pic_sym *uid;
+
+  assert(pic_var_p(var));
+
+  uid = pic_uniq(pic, var);
+
+  pic_put_variable(pic, env, var, uid);
+
+  return uid;
+}
+
+void
+pic_put_variable(pic_state PIC_UNUSED(*pic), struct pic_env *env, pic_value var, pic_sym *uid)
+{
+  assert(pic_var_p(var));
+
+  xh_put_ptr(&env->map, pic_ptr(var), &uid);
+}
+
+pic_sym *
+pic_find_variable(pic_state PIC_UNUSED(*pic), struct pic_env *env, pic_value var)
+{
+  xh_entry *e;
+
+  assert(pic_var_p(var));
+
+  if ((e = xh_get_ptr(&env->map, pic_ptr(var))) == NULL) {
+    return NULL;
   }
+  return xh_val(e, pic_sym *);
+}
+
+static void
+define_macro(pic_state *pic, pic_sym *uid, struct pic_proc *mac)
+{
+  pic_dict_set(pic, pic->macros, uid, pic_obj_value(mac));
+}
+
+static struct pic_proc *
+find_macro(pic_state *pic, pic_sym *uid)
+{
+  if (! pic_dict_has(pic, pic->macros, uid)) {
+    return NULL;
+  }
+  return pic_proc_ptr(pic_dict_ref(pic, pic->macros, uid));
 }
 
 static pic_value macroexpand(pic_state *, pic_value, struct pic_env *);
 static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_env *);
 
 static pic_value
-macroexpand_symbol(pic_state *pic, pic_sym *sym, struct pic_env *env)
+macroexpand_var(pic_state *pic, pic_value var, struct pic_env *env)
 {
-  return pic_obj_value(make_identifier(pic, sym, env));
+  pic_sym *uid;
+
+  if ((uid = resolve(pic, var, env)) == NULL) {
+    pic_errorf(pic, "unbound variable found: ~s", var);
+  }
+  return pic_obj_value(uid);
 }
 
 static pic_value
@@ -142,15 +223,15 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
   in = pic_make_env(pic, env);
 
   for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
-    pic_value v = pic_car(pic, a);
+    pic_value var = pic_car(pic, a);
 
-    if (! pic_sym_p(v)) {
+    if (! pic_var_p(var)) {
       pic_errorf(pic, "syntax error");
     }
-    pic_add_rename(pic, in, pic_sym_ptr(v));
+    pic_add_variable(pic, in, var);
   }
-  if (pic_sym_p(a)) {
+  if (pic_var_p(a)) {
-    pic_add_rename(pic, in, pic_sym_ptr(a));
+    pic_add_variable(pic, in, a);
   }
   else if (! pic_nil_p(a)) {
     pic_errorf(pic, "syntax error");
@@ -167,14 +248,14 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
 static pic_value
 macroexpand_define(pic_state *pic, pic_value expr, struct pic_env *env)
 {
-  pic_sym *sym, *rename;
+  pic_sym *uid;
   pic_value var, val;
 
   while (pic_length(pic, expr) >= 2 && pic_pair_p(pic_cadr(pic, expr))) {
     var = pic_car(pic, pic_cadr(pic, expr));
     val = pic_cdr(pic, pic_cadr(pic, expr));
 
-    expr = pic_list3(pic, pic_obj_value(pic->uDEFINE), var, pic_cons(pic, pic_obj_value(pic->uLAMBDA), pic_cons(pic, val, pic_cddr(pic, expr))));
+    expr = pic_list3(pic, pic_obj_value(pic->uDEFINE), var, pic_cons(pic, pic_obj_value(pic->sLAMBDA), pic_cons(pic, val, pic_cddr(pic, expr))));
   }
 
   if (pic_length(pic, expr) != 3) {
@@ -182,37 +263,35 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_env *env)
   }
 
   var = pic_cadr(pic, expr);
-  if (! pic_sym_p(var)) {
+  if (! pic_var_p(var)) {
-    pic_errorf(pic, "binding to non-symbol object");
+    pic_errorf(pic, "binding to non-variable object");
   }
-  sym = pic_sym_ptr(var);
+  if ((uid = pic_find_variable(pic, env, var)) == NULL) {
-  if ((rename = pic_find_rename(pic, env, sym)) == NULL) {
+    uid = pic_add_variable(pic, env, var);
-    rename = pic_add_rename(pic, env, sym);
   }
   val = macroexpand(pic, pic_list_ref(pic, expr, 2), env);
 
-  return pic_list3(pic, pic_obj_value(pic->uDEFINE), pic_obj_value(rename), val);
+  return pic_list3(pic, pic_obj_value(pic->uDEFINE), pic_obj_value(uid), val);
 }
 
 static pic_value
-macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_env *env)
+macroexpand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env)
 {
   pic_value var, val;
-  pic_sym *sym, *rename;
+  pic_sym *uid;
 
   if (pic_length(pic, expr) != 3) {
     pic_errorf(pic, "syntax error");
   }
 
   var = pic_cadr(pic, expr);
-  if (! pic_sym_p(var)) {
+  if (! pic_var_p(var)) {
-    pic_errorf(pic, "binding to non-symbol object");
+    pic_errorf(pic, "binding to non-variable object");
   }
-  sym = pic_sym_ptr(var);
+  if ((uid = pic_find_variable(pic, env, var)) == NULL) {
-  if ((rename = pic_find_rename(pic, env, sym)) == NULL) {
+    uid = pic_add_variable(pic, env, var);
-    rename = pic_add_rename(pic, env, sym);
   } else {
-    pic_warnf(pic, "redefining syntax variable: ~s", pic_obj_value(sym));
+    pic_warnf(pic, "redefining syntax variable: ~s", var);
   }
 
   val = pic_cadr(pic, pic_cdr(pic, expr));
@@ -227,13 +306,7 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_env *env)
     pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
   }
 
-  val = pic_apply1(pic, pic_proc_ptr(val), pic_obj_value(env));
+  define_macro(pic, uid, pic_proc_ptr(val));
-
-  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));
 
   return pic_undef_value();
 }
@@ -241,7 +314,7 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_env *env)
 static pic_value
 macroexpand_macro(pic_state *pic, struct pic_proc *mac, pic_value expr, struct pic_env *env)
 {
-  pic_value v, args;
+  pic_value v;
 
 #if DEBUG
   puts("before expand-1:");
@@ -249,10 +322,8 @@ macroexpand_macro(pic_state *pic, struct pic_proc *mac, pic_value expr, struct p
   puts("");
 #endif
 
-  args = pic_list2(pic, expr, pic_obj_value(env));
-
   pic_try {
-    v = pic_apply(pic, mac, args);
+    v = pic_apply2(pic, mac, expr, pic_obj_value(env));
   } pic_catch {
     pic_errorf(pic, "macroexpand error while application: %s", pic_errmsg(pic));
   }
@@ -270,40 +341,44 @@ static pic_value
 macroexpand_node(pic_state *pic, pic_value expr, struct pic_env *env)
 {
   switch (pic_type(expr)) {
+  case PIC_TT_ID:
   case PIC_TT_SYMBOL: {
-    return macroexpand_symbol(pic, pic_sym_ptr(expr), env);
+    return macroexpand_var(pic, expr, env);
   }
   case PIC_TT_PAIR: {
-    pic_value car;
     struct pic_proc *mac;
 
     if (! pic_list_p(expr)) {
       pic_errorf(pic, "cannot macroexpand improper list: ~s", expr);
     }
 
-    car = macroexpand(pic, pic_car(pic, expr), env);
+    if (pic_var_p(pic_car(pic, expr))) {
-    if (pic_sym_p(car)) {
+      pic_sym *functor;
-      pic_sym *tag = pic_sym_ptr(car);
 
-      if (tag == pic->uDEFINE_SYNTAX) {
+      if ((functor = resolve(pic, pic_car(pic, expr), env)) == NULL) {
-        return macroexpand_defsyntax(pic, expr, env);
+        goto call;
       }
-      else if (tag == pic->uLAMBDA) {
+
+      if (functor == pic->uDEFINE_MACRO) {
+        return macroexpand_defmacro(pic, expr, env);
+      }
+      else if (functor == pic->uLAMBDA) {
         return macroexpand_defer(pic, expr, env);
       }
-      else if (tag == pic->uDEFINE) {
+      else if (functor == pic->uDEFINE) {
         return macroexpand_define(pic, expr, env);
       }
-      else if (tag == pic->uQUOTE) {
+      else if (functor == pic->uQUOTE) {
         return macroexpand_quote(pic, expr);
       }
 
-      if ((mac = find_macro(pic, tag)) != NULL) {
+      if ((mac = find_macro(pic, functor)) != NULL) {
         return macroexpand_node(pic, macroexpand_macro(pic, mac, expr, env), env);
       }
     }
+    call:
 
-    return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), env));
+    return macroexpand_list(pic, expr, env);
   }
   default:
     return expr;
@@ -362,22 +437,6 @@ pic_macroexpand(pic_state *pic, pic_value expr, struct pic_lib *lib)
   return v;
 }
 
-struct pic_env *
-pic_make_env(pic_state *pic, struct pic_env *up)
-{
-  struct pic_env *env;
-  struct pic_dict *map;
-
-  map = pic_make_dict(pic);
-
-  env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
-  env->up = up;
-  env->defer = pic_nil_value();
-  env->map = map;
-
-  return env;
-}
-
 static pic_value
 defmacro_call(pic_state *pic)
 {
@@ -398,7 +457,7 @@ pic_defmacro(pic_state *pic, pic_sym *name, pic_sym *id, pic_func_t func)
 
   trans = pic_make_proc(pic, func, pic_symbol_name(pic, name));
 
-  pic_put_rename(pic, pic->lib->env, name, id);
+  pic_put_variable(pic, pic->lib->env, pic_obj_value(name), id);
 
   proc = pic_make_proc(pic, defmacro_call, "defmacro_call");
   pic_attr_set(pic, pic_obj_value(proc), "@@transformer", pic_obj_value(trans));
@@ -410,30 +469,6 @@ pic_defmacro(pic_state *pic, pic_sym *name, pic_sym *id, pic_func_t func)
   pic_export(pic, name);
 }
 
-bool
-pic_identifier_p(pic_state *pic, pic_value obj)
-{
-  return pic_sym_p(obj) && ! pic_interned_p(pic, pic_sym_ptr(obj));
-}
-
-bool
-pic_identifier_eq_p(pic_state *pic, struct pic_env *env1, pic_sym *sym1, struct pic_env *env2, pic_sym *sym2)
-{
-  pic_sym *a, *b;
-
-  a = make_identifier(pic, sym1, env1);
-  if (a != make_identifier(pic, sym1, env1)) {
-    a = sym1;
-  }
-
-  b = make_identifier(pic, sym2, env2);
-  if (b != make_identifier(pic, sym2, env2)) {
-    b = sym2;
-  }
-
-  return pic_eq_p(pic_obj_value(a), pic_obj_value(b));
-}
-
 static pic_value
 pic_macro_identifier_p(pic_state *pic)
 {
@@ -441,40 +476,62 @@ pic_macro_identifier_p(pic_state *pic)
 
   pic_get_args(pic, "o", &obj);
 
-  return pic_bool_value(pic_identifier_p(pic, obj));
+  return pic_bool_value(pic_id_p(obj));
 }
 
 static pic_value
 pic_macro_make_identifier(pic_state *pic)
 {
-  pic_value obj;
+  pic_value var, env;
-  pic_sym *sym;
 
-  pic_get_args(pic, "mo", &sym, &obj);
+  pic_get_args(pic, "oo", &var, &env);
 
-  pic_assert_type(pic, obj, env);
+  pic_assert_type(pic, var, var);
+  pic_assert_type(pic, env, env);
 
-  return pic_obj_value(make_identifier(pic, sym, pic_env_ptr(obj)));
+  return pic_obj_value(pic_make_id(pic, var, pic_env_ptr(env)));
 }
 
 static pic_value
-pic_macro_identifier_eq_p(pic_state *pic)
+pic_macro_variable_p(pic_state *pic)
 {
-  pic_sym *sym1, *sym2;
+  pic_value obj;
-  pic_value env1, env2;
 
-  pic_get_args(pic, "omom", &env1, &sym1, &env2, &sym2);
+  pic_get_args(pic, "o", &obj);
 
-  pic_assert_type(pic, env1, env);
+  return pic_bool_value(pic_var_p(obj));
-  pic_assert_type(pic, env2, env);
+}
 
-  return pic_bool_value(pic_identifier_eq_p(pic, pic_env_ptr(env1), sym1, pic_env_ptr(env2), sym2));
+static pic_value
+pic_macro_variable_eq_p(pic_state *pic)
+{
+  pic_value var1, var2;
+  pic_sym *uid1, *uid2;
+
+  pic_get_args(pic, "oo", &var1, &var2);
+
+  pic_assert_type(pic, var1, var);
+  pic_assert_type(pic, var2, var);
+
+  if (pic_eq_p(var1, var2)) {
+    return pic_true_value();
+  }
+
+  uid1 = resolve(pic, var1, NULL);
+  uid2 = resolve(pic, var2, NULL);
+
+  if (uid1 || uid2) {
+    return pic_bool_value(uid1 == uid2);
+  }
+  return pic_false_value();
 }
 
 void
 pic_init_macro(pic_state *pic)
 {
   pic_defun(pic, "identifier?", pic_macro_identifier_p);
-  pic_defun(pic, "identifier=?", pic_macro_identifier_eq_p);
   pic_defun(pic, "make-identifier", pic_macro_make_identifier);
+
+  pic_defun(pic, "variable?", pic_macro_variable_p);
+  pic_defun(pic, "variable=?", pic_macro_variable_eq_p);
 }

extlib/benz/state.c

@@ -109,7 +109,7 @@ pic_init_core(pic_state *pic)
     pic_define_syntactic_keyword(pic, pic->lib->env, pic->sLAMBDA, pic->uLAMBDA);
     pic_define_syntactic_keyword(pic, pic->lib->env, pic->sIF, pic->uIF);
     pic_define_syntactic_keyword(pic, pic->lib->env, pic->sBEGIN, pic->uBEGIN);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE_SYNTAX, pic->uDEFINE_SYNTAX);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE_MACRO, pic->uDEFINE_MACRO);
 
     pic_init_undef(pic); DONE;
     pic_init_bool(pic); DONE;
@@ -222,6 +222,9 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
   /* symbol table */
   xh_init_str(&pic->syms, sizeof(pic_sym *));
 
+  /* unique symbol count */
+  pic->ucnt = 0;
+
   /* global variables */
   pic->globals = NULL;
 
@@ -265,7 +268,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
   S(sQUASIQUOTE, "quasiquote");
   S(sUNQUOTE, "unquote");
   S(sUNQUOTE_SPLICING, "unquote-splicing");
-  S(sDEFINE_SYNTAX, "define-syntax");
+  S(sDEFINE_MACRO, "define-macro");
   S(sIMPORT, "import");
   S(sEXPORT, "export");
   S(sDEFINE_LIBRARY, "define-library");
@@ -308,7 +311,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
 
   pic_gc_arena_restore(pic, ai);
 
-#define U(slot,name) pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name))
+#define U(slot,name) pic->slot = pic_uniq(pic, pic_obj_value(pic_intern_cstr(pic, name)))
 
   U(uDEFINE, "define");
   U(uLAMBDA, "lambda");
@@ -316,7 +319,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
   U(uBEGIN, "begin");
   U(uSETBANG, "set!");
   U(uQUOTE, "quote");
-  U(uDEFINE_SYNTAX, "define-syntax");
+  U(uDEFINE_MACRO, "define-macro");
   U(uIMPORT, "import");
   U(uEXPORT, "export");
   U(uDEFINE_LIBRARY, "define-library");

extlib/benz/symbol.c

@@ -4,7 +4,7 @@
 
 #include "picrin.h"
 
-pic_sym *
+static pic_sym *
 pic_make_symbol(pic_state *pic, pic_str *str)
 {
   pic_sym *sym;
@@ -42,25 +42,6 @@ pic_intern_cstr(pic_state *pic, const char *str)
   return pic_intern(pic, pic_make_str(pic, str, strlen(str)));
 }
 
-pic_sym *
-pic_gensym(pic_state *pic, pic_sym *base)
-{
-  return pic_make_symbol(pic, base->str);
-}
-
-bool
-pic_interned_p(pic_state *pic, pic_sym *sym)
-{
-  xh_entry *e;
-
-  e = xh_get_str(&pic->syms, pic_str_cstr(pic, sym->str));
-  if (e) {
-    return sym == xh_val(e, pic_sym *);
-  } else {
-    return false;
-  }
-}
-
 const char *
 pic_symbol_name(pic_state *pic, pic_sym *sym)
 {

extlib/benz/vm.c

@@ -394,9 +394,9 @@ pic_get_args(pic_state *pic, const char *format, ...)
 }
 
 void
-pic_define_syntactic_keyword(pic_state *pic, struct pic_env *env, pic_sym *sym, pic_sym *rsym)
+pic_define_syntactic_keyword(pic_state *pic, struct pic_env *env, pic_sym *sym, pic_sym *uid)
 {
-  pic_put_rename(pic, env, sym, rsym);
+  pic_put_variable(pic, env, pic_obj_value(sym), uid);
 
   if (pic->lib && pic->lib->env == env) {
     pic_export(pic, sym);
@@ -406,17 +406,17 @@ pic_define_syntactic_keyword(pic_state *pic, struct pic_env *env, pic_sym *sym,
 void
 pic_define_noexport(pic_state *pic, const char *name, pic_value val)
 {
-  pic_sym *sym, *rename;
+  pic_sym *sym, *uid;
 
   sym = pic_intern_cstr(pic, name);
 
-  if ((rename = pic_find_rename(pic, pic->lib->env, sym)) == NULL) {
+  if ((uid = pic_find_variable(pic, pic->lib->env, pic_obj_value(sym))) == NULL) {
-    rename = pic_add_rename(pic, pic->lib->env, sym);
+    uid = pic_add_variable(pic, pic->lib->env, pic_obj_value(sym));
   } else {
     pic_warnf(pic, "redefining global");
   }
 
-  pic_dict_set(pic, pic->globals, rename, val);
+  pic_dict_set(pic, pic->globals, uid, val);
 }
 
 void
@@ -430,29 +430,29 @@ pic_define(pic_state *pic, const char *name, pic_value val)
 pic_value
 pic_ref(pic_state *pic, struct pic_lib *lib, const char *name)
 {
-  pic_sym *sym, *rename;
+  pic_sym *sym, *uid;
 
   sym = pic_intern_cstr(pic, name);
 
-  if ((rename = pic_find_rename(pic, lib->env, sym)) == NULL) {
+  if ((uid = pic_find_variable(pic, lib->env, pic_obj_value(sym))) == NULL) {
     pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
   }
 
-  return pic_dict_ref(pic, pic->globals, rename);
+  return pic_dict_ref(pic, pic->globals, uid);
 }
 
 void
 pic_set(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val)
 {
-  pic_sym *sym, *rename;
+  pic_sym *sym, *uid;
 
   sym = pic_intern_cstr(pic, name);
 
-  if ((rename = pic_find_rename(pic, lib->env, sym)) == NULL) {
+  if ((uid = pic_find_variable(pic, lib->env, pic_obj_value(sym))) == NULL) {
     pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
   }
 
-  pic_dict_set(pic, pic->globals, rename, val);
+  pic_dict_set(pic, pic->globals, uid, val);
 }
 
 pic_value
@@ -477,7 +477,7 @@ pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
 }
 
 void
-pic_defun_vm(pic_state *pic, const char *name, pic_sym *rename, pic_func_t func)
+pic_defun_vm(pic_state *pic, const char *name, pic_sym *uid, pic_func_t func)
 {
   struct pic_proc *proc;
   pic_sym *sym;
@@ -486,9 +486,9 @@ pic_defun_vm(pic_state *pic, const char *name, pic_sym *rename, pic_func_t func)
 
   sym = pic_intern_cstr(pic, name);
 
-  pic_put_rename(pic, pic->lib->env, sym, rename);
+  pic_put_variable(pic, pic->lib->env, pic_obj_value(sym), uid);
 
-  pic_dict_set(pic, pic->globals, rename, pic_obj_value(proc));
+  pic_dict_set(pic, pic->globals, uid, pic_obj_value(proc));
 
   pic_export(pic, sym);
 }

extlib/benz/write.c

@@ -302,6 +302,9 @@ write_core(struct writer_control *p, pic_value obj)
     }
     xfprintf(file, ")");
     break;
+  case PIC_TT_ID:
+    xfprintf(file, "#<identifier %s>", pic_symbol_name(pic, pic_var_name(pic, obj)));
+    break;
   default:
     xfprintf(file, "#<%s %p>", pic_type_repr(pic_type(obj)), pic_ptr(obj));
     break;