[armedbear-cvs] r13310 - trunk/abcl/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Tue Jun  7 11:07:33 2011
New Revision: 13310

Log:
SYS:HASH-TABLE-WEAKNESS provides the weakness property of a hashtable.

Modified:
   trunk/abcl/src/org/armedbear/lisp/HashTableFunctions.java
   trunk/abcl/src/org/armedbear/lisp/Symbol.java
   trunk/abcl/src/org/armedbear/lisp/WeakHashTable.java

Modified: trunk/abcl/src/org/armedbear/lisp/HashTableFunctions.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/HashTableFunctions.java	Tue Jun  7 08:38:11 2011	(r13309)
+++ trunk/abcl/src/org/armedbear/lisp/HashTableFunctions.java	Tue Jun  7 11:07:33 2011	(r13310)
@@ -412,6 +412,27 @@
       }
     };
 
+  @DocString(name="hash-table-weakness",
+             args="hash-table",
+             doc="Return weakness property of HASH-TABLE, or NIL if it has none.")
+  private static final Primitive HASH_TABLE_WEAKNESS
+    = new pf_hash_table_weakness();
+  private static final class pf_hash_table_weakness extends Primitive {
+      pf_hash_table_weakness() {
+          super(Symbol.HASH_TABLE_WEAKNESS, "hash-table");
+      }
+      @Override
+      public LispObject execute(LispObject first) 
+      {
+          if (first instanceof HashTable) {
+              return NIL;
+          } else if (first instanceof WeakHashTable) {
+              return ((WeakHashTable)first).getWeakness();
+          }
+          return error(new TypeError(first, Symbol.HASH_TABLE));
+      }
+  };
+
   protected static HashTable checkHashTable(LispObject ht) {
     if (ht instanceof HashTable) return (HashTable)ht;
     type_error(ht, Symbol.HASH_TABLE);    

Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java	Tue Jun  7 08:38:11 2011	(r13309)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java	Tue Jun  7 11:07:33 2011	(r13310)
@@ -3045,6 +3045,8 @@
     PACKAGE_SYS.addExternalSymbol("GETHASH1");
   public static final Symbol PUTHASH =
     PACKAGE_SYS.addExternalSymbol("PUTHASH");
+  public static final Symbol HASH_TABLE_WEAKNESS =
+    PACKAGE_SYS.addExternalSymbol("HASH-TABLE-WEAKNESS");
   public static final Symbol UNDEFINED_FUNCTION_CALLED =
     PACKAGE_SYS.addExternalSymbol("UNDEFINED-FUNCTION-CALLED");
   public static final Symbol SET_CHAR =

Modified: trunk/abcl/src/org/armedbear/lisp/WeakHashTable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/WeakHashTable.java	Tue Jun  7 08:38:11 2011	(r13309)
+++ trunk/abcl/src/org/armedbear/lisp/WeakHashTable.java	Tue Jun  7 11:07:33 2011	(r13310)
@@ -45,10 +45,6 @@
 import java.util.Map;
 import java.util.concurrent.locks.ReentrantLock;
 
-
-
-
-
 // ??? Replace standard Hashtable when this code is working; maybe not
 // because we have additional places for locking here.
 // 
@@ -78,6 +74,7 @@
     final Comparator comparator;
     final private ReentrantLock lock = new ReentrantLock();
     HashEntry bucketType;
+    final LispObject weakness;
 
     private WeakHashTable(Comparator c, int size, LispObject rehashSize, 
                           LispObject rehashThreshold, LispObject weakness) 
@@ -85,6 +82,7 @@
         this.rehashSize = rehashSize;
         this.rehashThreshold = rehashThreshold;
         bucketType = null;
+        this.weakness = weakness;
         if (weakness.equals(Keyword.KEY)) {
             bucketType = this.new HashEntryWeakKey();
         } else if (weakness.equals(Keyword.VALUE)) {
@@ -350,6 +348,10 @@
     public Symbol getTest() {
         return comparator.getTest();
     }
+    
+    public LispObject getWeakness() {
+        return weakness;
+    }
 
     HashEntry[] getTable() {
         lock.lock();