ephemeron-table -> attribute

contrib/10.attribute/attr.scm

@@ -1,7 +1,7 @@
 (define-library (picrin base)
   (export attribute)
 
-  (define attribute-table (make-ephemeron-table))
+  (define attribute-table (make-attribute))
 
   (define (attribute obj)
     (or (attribute-table obj)

contrib/10.macro/macro.scm

@@ -53,17 +53,17 @@
 
   (define (transformer f)
     (lambda (form env)
-      (let ((ephemeron1 (make-ephemeron-table))
+      (let ((attr1 (make-attribute))
-            (ephemeron2 (make-ephemeron-table)))
+            (attr2 (make-attribute)))
         (letrec
             ((wrap (lambda (var1)
-                     (or (ephemeron1 var1)
+                     (or (attr1 var1)
                          (let ((var2 (make-identifier var1 env)))
-                           (ephemeron1 var1 var2)
+                           (attr1 var1 var2)
-                           (ephemeron2 var2 var1)
+                           (attr2 var2 var1)
                            var2))))
              (unwrap (lambda (var2)
-                       (or (ephemeron2 var2)
+                       (or (attr2 var2)
                            var2)))
              (walk (lambda (f form)
                      (cond
@@ -203,11 +203,11 @@
 
   (define (make-syntactic-closure env free form)
     (letrec
-        ((wrap (let ((ephemeron (make-ephemeron-table)))
+        ((wrap (let ((attr (make-attribute)))
                  (lambda (var)
-                   (or (ephemeron var)
+                   (or (attr var)
                        (let ((id (make-identifier var env)))
-                         (ephemeron var id)
+                         (attr var id)
                          id)))))
          (walk (lambda (f form)
                  (cond
@@ -263,11 +263,11 @@
   (define (er-transformer f)
     (lambda (form use-env mac-env)
       (letrec
-          ((rename (let ((ephemeron (make-ephemeron-table)))
+          ((rename (let ((attr (make-attribute)))
                      (lambda (var)
-                       (or (ephemeron var)
+                       (or (attr var)
                            (let ((id (make-identifier var mac-env)))
-                             (ephemeron var id)
+                             (attr var id)
                              id)))))
            (compare (lambda (x y)
                       (identifier=?
@@ -277,23 +277,23 @@
 
   (define (ir-transformer f)
     (lambda (form use-env mac-env)
-      (let ((ephemeron1 (make-ephemeron-table))
+      (let ((attr1 (make-attribute))
-            (ephemeron2 (make-ephemeron-table)))
+            (attr2 (make-attribute)))
         (letrec
             ((inject (lambda (var1)
-                       (or (ephemeron1 var1)
+                       (or (attr1 var1)
                            (let ((var2 (make-identifier var1 use-env)))
-                             (ephemeron1 var1 var2)
+                             (attr1 var1 var2)
-                             (ephemeron2 var2 var1)
+                             (attr2 var2 var1)
                              var2))))
-             (rename (let ((ephemeron (make-ephemeron-table)))
+             (rename (let ((attr (make-attribute)))
                        (lambda (var)
-                         (or (ephemeron var)
+                         (or (attr var)
                              (let ((id (make-identifier var mac-env)))
-                               (ephemeron var id)
+                               (attr var id)
                                id)))))
              (flip (lambda (var2) ; unwrap if injected, wrap if not injected
-                     (or (ephemeron2 var2)
+                     (or (attr2 var2)
                          (rename var2))))
              (walk (lambda (f form)
                      (cond

contrib/20.r7rs/scheme/base.scm

@@ -343,7 +343,7 @@
       #`(call-with-current-environment
          (lambda (env)
            (letrec
-               ((#,'rename (let ((wm (make-ephemeron-table)))
+               ((#,'rename (let ((wm (make-attribute)))
                              (lambda (x)
                                (or (wm x)
                                    (let ((id (make-identifier x env)))

lib/Makefile

@@ -1,4 +1,5 @@
 LIBPICRIN_SRCS = \
+	attr.c\
 	blob.c\
 	bool.c\
 	char.c\
@@ -17,7 +18,6 @@ LIBPICRIN_SRCS = \
 	symbol.c\
 	var.c\
 	vector.c\
-	weak.c\
 	ext/cont.c\
 	ext/eval.c\
 	ext/read.c\

lib/attr.c

@@ -0,0 +1,107 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#include "picrin.h"
+#include "object.h"
+
+KHASH_DEFINE(attr, struct object *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)
+
+static pic_value
+attr_call(pic_state *pic)
+{
+  pic_value self, key, val;
+  int n;
+
+  n = pic_get_args(pic, "&o|o", &self, &key, &val);
+
+  if (! obj_p(pic, key)) {
+    pic_error(pic, "attempted to set a non-object key", 1, key);
+  }
+
+  if (n == 1) {
+    if (! pic_attr_has(pic, self, key)) {
+      return pic_false_value(pic);
+    }
+    return pic_attr_ref(pic, self, key);
+  } else {
+    if (pic_false_p(pic, val)) {
+      if (pic_attr_has(pic, self, key)) {
+        pic_attr_del(pic, self, key);
+      }
+    } else {
+      pic_attr_set(pic, self, key, val);
+    }
+    return pic_undef_value(pic);
+  }
+}
+
+pic_value
+pic_make_attr(pic_state *pic)
+{
+  struct attr *attr;
+
+  attr = (struct attr *)pic_obj_alloc(pic, PIC_TYPE_ATTR);
+  attr->prev = NULL;
+  kh_init(attr, &attr->hash);
+  return pic_lambda(pic, attr_call, 1, obj_value(pic, attr));
+}
+
+pic_value
+pic_attr_ref(pic_state *pic, pic_value attr, pic_value key)
+{
+  khash_t(attr) *h = &attr_ptr(pic, proc_ptr(pic, attr)->env->regs[0])->hash;
+  int it;
+
+  it = kh_get(attr, h, obj_ptr(pic, key));
+  if (it == kh_end(h)) {
+    pic_error(pic, "element not found for given key", 1, key);
+  }
+  return kh_val(h, it);
+}
+
+void
+pic_attr_set(pic_state *pic, pic_value attr, pic_value key, pic_value val)
+{
+  khash_t(attr) *h = &attr_ptr(pic, proc_ptr(pic, attr)->env->regs[0])->hash;
+  int ret;
+  int it;
+
+  it = kh_put(attr, h, obj_ptr(pic, key), &ret);
+  kh_val(h, it) = val;
+}
+
+bool
+pic_attr_has(pic_state *pic, pic_value attr, pic_value key)
+{
+  khash_t(attr) *h = &attr_ptr(pic, proc_ptr(pic, attr)->env->regs[0])->hash;
+
+  return kh_get(attr, h, obj_ptr(pic, key)) != kh_end(h);
+}
+
+void
+pic_attr_del(pic_state *pic, pic_value attr, pic_value key)
+{
+  khash_t(attr) *h = &attr_ptr(pic, proc_ptr(pic, attr)->env->regs[0])->hash;
+  int it;
+
+  it = kh_get(attr, h, obj_ptr(pic, key));
+  if (it == kh_end(h)) {
+    pic_error(pic, "element not found for given key", 1, key);
+  }
+  kh_del(attr, h, it);
+}
+
+static pic_value
+pic_attr_make_attribute(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_make_attr(pic);
+}
+
+void
+pic_init_attr(pic_state *pic)
+{
+  pic_defun(pic, "make-attribute", pic_attr_make_attribute);
+}

lib/error.c

@@ -73,8 +73,8 @@ pic_enter_try(pic_state *pic)
   handler = pic_lambda(pic, native_exception_handler, 1, cont);
   /* with-exception-handler */
   var = pic_exc(pic);
-  env = pic_make_weak(pic);
+  env = pic_make_attr(pic);
-  pic_weak_set(pic, env, var, pic_cons(pic, handler, pic_call(pic, var, 0)));
+  pic_attr_set(pic, env, var, pic_cons(pic, handler, pic_call(pic, var, 0)));
   pic->dyn_env = pic_cons(pic, env, pic->dyn_env);
 
   pic_leave(pic, pic->cxt->ai);
@@ -137,8 +137,8 @@ with_exception_handlers(pic_state *pic, pic_value handlers, pic_value thunk)
 {
   pic_value var, env, r;
   var = pic_exc(pic);
-  env = pic_make_weak(pic);
+  env = pic_make_attr(pic);
-  pic_weak_set(pic, env, var, handlers);
+  pic_attr_set(pic, env, var, handlers);
   pic->dyn_env = pic_cons(pic, env, pic->dyn_env);
   r = pic_call(pic, thunk, 0);
   pic->dyn_env = pic_cdr(pic, pic->dyn_env);

lib/ext/write.c

@@ -29,8 +29,8 @@ writer_control_init(pic_state *pic, struct writer_control *p, int mode, int op)
   p->mode = mode;
   p->op = op;
   p->cnt = 0;
-  p->shared = pic_make_weak(pic);
+  p->shared = pic_make_attr(pic);
-  p->labels = pic_make_weak(pic);
+  p->labels = pic_make_attr(pic);
 }
 
 static void
@@ -48,9 +48,9 @@ traverse(pic_state *pic, pic_value obj, struct writer_control *p)
   case PIC_TYPE_DICT:
   case PIC_TYPE_RECORD: {
 
-    if (! pic_weak_has(pic, shared, obj)) {
+    if (! pic_attr_has(pic, shared, obj)) {
       /* first time */
-      pic_weak_set(pic, shared, obj, pic_int_value(pic, 0));
+      pic_attr_set(pic, shared, obj, pic_int_value(pic, 0));
 
       if (pic_pair_p(pic, obj)) {
         /* pair */
@@ -75,13 +75,13 @@ traverse(pic_state *pic, pic_value obj, struct writer_control *p)
       }
 
       if (p->op == OP_WRITE) {
-        if (pic_int(pic, pic_weak_ref(pic, shared, obj)) == 0) {
+        if (pic_int(pic, pic_attr_ref(pic, shared, obj)) == 0) {
-          pic_weak_del(pic, shared, obj);
+          pic_attr_del(pic, shared, obj);
         }
       }
     } else {
       /* second time */
-      pic_weak_set(pic, shared, obj, pic_int_value(pic, 1));
+      pic_attr_set(pic, shared, obj, pic_int_value(pic, 1));
     }
     break;
   }
@@ -97,10 +97,10 @@ is_shared_object(pic_state *pic, pic_value obj, struct writer_control *p) {
   if (! obj_p(pic, obj)) {
     return false;
   }
-  if (! pic_weak_has(pic, shared, obj)) {
+  if (! pic_attr_has(pic, shared, obj)) {
     return false;
   }
-  return pic_int(pic, pic_weak_ref(pic, shared, obj)) > 0;
+  return pic_int(pic, pic_attr_ref(pic, shared, obj)) > 0;
 }
 
 static void
@@ -369,8 +369,8 @@ typename(pic_state *pic, pic_value obj)
     return "data";
   case PIC_TYPE_DICT:
     return "dictionary";
-  case PIC_TYPE_WEAK:
+  case PIC_TYPE_ATTR:
-    return "ephemeron";
+    return "attribute";
   case PIC_TYPE_RECORD:
     return "record";
   default:
@@ -386,13 +386,13 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
 
   /* shared objects */
   if (is_shared_object(pic, obj, p)) {
-    if (pic_weak_has(pic, labels, obj)) {
+    if (pic_attr_has(pic, labels, obj)) {
-      pic_fprintf(pic, port, "#%d#", pic_int(pic, pic_weak_ref(pic, labels, obj)));
+      pic_fprintf(pic, port, "#%d#", pic_int(pic, pic_attr_ref(pic, labels, obj)));
       return;
     }
     i = p->cnt++;
     pic_fprintf(pic, port, "#%d=", i);
-    pic_weak_set(pic, labels, obj, pic_int_value(pic, i));
+    pic_attr_set(pic, labels, obj, pic_int_value(pic, i));
   }
 
   switch (pic_type(pic, obj)) {
@@ -451,7 +451,7 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
 
   if (p->op == OP_WRITE) {
     if (is_shared_object(pic, obj, p)) {
-      pic_weak_del(pic, labels, obj);
+      pic_attr_del(pic, labels, obj);
     }
   }
 }

lib/gc.c

@@ -20,7 +20,7 @@ struct object {
     struct pair pair;
     struct vector vec;
     struct dict dict;
-    struct weak weak;
+    struct attr attr;
     struct data data;
     struct record rec;
     struct proc proc;
@@ -52,7 +52,7 @@ struct heap_page {
 struct heap {
   union header base, *freep;
   struct heap_page *pages;
-  struct weak *weaks;           /* weak map chain */
+  struct attr *attrs;           /* weak map chain */
 };
 
 #define unitsof(type) ((type2size(type) + sizeof(union header) - 1) / sizeof(union header))
@@ -69,7 +69,7 @@ pic_heap_open(pic_state *pic)
   heap->freep = &heap->base;
 
   heap->pages = NULL;
-  heap->weaks = NULL;
+  heap->attrs = NULL;
 
   return heap;
 }
@@ -304,11 +304,11 @@ gc_mark_object(pic_state *pic, struct object *obj)
     LOOP(obj->u.sym.str);
     break;
   }
-  case PIC_TYPE_WEAK: {
+  case PIC_TYPE_ATTR: {
-    struct weak *weak = (struct weak *)obj;
+    struct attr *attr = (struct attr *)obj;
 
-    weak->prev = pic->heap->weaks;
+    attr->prev = pic->heap->attrs;
-    pic->heap->weaks = weak;
+    pic->heap->attrs = attr;
     break;
   }
   default:
@@ -322,7 +322,7 @@ gc_mark_phase(pic_state *pic)
   struct context *cxt;
   size_t j;
 
-  assert(pic->heap->weaks == NULL);
+  assert(pic->heap->attrs == NULL);
 
   /* context */
   for (cxt = pic->cxt; cxt != NULL; cxt = cxt->prev) {
@@ -354,14 +354,14 @@ gc_mark_phase(pic_state *pic)
     struct object *key;
     pic_value val;
     int it;
-    khash_t(weak) *h;
+    khash_t(attr) *h;
-    struct weak *weak;
+    struct attr *attr;
 
     j = 0;
-    weak = pic->heap->weaks;
+    attr = pic->heap->attrs;
 
-    while (weak != NULL) {
+    while (attr != NULL) {
-      h = &weak->hash;
+      h = &attr->hash;
       for (it = kh_begin(h); it != kh_end(h); ++it) {
         if (! kh_exist(h, it))
           continue;
@@ -374,7 +374,7 @@ gc_mark_phase(pic_state *pic)
           }
         }
       }
-      weak = weak->prev;
+      attr = attr->prev;
     }
   } while (j > 0);
 }
@@ -411,8 +411,8 @@ gc_finalize_object(pic_state *pic, struct object *obj)
     /* TODO: remove this symbol's entry from pic->syms immediately */
     break;
   }
-  case PIC_TYPE_WEAK: {
+  case PIC_TYPE_ATTR: {
-    kh_destroy(weak, &obj->u.weak.hash);
+    kh_destroy(attr, &obj->u.attr.hash);
     break;
   }
   case PIC_TYPE_IREP: {
@@ -455,7 +455,7 @@ type2size(int type)
   case PIC_TYPE_DATA: return sizeof(struct data);
   case PIC_TYPE_DICT: return sizeof(struct dict);
   case PIC_TYPE_SYMBOL: return sizeof(struct symbol);
-  case PIC_TYPE_WEAK: return sizeof(struct weak);
+  case PIC_TYPE_ATTR: return sizeof(struct attr);
   case PIC_TYPE_IREP: return sizeof(struct irep);
   case PIC_TYPE_PORT: return sizeof(struct port);
   case PIC_TYPE_PAIR: return sizeof(struct pair);
@@ -600,24 +600,24 @@ gc_sweep_phase(pic_state *pic)
 {
   struct heap_page *page;
   int it;
-  khash_t(weak) *h;
+  khash_t(attr) *h;
   khash_t(oblist) *s = &pic->oblist;
   struct symbol *sym;
   struct object *obj;
   size_t total = 0, inuse = 0;
 
   /* weak maps */
-  while (pic->heap->weaks != NULL) {
+  while (pic->heap->attrs != NULL) {
-    h = &pic->heap->weaks->hash;
+    h = &pic->heap->attrs->hash;
     for (it = kh_begin(h); it != kh_end(h); ++it) {
       if (! kh_exist(h, it))
         continue;
       obj = kh_key(h, it);
       if (! is_alive(obj)) {
-        kh_del(weak, h, it);
+        kh_del(attr, h, it);
       }
     }
-    pic->heap->weaks = pic->heap->weaks->prev;
+    pic->heap->attrs = pic->heap->attrs->prev;
   }
 
   /* symbol table */

lib/include/picrin.h

@@ -194,14 +194,14 @@ bool pic_dict_next(pic_state *, pic_value dict, int *iter, pic_value *key, pic_v
 
 
 /*
- * ephemeron table
+ * attribute
  */
 
-pic_value pic_make_weak(pic_state *);
+pic_value pic_make_attr(pic_state *);
-pic_value pic_weak_ref(pic_state *, pic_value weak, pic_value key);
+pic_value pic_attr_ref(pic_state *, pic_value attr, pic_value key);
-void pic_weak_set(pic_state *, pic_value weak, pic_value key, pic_value val);
+void pic_attr_set(pic_state *, pic_value attr, pic_value key, pic_value val);
-void pic_weak_del(pic_state *, pic_value weak, pic_value key);
+void pic_attr_del(pic_state *, pic_value attr, pic_value key);
-bool pic_weak_has(pic_state *, pic_value weak, pic_value key);
+bool pic_attr_has(pic_state *, pic_value attr, pic_value key);
 
 
 /*

lib/include/picrin/value.h

@@ -29,7 +29,7 @@ enum {
   PIC_TYPE_VECTOR    = 21,
   PIC_TYPE_DICT      = 22,
   PIC_TYPE_RECORD    = 23,
-  PIC_TYPE_WEAK      = 24,
+  PIC_TYPE_ATTR      = 24,
   PIC_TYPE_PORT      = 25,
   PIC_TYPE_ERROR     = 26,
   PIC_TYPE_IREP      = 27,
@@ -224,7 +224,7 @@ DEFPRED(pic_vec_p, PIC_TYPE_VECTOR)
 DEFPRED(pic_blob_p, PIC_TYPE_BLOB)
 DEFPRED(pic_error_p, PIC_TYPE_ERROR)
 DEFPRED(pic_dict_p, PIC_TYPE_DICT)
-DEFPRED(pic_weak_p, PIC_TYPE_WEAK)
+DEFPRED(pic_attr_p, PIC_TYPE_ATTR)
 DEFPRED(pic_rec_p, PIC_TYPE_RECORD)
 DEFPRED(pic_sym_p, PIC_TYPE_SYMBOL)
 DEFPRED(pic_pair_p, PIC_TYPE_PAIR)

lib/object.h

@@ -52,12 +52,12 @@ struct dict {
   khash_t(dict) hash;
 };
 
-KHASH_DECLARE(weak, struct object *, pic_value)
+KHASH_DECLARE(attr, struct object *, pic_value)
 
-struct weak {
+struct attr {
   OBJECT_HEADER
-  khash_t(weak) hash;
+  khash_t(attr) hash;
-  struct weak *prev;         /* for GC */
+  struct attr *prev;         /* for GC */
 };
 
 struct vector {
@@ -253,7 +253,7 @@ DEFPTR(blob, struct blob)
 DEFPTR(pair, struct pair)
 DEFPTR(vec, struct vector)
 DEFPTR(dict, struct dict)
-DEFPTR(weak, struct weak)
+DEFPTR(attr, struct attr)
 DEFPTR(data, struct data)
 DEFPTR(proc, struct proc)
 DEFPTR(port, struct port)

lib/state.c

@@ -107,7 +107,7 @@ void pic_init_write(pic_state *);
 void pic_init_read(pic_state *);
 void pic_init_dict(pic_state *);
 void pic_init_record(pic_state *);
-void pic_init_weak(pic_state *);
+void pic_init_attr(pic_state *);
 void pic_init_file(pic_state *);
 void pic_init_state(pic_state *);
 void pic_init_eval(pic_state *);
@@ -133,7 +133,7 @@ pic_init_core(pic_state *pic)
   pic_init_var(pic); DONE;
   pic_init_dict(pic); DONE;
   pic_init_record(pic); DONE;
-  pic_init_weak(pic); DONE;
+  pic_init_attr(pic); DONE;
   pic_init_state(pic); DONE;
 
 #if PIC_USE_CALLCC
@@ -205,7 +205,7 @@ pic_open(pic_allocf allocf, void *userdata)
   pic->features = pic_nil_value(pic);
 
   /* dynamic environment */
-  pic->dyn_env = pic_list(pic, 1, pic_make_weak(pic));
+  pic->dyn_env = pic_list(pic, 1, pic_make_attr(pic));
 
   /* top continuation */
   {

lib/var.c

@@ -20,8 +20,8 @@ var_call(pic_state *pic)
     pic_value env, it;
 
     pic_for_each(env, pic->dyn_env, it) {
-      if (pic_weak_has(pic, env, self)) {
+      if (pic_attr_has(pic, env, self)) {
-        return pic_weak_ref(pic, env, self);
+        return pic_attr_ref(pic, env, self);
       }
     }
     PIC_UNREACHABLE();          /* logic flaw */
@@ -32,7 +32,7 @@ var_call(pic_state *pic)
     if (! pic_false_p(pic, conv)) {
       val = pic_call(pic, conv, 1, val);
     }
-    pic_weak_set(pic, pic_car(pic, pic->dyn_env), self, val);
+    pic_attr_set(pic, pic_car(pic, pic->dyn_env), self, val);
     return pic_undef_value(pic);
   }
 }
@@ -48,7 +48,7 @@ pic_make_var(pic_state *pic, pic_value init, pic_value conv)
       if (! pic_false_p(pic, conv)) {
         init = pic_call(pic, conv, 1, init);
       }
-      pic_weak_set(pic, pic_car(pic, env), var, init);
+      pic_attr_set(pic, pic_car(pic, env), var, init);
       break;
     }
     env = pic_cdr(pic, env);

lib/weak.c

@@ -1,107 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include "picrin.h"
-#include "object.h"
-
-KHASH_DEFINE(weak, struct object *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)
-
-static pic_value
-weak_call(pic_state *pic)
-{
-  pic_value self, key, val;
-  int n;
-
-  n = pic_get_args(pic, "&o|o", &self, &key, &val);
-
-  if (! obj_p(pic, key)) {
-    pic_error(pic, "attempted to set a non-object key", 1, key);
-  }
-
-  if (n == 1) {
-    if (! pic_weak_has(pic, self, key)) {
-      return pic_false_value(pic);
-    }
-    return pic_weak_ref(pic, self, key);
-  } else {
-    if (pic_false_p(pic, val)) {
-      if (pic_weak_has(pic, self, key)) {
-        pic_weak_del(pic, self, key);
-      }
-    } else {
-      pic_weak_set(pic, self, key, val);
-    }
-    return pic_undef_value(pic);
-  }
-}
-
-pic_value
-pic_make_weak(pic_state *pic)
-{
-  struct weak *weak;
-
-  weak = (struct weak *)pic_obj_alloc(pic, PIC_TYPE_WEAK);
-  weak->prev = NULL;
-  kh_init(weak, &weak->hash);
-  return pic_lambda(pic, weak_call, 1, obj_value(pic, weak));
-}
-
-pic_value
-pic_weak_ref(pic_state *pic, pic_value weak, pic_value key)
-{
-  khash_t(weak) *h = &weak_ptr(pic, proc_ptr(pic, weak)->env->regs[0])->hash;
-  int it;
-
-  it = kh_get(weak, h, obj_ptr(pic, key));
-  if (it == kh_end(h)) {
-    pic_error(pic, "element not found for given key", 1, key);
-  }
-  return kh_val(h, it);
-}
-
-void
-pic_weak_set(pic_state *pic, pic_value weak, pic_value key, pic_value val)
-{
-  khash_t(weak) *h = &weak_ptr(pic, proc_ptr(pic, weak)->env->regs[0])->hash;
-  int ret;
-  int it;
-
-  it = kh_put(weak, h, obj_ptr(pic, key), &ret);
-  kh_val(h, it) = val;
-}
-
-bool
-pic_weak_has(pic_state *pic, pic_value weak, pic_value key)
-{
-  khash_t(weak) *h = &weak_ptr(pic, proc_ptr(pic, weak)->env->regs[0])->hash;
-
-  return kh_get(weak, h, obj_ptr(pic, key)) != kh_end(h);
-}
-
-void
-pic_weak_del(pic_state *pic, pic_value weak, pic_value key)
-{
-  khash_t(weak) *h = &weak_ptr(pic, proc_ptr(pic, weak)->env->regs[0])->hash;
-  int it;
-
-  it = kh_get(weak, h, obj_ptr(pic, key));
-  if (it == kh_end(h)) {
-    pic_error(pic, "element not found for given key", 1, key);
-  }
-  kh_del(weak, h, it);
-}
-
-static pic_value
-pic_weak_make_ephemeron_table(pic_state *pic)
-{
-  pic_get_args(pic, "");
-
-  return pic_make_weak(pic);
-}
-
-void
-pic_init_weak(pic_state *pic)
-{
-  pic_defun(pic, "make-ephemeron-table", pic_weak_make_ephemeron_table);
-}

piclib/eval.scm

@@ -99,7 +99,7 @@
         ((environment-binding env) id uid))
 
       (define (make-environment prefix)
-        (%make-environment #f (symbol->string prefix) (make-ephemeron-table)))
+        (%make-environment #f (symbol->string prefix) (make-attribute)))
 
       (define default-environment
         (let ((env (make-environment (string->symbol ""))))
@@ -116,7 +116,7 @@
             env)))
 
       (define (extend-environment parent)
-        (%make-environment parent #f (make-ephemeron-table)))
+        (%make-environment parent #f (make-attribute)))
 
 
       ;; macro
@@ -589,7 +589,7 @@
             (let ((table (the 'table))
                   (prev (the 'prev))
                   (it (the 'it)))
-              `(,(the 'let) ((,table (,(the 'make-ephemeron-table)))
+              `(,(the 'let) ((,table (,(the 'make-attribute)))
                              (,prev (,(the 'current-dynamic-environment))))
                 (,(the 'current-dynamic-environment) (,(the 'cons) ,table ,prev))
                 (,the-begin . ,formal)