Merge branch 'master' of github.com:picrin-scheme/picrin

extlib/benz/bool.c

@@ -10,8 +10,10 @@ KHASH_DEFINE2(m, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
 static bool
 internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m) *h)
 {
-  pic_value local = pic_nil_value();
+  pic_value localx = pic_nil_value();
-  int c = 0;
+  pic_value localy = pic_nil_value();
+  int cx = 0;
+  int cy = 0;
 
   if (depth > 10) {
     if (depth > 200) {
@@ -68,17 +70,30 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
       return false;
 
     /* Floyd's cycle-finding algorithm */
-    if (pic_nil_p(local)) {
+    if (pic_nil_p(localx)) {
-      local = x;
+      localx = x;
     }
     x = pic_cdr(pic, x);
+    cx++;
+    if (pic_nil_p(localy)) {
+      localy = y;
+    }
     y = pic_cdr(pic, y);
-    c++;
+    cy++;
-    if (c == 2) {
+    if (cx == 2) {
-      c = 0;
+      cx = 0;
-      local = pic_cdr(pic, local);
+      localx = pic_cdr(pic, localx);
-      if (pic_eq_p(local, x)) {
+      if (pic_eq_p(localx, x)) {
-        return true;
+        if (cy < 0 ) return true; /* both lists circular */
+        cx = INT_MIN; /* found a cycle on x */
+      }
+    }
+    if (cy == 2) {
+      cy = 0;
+      localy = pic_cdr(pic, localy);
+      if (pic_eq_p(localy, y)) {
+        if (cx < 0 ) return true; /* both lists circular */
+        cy = INT_MIN; /* found a cycle on y */
       }
     }
     goto LOOP;                  /* tail-call optimization */

extlib/benz/include/picrin/reg.h

@@ -26,6 +26,7 @@ pic_value pic_reg_ref(pic_state *, struct pic_reg *, void *);
 void pic_reg_set(pic_state *, struct pic_reg *, void *, pic_value);
 void pic_reg_del(pic_state *, struct pic_reg *, void *);
 bool pic_reg_has(pic_state *, struct pic_reg *, void *);
+void *pic_reg_rev_ref(pic_state *, struct pic_reg *, pic_value);
 
 #if defined(__cplusplus)
 }

extlib/benz/reg.c

@@ -31,6 +31,22 @@ pic_reg_ref(pic_state *pic, struct pic_reg *reg, void *key)
   return kh_val(h, it);
 }
 
+void *
+pic_reg_rev_ref(pic_state *pic, struct pic_reg *reg, pic_value val)
+{
+  khash_t(reg) *h = &reg->hash;
+
+  if (h->n_buckets) {
+    khint_t i = 0;
+    while ((i < h->n_buckets) && (ac_iseither(h->flags, i) || !pic_eq_p(h->vals[i], val))) {
+      i += 1;
+    }
+    if (i < h->n_buckets) return kh_key(h, i);
+  }
+  pic_errorf(pic, "key not found for an element: ~s", val);
+  return NULL;
+}
+
 void
 pic_reg_set(pic_state PIC_UNUSED(*pic), struct pic_reg *reg, void *key, pic_value val)
 {

extlib/benz/vm.c

@@ -198,9 +198,9 @@ vm_gref(pic_state *pic, struct pic_box *slot, pic_sym *uid)
 {
   if (pic_invalid_p(slot->value)) {
     if (uid == NULL) {
-      uid = pic_intern(pic, "unknown"); /* FIXME */
+      uid = pic_reg_rev_ref(pic, pic->globals, pic_obj_value(slot));
     }
-    pic_errorf(pic, "uninitialized global variable: ~a", pic_obj_value(uid));
+    pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, uid));
   }
   return slot->value;
 }