Changeset 13309


Ignore:
Timestamp:
06/07/11 15:38:11 (12 years ago)
Author:
Mark Evenson
Message:

Implementation of hashtables with weak keys and/or values.

MAKE-HASH-TABLE now has an optional :WEAKNESS argument that can take
the values :KEY, :VALUE, :KEY-AND-VALUE, or :KEY-OR-VALUE. :KEY means
that the key of an entry must be live to guarantee that the entry is
preserved. VALUE means that the value of an entry must be live to
guarantee that the entry is preserved. :KEY-AND-VALUE means that both
the key and the value must be live to guarantee that the entry is
preserved. :KEY-OR-VALUE means that either the key or the value must
be live to guarantee that the entry is preserved.

The tests simply excercise the various types of weak hash tables
enough that a GC phase should show that the table indeed does decrease
in size.

Changed the defition of functions in HashTableFunctions? to match
current docstring/pf_XXX() naming conventions.

This implementation is only lightly tested in single-threaded use, and
untested in multiple threading scenarios.

Addresses ticket:140.

Location:
trunk/abcl
Files:
2 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/abcl.asd

    r13261 r13309  
    5656                      (:file "wild-pathnames" :depends-on
    5757                             ("file-system-tests"))
     58                      #+abcl
     59                      (:file "weak-hash-tables")
    5860                      #+abcl
    5961                      (:file "pathname-tests" :depends-on

  • trunk/abcl/src/org/armedbear/lisp/HashTableFunctions.java

    r12970 r13309  
    4747    Symbol.EQUALP.getSymbolFunction();
    4848
    49   // ### %make-hash-table
    50   private static final Primitive _MAKE_HASH_TABLE =
    51     new Primitive("%make-hash-table", PACKAGE_SYS, false)
    52     {
     49  @DocString(name="%make-hash-table")
     50  private static final Primitive _MAKE_HASH_TABLE
     51      = new pf__make_hash_table();
     52  private static final class pf__make_hash_table extends Primitive {
     53      pf__make_hash_table() {
     54        super("%make-hash-table", PACKAGE_SYS, false);
     55      }
     56       
    5357      @Override
    5458      public LispObject execute(LispObject test, LispObject size,
    55                                 LispObject rehashSize, LispObject rehashThreshold)
    56 
     59                                LispObject rehashSize,
     60                                LispObject rehashThreshold)
    5761      {
    5862        final int n = Fixnum.getValue(size);
    … …  
    7074    };
    7175
    72   // ### gethash key hash-table &optional default => value, present-p
    73   private static final Primitive GETHASH =
    74     new Primitive(Symbol.GETHASH, "key hash-table &optional default")
    75     {
     76  @DocString(name="%make-weak-hash-table")
     77  private static final Primitive _MAKE_WEAK_HASH_TABLE
     78    = new pf__make_weak_hash_table();
     79
     80  private static final class pf__make_weak_hash_table extends Primitive {
     81      pf__make_weak_hash_table() {
     82        super("%make-weak-hash-table", PACKAGE_SYS, false);
     83      }
     84      @Override
     85      public LispObject execute(LispObject test,
     86                                LispObject size,
     87                                LispObject rehashSize,
     88                                LispObject rehashThreshold,
     89        LispObject weakness)
     90      {
     91        final int n = Fixnum.getValue(size);
     92        if (test == FUNCTION_EQL || test == NIL)
     93          return WeakHashTable.newEqlHashTable(n, rehashSize,
     94                 rehashThreshold, weakness);
     95        if (test == FUNCTION_EQ)
     96          return WeakHashTable.newEqHashTable(n, rehashSize,
     97                                              rehashThreshold, weakness);
     98        if (test == FUNCTION_EQUAL)
     99          return WeakHashTable.newEqualHashTable(n, rehashSize,
     100             rehashThreshold, weakness);
     101        if (test == FUNCTION_EQUALP)
     102          return WeakHashTable.newEqualpHashTable(n, rehashSize,
     103              rehashThreshold, weakness);
     104        return error(new LispError("Unsupported test for MAKE-HASH-TABLE: " +
     105                                    test.writeToString()));
     106      }
     107    };
     108
     109  @DocString(name="gethash",
     110             args="key hash-table &optional default => value, present-p",
     111             doc="Returns the value associated with KEY in HASH-TABLE.")
     112  private static final Primitive GETHASH
     113    = new pf_gethash();
     114  private static final class pf_gethash extends Primitive {
     115      pf_gethash() {
     116        super(Symbol.GETHASH, "key hash-table &optional default");
     117      }
     118
    76119      @Override
    77120      public LispObject execute(LispObject key, LispObject ht)
    78121
    79122      {
     123          if (ht instanceof WeakHashTable) {
     124              return ((WeakHashTable)ht).gethash(key);
     125          }
    80126          return checkHashTable(ht).gethash(key);
    81127      }
    … …  
    84130      public LispObject execute(LispObject key, LispObject ht,
    85131                                LispObject defaultValue)
    86 
    87       {
     132      {
     133          if (ht instanceof WeakHashTable) {
     134              return ((WeakHashTable)ht).gethash(key, defaultValue);
     135          }
    88136          return checkHashTable(ht).gethash(key, defaultValue);
    89137      }
    90138    };
    91139
    92   // ### gethash1 key hash-table => value
    93   private static final Primitive GETHASH1 =
    94     new Primitive(Symbol.GETHASH1, "key hash-table")
    95     {
    96       @Override
    97       public LispObject execute(LispObject first, LispObject second)
    98 
    99       {
    100         final HashTable ht = checkHashTable(second);
    101         synchronized (ht)
    102           {
    103             final LispObject value = ht.get(first);
    104             return value != null ? value : NIL;
    105           }
     140  @DocString(name="gethash1",
     141             args="key hash-table => value")
     142  private static final Primitive GETHASH1
     143    = new pf_gethash1();
     144  private static final class pf_gethash1 extends Primitive {
     145      pf_gethash1() {
     146        super(Symbol.GETHASH1, "key hash-table");
     147      }
     148      @Override
     149      public LispObject execute(LispObject first, LispObject second) {
     150        if (second instanceof WeakHashTable) {
     151            final WeakHashTable ht = (WeakHashTable) second;
     152            synchronized (ht) {
     153                final LispObject value = ht.get(first);
     154                return value != null ? value : NIL;
     155            }
     156        } else {
     157            final HashTable ht = checkHashTable(second);
     158            synchronized (ht) {
     159                final LispObject value = ht.get(first);
     160                return value != null ? value : NIL;
     161            }
     162        }
    106163      }
    107164    };
    108165
    109166  // ### puthash key hash-table new-value &optional default => value
    110   private static final Primitive PUTHASH =
    111     new Primitive(Symbol.PUTHASH,
    112                   "key hash-table new-value &optional default")
    113     {
     167  @DocString(name="puthash",
     168             args="key hash-table new-value &optional default => value")
     169  private static final Primitive PUTHASH
     170    = new pf_puthash();
     171
     172  private static final class pf_puthash extends Primitive {
     173      pf_puthash() {
     174        super(Symbol.PUTHASH,
     175             "key hash-table new-value &optional default");
     176      }
    114177      @Override
    115178      public LispObject execute(LispObject key, LispObject ht,
    116179                                LispObject value)
    117 
    118       {
    119           return checkHashTable(ht).puthash(key, value);
     180      {
     181        if (ht instanceof WeakHashTable) {
     182            return ((WeakHashTable)ht).puthash(key, value);
     183        }
     184        return checkHashTable(ht).puthash(key, value);
    120185      }
    121186      @Override
    122187      public LispObject execute(LispObject key, LispObject ht,
    123188                                LispObject ignored, LispObject value)
    124 
    125       {
    126           return checkHashTable(ht).puthash(key, value);
    127       }
    128     };
    129 
    130   // remhash key hash-table => generalized-boolean
    131   private static final Primitive REMHASH =
    132     new Primitive(Symbol.REMHASH, "key hash-table")
    133     {
    134       @Override
    135       public LispObject execute(LispObject key, LispObject ht)
    136 
    137       {
    138             return checkHashTable(ht).remhash(key);
    139       }
    140     };
    141 
    142   // ### clrhash hash-table => hash-table
    143   private static final Primitive CLRHASH =
    144     new Primitive(Symbol.CLRHASH, "hash-table")
    145     {
     189      {
     190        if (ht instanceof WeakHashTable) {
     191            return ((WeakHashTable)ht).puthash(key, value);
     192        }
     193        return checkHashTable(ht).puthash(key, value);
     194      }
     195    };
     196
     197  @DocString(name="remhash",
     198             args="key hash-table => generalized-boolean",
     199             doc="Removes the value for KEY in HASH-TABLE, if any.")
     200  private static final Primitive REMHASH
     201    = new pf_remhash();
     202  private static final class pf_remhash extends Primitive {
     203      pf_remhash() {
     204        super(Symbol.REMHASH, "key hash-table");
     205      }
     206      @Override
     207      public LispObject execute(LispObject key, LispObject ht) {
     208        if (ht instanceof WeakHashTable) {
     209            return ((WeakHashTable)ht).remhash(key);
     210        }
     211        return checkHashTable(ht).remhash(key);
     212      }
     213    };
     214
     215  @DocString(name="clrhash",
     216             args="hash-table => hash-table")
     217  private static final Primitive CLRHASH
     218    = new pf_clrhash();
     219  private static final class pf_clrhash extends Primitive {
     220      pf_clrhash() {
     221        super(Symbol.CLRHASH, "hash-table");
     222      }
    146223      @Override
    147224      public LispObject execute(LispObject ht)
    148225      {
    149           checkHashTable(ht).clear();
    150           return ht;
    151       }
    152     };
    153 
    154   // ### hash-table-count
    155   private static final Primitive HASH_TABLE_COUNT =
    156     new Primitive(Symbol.HASH_TABLE_COUNT, "hash-table")
    157     {
    158       @Override
    159       public LispObject execute(LispObject arg)
    160       {
     226        if (ht instanceof WeakHashTable) {
     227            ((WeakHashTable)ht).clear();
     228            return ht;
     229        }
     230        checkHashTable(ht).clear();
     231        return ht;
     232      }
     233    };
     234
     235  @DocString(name="hash-table-count",
     236             args="hash-table",
     237             doc="Returns the number of entries in HASH-TABLE.")
     238  private static final Primitive HASH_TABLE_COUNT
     239    = new pf_hash_table_count();
     240  private static final class pf_hash_table_count extends Primitive {
     241      pf_hash_table_count() {
     242          super(Symbol.HASH_TABLE_COUNT, "hash-table");
     243      }
     244      @Override
     245      public LispObject execute(LispObject arg)
     246      {
     247          if (arg instanceof WeakHashTable) {
     248              return Fixnum.getInstance(((WeakHashTable)arg).getCount());
     249          }
    161250          return Fixnum.getInstance(checkHashTable(arg).getCount());
    162251      }
    163252    };
    164253
    165   // ### sxhash object => hash-code
    166   private static final Primitive SXHASH =
    167     new Primitive(Symbol.SXHASH, "object")
    168     {
     254  @DocString(name="sxhash",
     255             args="object => hash-code")
     256  private static final Primitive SXHASH
     257    = new pf_sxhash();
     258  private static final class pf_sxhash extends Primitive {
     259      pf_sxhash() {
     260        super(Symbol.SXHASH, "object");
     261      }
    169262      @Override
    170263      public LispObject execute(LispObject arg)
    … …  
    174267    };
    175268
    176   // ### psxhash object => hash-code
    177269  // For EQUALP hash tables.
    178   private static final Primitive PSXHASH =
    179     new Primitive("psxhash", PACKAGE_SYS, true, "object")
    180     {
     270  @DocString(name="psxhash",
     271             args="object")
     272  private static final Primitive PSXHASH
     273    = new pf_psxhash();
     274  private static final class pf_psxhash extends Primitive  {
     275      pf_psxhash() {
     276        super("psxhash", PACKAGE_SYS, true, "object");
     277      }
    181278      @Override
    182279      public LispObject execute(LispObject arg)
    … …  
    186283    };
    187284
    188   // ### hash-table-p
    189   private static final Primitive HASH_TABLE_P =
    190     new Primitive(Symbol.HASH_TABLE_P,"object")
    191     {
    192       @Override
    193       public LispObject execute(LispObject arg)
    194       {
    195         return arg instanceof HashTable ? T : NIL;
    196       }
    197     };
    198 
    199   // ### hash-table-entries
    200   private static final Primitive HASH_TABLE_ENTRIES =
    201     new Primitive("hash-table-entries", PACKAGE_SYS, false)
    202     {
    203       @Override
    204       public LispObject execute(LispObject arg)
    205       {
     285  @DocString(name="hash-table-p",
     286             args="object",
     287             doc="Whether OBJECT is an instance of a hash-table.")
     288  private static final Primitive HASH_TABLE_P
     289    = new pf_hash_table_p();
     290  private static final class pf_hash_table_p extends Primitive {
     291      pf_hash_table_p(){
     292        super(Symbol.HASH_TABLE_P,"object");
     293      }
     294      @Override
     295      public LispObject execute(LispObject arg)
     296      {
     297          if (arg instanceof WeakHashTable) return T;
     298          return arg instanceof HashTable ? T : NIL;
     299      }
     300    };
     301
     302  @DocString(name="hah-table-entries",
     303             args="hash-table",
     304             doc="Returns a list of all key/values pairs in HASH-TABLE.")
     305  private static final Primitive HASH_TABLE_ENTRIES
     306    = new pf_hash_table_entries();
     307  private static final class pf_hash_table_entries extends Primitive {
     308      pf_hash_table_entries() {
     309        super("hash-table-entries", PACKAGE_SYS, false);
     310      }
     311      @Override
     312      public LispObject execute(LispObject arg)
     313      {
     314          if (arg instanceof WeakHashTable) {
     315              return ((WeakHashTable)arg).ENTRIES();
     316          }
    206317          return checkHashTable(arg).ENTRIES();
    207318      }
    208319    };
    209320
    210   // ### hash-table-test
    211   private static final Primitive HASH_TABLE_TEST =
    212     new Primitive(Symbol.HASH_TABLE_TEST, "hash-table")
    213     {
    214       @Override
    215       public LispObject execute(LispObject arg)
    216       {
     321  @DocString(name="hash-table-test",
     322             args="hash-table",
     323             doc="Return the test used for the keys of HASH-TABLE.")
     324  private static final Primitive HASH_TABLE_TEST
     325    = new pf_hash_table_test();
     326  private static final class pf_hash_table_test extends Primitive {
     327      pf_hash_table_test() {
     328        super(Symbol.HASH_TABLE_TEST, "hash-table");
     329      }
     330      public LispObject execute(LispObject arg)
     331      {
     332          if (arg instanceof WeakHashTable) {
     333              return ((WeakHashTable)arg).getTest();
     334          }
    217335          return checkHashTable(arg).getTest();
    218336      }
    219337    };
    220338
    221   // ### hash-table-size
    222   private static final Primitive HASH_TABLE_SIZE =
    223     new Primitive(Symbol.HASH_TABLE_SIZE, "hash-table")
    224     {
    225       @Override
    226       public LispObject execute(LispObject arg)
    227       {
     339  @DocString(name="hash-table-size",
     340             args="hash-table",
     341             doc="Returns the number of storage buckets in HASH-TABLE.")
     342  private static final Primitive HASH_TABLE_SIZE
     343    = new pf_hash_table_size();
     344  private static final class pf_hash_table_size extends Primitive {
     345      pf_hash_table_size() {
     346        super(Symbol.HASH_TABLE_SIZE, "hash-table");
     347      }
     348      @Override
     349      public LispObject execute(LispObject arg)
     350      {
     351          if (arg instanceof WeakHashTable) {
     352              return Fixnum.getInstance(((WeakHashTable)arg).getSize());
     353          }
    228354          return Fixnum.getInstance(checkHashTable(arg).getSize());
    229355      }
    230356    };
    231357
    232   // ### hash-table-rehash-size
    233   private static final Primitive HASH_TABLE_REHASH_SIZE =
    234     new Primitive(Symbol.HASH_TABLE_REHASH_SIZE, "hash-table")
    235     {
    236       @Override
    237       public LispObject execute(LispObject arg)
    238       {
     358  @DocString(name="hash-table-rehash-size",
     359             args="hash-table")
     360  private static final Primitive HASH_TABLE_REHASH_SIZE
     361    = new pf_hash_table_rehash_size();
     362  private static final class pf_hash_table_rehash_size extends Primitive {
     363      pf_hash_table_rehash_size() {
     364        super(Symbol.HASH_TABLE_REHASH_SIZE, "hash-table");
     365      }
     366      @Override
     367      public LispObject execute(LispObject arg)
     368      {
     369          if (arg instanceof WeakHashTable) {
     370              return ((WeakHashTable)arg).getRehashSize();
     371          }
    239372          return checkHashTable(arg).getRehashSize();
    240373      }
    241374    };
    242375
    243   // ### hash-table-rehash-threshold
    244   private static final Primitive HASH_TABLE_REHASH_THRESHOLD =
    245     new Primitive(Symbol.HASH_TABLE_REHASH_THRESHOLD, "hash-table")
    246     {
    247       @Override
    248       public LispObject execute(LispObject arg)
    249       {
     376  @DocString(name="hash-table-rehash-threshold",
     377             args="hash-table")
     378  private static final Primitive HASH_TABLE_REHASH_THRESHOLD
     379    = new pf_hash_table_rehash_threshold();
     380  private static final class pf_hash_table_rehash_threshold extends Primitive {
     381      pf_hash_table_rehash_threshold() {
     382        super(Symbol.HASH_TABLE_REHASH_THRESHOLD, "hash-table");
     383      }
     384      @Override
     385      public LispObject execute(LispObject arg)
     386      {
     387          if (arg instanceof WeakHashTable) {
     388              return ((WeakHashTable)arg).getRehashThreshold();
     389          }
    250390          return checkHashTable(arg).getRehashThreshold();
    251391      }
    252392    };
    253393
    254   // ### maphash
    255   private static final Primitive MAPHASH =
    256     new Primitive(Symbol.MAPHASH, "function hash-table")
    257     {
     394  @DocString(name="maphash",
     395             args="function hash-table",
     396             doc="Iterates over all entries in the hash-table. For each entry,"
     397             + " the function is called with two arguments--the key and the"
     398             + " value of that entry.")
     399  private static final Primitive MAPHASH
     400    = new pf_maphash();
     401  private static final class pf_maphash extends Primitive {
     402      pf_maphash() {
     403        super(Symbol.MAPHASH, "function hash-table");
     404      }
    258405      @Override
    259406      public LispObject execute(LispObject first, LispObject second)
    260 
    261       {
     407      {
     408          if (second instanceof WeakHashTable) {
     409              return ((WeakHashTable)second).MAPHASH(first);
     410          }
    262411        return checkHashTable(second).MAPHASH(first);
    263412      }
    264413    };
    265414
    266 protected static HashTable checkHashTable(LispObject ht) {
    267         if (ht instanceof HashTable) return (HashTable)ht;
     415  protected static HashTable checkHashTable(LispObject ht) {
     416    if (ht instanceof HashTable) return (HashTable)ht;
    268417    type_error(ht, Symbol.HASH_TABLE);   
    269         return null;
     418    return null;
     419  }
    270420}
    271 }

  • trunk/abcl/src/org/armedbear/lisp/Keyword.java

    r13028 r13309  
    9999        JAVA_1_7            = internKeyword("JAVA-1.7"),
    100100        KEY                 = internKeyword("KEY"),
     101        KEY_AND_VALUE       = internKeyword("KEY-AND-VALUE"),
     102        KEY_OR_VALUE        = internKeyword("KEY-OR-VALUE"),
    101103        LINUX               = internKeyword("LINUX"),
    102104        LOAD_TOPLEVEL       = internKeyword("LOAD-TOPLEVEL"),
    … …  
    145147        UPCASE              = internKeyword("UPCASE"),
    146148        USE                 = internKeyword("USE"),
     149        VALUE               = internKeyword("VALUE"),
    147150        VERSION             = internKeyword("VERSION"),
    148151        WILD                = internKeyword("WILD"),

  • trunk/abcl/src/org/armedbear/lisp/make-hash-table.lisp

    r11391 r13309  
    3333
    3434(defun make-hash-table (&key (test 'eql) (size 11) (rehash-size 1.5)
    35            (rehash-threshold 0.75))
     35                             (rehash-threshold 0.75)
     36                             (weakness nil))
    3637  (setf test (coerce-to-function test))
    3738  (unless (and (integerp size) (>= size 0))
    3839    (error 'type-error :datum size :expected-type '(integer 0)))
    39   (let ((size (max 11 (min size array-dimension-limit))))
    40     (%make-hash-table test size rehash-size rehash-threshold)))
     40  (let ((size (max 11 (min size array-dimension-limit)))
     41        (weakness-types '(or (eql :key) (eql :value)
     42                             (eql :key-and-value)
     43                             (eql :key-or-value))))
     44    (if weakness
     45        (if (not (typep weakness weakness-types))
     46            (error 'type-error :datum weakness
     47                   :expected-type weakness-types)
     48            (%make-weak-hash-table test size rehash-size
     49                                   rehash-threshold weakness))
     50  (%make-hash-table test size
     51                          rehash-size rehash-threshold))))
     52
     53   
     54 
Note: See TracChangeset for help on using the changeset viewer.