source: branches/1.1.x/src/org/armedbear/lisp/HashTableFunctions.java

Last change on this file was 13440, checked in by ehuelsmann, 14 years ago

Rename writeToString() to printObject() since that's what it's being used for.
Additionally, create princToString() for use in error messages, making the

required replacement where appropriate.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.2 KB
Line 
1/*
2 * HashTableFunctions.java
3 *
4 * Copyright (C) 2002-2006 Peter Graves
5 * $Id: HashTableFunctions.java 13440 2011-08-05 21:25:10Z ehuelsmann $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38public final class HashTableFunctions
39{
40  static final LispObject FUNCTION_EQ =
41    Symbol.EQ.getSymbolFunction();
42  static final LispObject FUNCTION_EQL =
43    Symbol.EQL.getSymbolFunction();
44  static final LispObject FUNCTION_EQUAL =
45    Symbol.EQUAL.getSymbolFunction();
46  static final LispObject FUNCTION_EQUALP =
47    Symbol.EQUALP.getSymbolFunction();
48
49  private static final Primitive _MAKE_HASH_TABLE
50      = new pf__make_hash_table();
51  @DocString(name="%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       
57      @Override
58      public LispObject execute(LispObject test, LispObject size,
59                                LispObject rehashSize, 
60                                LispObject rehashThreshold)
61      {
62        final int n = Fixnum.getValue(size);
63        if (test == FUNCTION_EQL || test == NIL)
64          return HashTable.newEqlHashTable(n, rehashSize, rehashThreshold);
65        if (test == FUNCTION_EQ)
66          return HashTable.newEqHashTable(n, rehashSize, rehashThreshold);
67        if (test == FUNCTION_EQUAL)
68          return HashTable.newEqualHashTable(n, rehashSize, rehashThreshold);
69        if (test == FUNCTION_EQUALP)
70          return HashTable.newEqualpHashTable(n, rehashSize, rehashThreshold);
71        return error(new LispError("Unsupported test for MAKE-HASH-TABLE: " +
72                                    test.princToString()));
73      }
74    };
75
76
77  private static final Primitive _MAKE_WEAK_HASH_TABLE
78    = new pf__make_weak_hash_table();
79  @DocString(name="%make-weak-hash-table")
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.princToString()));
106      }
107    };
108
109  private static final Primitive GETHASH
110    = new pf_gethash();
111  @DocString(name="gethash",
112             args="key hash-table &optional default",
113             returns="value, present-p",
114             doc="Returns the value associated with KEY in HASH-TABLE.")
115  private static final class pf_gethash extends Primitive {
116      pf_gethash() {
117        super(Symbol.GETHASH, "key hash-table &optional default");
118      }
119
120      @Override
121      public LispObject execute(LispObject key, LispObject ht)
122
123      {
124          if (ht instanceof WeakHashTable) {
125              return ((WeakHashTable)ht).gethash(key);
126          }
127          return checkHashTable(ht).gethash(key);
128      }
129     
130      @Override
131      public LispObject execute(LispObject key, LispObject ht,
132                                LispObject defaultValue)
133      {
134          if (ht instanceof WeakHashTable) {
135              return ((WeakHashTable)ht).gethash(key, defaultValue);
136          }
137          return checkHashTable(ht).gethash(key, defaultValue);
138      }
139    };
140
141  private static final Primitive GETHASH1
142    = new pf_gethash1();
143  @DocString(name="gethash1",
144             args="key hash-table", returns="value")
145  private static final class pf_gethash1 extends Primitive {
146      pf_gethash1() {
147        super(Symbol.GETHASH1, "key hash-table");
148      }
149      @Override
150      public LispObject execute(LispObject first, LispObject second) {
151        if (second instanceof WeakHashTable) {
152            final WeakHashTable ht = (WeakHashTable) second;
153            synchronized (ht) {
154                final LispObject value = ht.get(first);
155                return value != null ? value : NIL;
156            }
157        } else {
158            final HashTable ht = checkHashTable(second);
159            synchronized (ht) {
160                final LispObject value = ht.get(first);
161                return value != null ? value : NIL;
162            }
163        }
164      }
165    };
166
167  private static final Primitive PUTHASH
168    = new pf_puthash();
169  @DocString(name="puthash",
170             args="key hash-table new-value &optional default", returns="value")
171  private static final class pf_puthash extends Primitive {
172      pf_puthash() {
173        super(Symbol.PUTHASH,
174             "key hash-table new-value &optional default");
175      }
176      @Override
177      public LispObject execute(LispObject key, LispObject ht,
178                                LispObject value)
179      {
180        if (ht instanceof WeakHashTable) {
181            return ((WeakHashTable)ht).puthash(key, value);
182        }
183        return checkHashTable(ht).puthash(key, value);
184      }
185      @Override
186      public LispObject execute(LispObject key, LispObject ht,
187                                LispObject ignored, LispObject value)
188      {
189        if (ht instanceof WeakHashTable) {
190            return ((WeakHashTable)ht).puthash(key, value);
191        }
192        return checkHashTable(ht).puthash(key, value);
193      }
194    };
195
196  private static final Primitive REMHASH
197    = new pf_remhash();
198  @DocString(name="remhash",
199             args="key hash-table", returns="generalized-boolean",
200             doc="Removes the value for KEY in HASH-TABLE, if any.")
201  private static final class pf_remhash extends Primitive {
202      pf_remhash() {
203        super(Symbol.REMHASH, "key hash-table");
204      }
205      @Override
206      public LispObject execute(LispObject key, LispObject ht) {
207        if (ht instanceof WeakHashTable) {
208            return ((WeakHashTable)ht).remhash(key);
209        }
210        return checkHashTable(ht).remhash(key);
211      }
212    };
213
214  private static final Primitive CLRHASH
215    = new pf_clrhash();
216  @DocString(name="clrhash",
217             args="hash-table", returns="hash-table")
218  private static final class pf_clrhash extends Primitive {
219      pf_clrhash() {
220        super(Symbol.CLRHASH, "hash-table");
221      }
222      @Override
223      public LispObject execute(LispObject ht)
224      {
225        if (ht instanceof WeakHashTable) {
226            ((WeakHashTable)ht).clear();
227            return ht;
228        }
229        checkHashTable(ht).clear();
230        return ht;
231      }
232    };
233
234  private static final Primitive HASH_TABLE_COUNT
235    = new pf_hash_table_count();
236  @DocString(name="hash-table-count",
237             args="hash-table",
238             doc="Returns the number of entries in HASH-TABLE.")
239  private static final class pf_hash_table_count extends Primitive {
240      pf_hash_table_count() {
241          super(Symbol.HASH_TABLE_COUNT, "hash-table");
242      }
243      @Override
244      public LispObject execute(LispObject arg)
245      {
246          if (arg instanceof WeakHashTable) {
247              return Fixnum.getInstance(((WeakHashTable)arg).getCount());
248          }
249          return Fixnum.getInstance(checkHashTable(arg).getCount());
250      }
251    };
252
253  private static final Primitive SXHASH
254    = new pf_sxhash();
255  @DocString(name="sxhash",
256             args="object => hash-code")
257  private static final class pf_sxhash extends Primitive {
258      pf_sxhash() {
259        super(Symbol.SXHASH, "object");
260      }
261      @Override
262      public LispObject execute(LispObject arg)
263      {
264        return Fixnum.getInstance(arg.sxhash());
265      }
266    };
267
268  // For EQUALP hash tables.
269  @DocString(name="psxhash",
270             args="object")
271  private static final Primitive PSXHASH
272    = new pf_psxhash();
273  private static final class pf_psxhash extends Primitive  {
274      pf_psxhash() {
275        super("psxhash", PACKAGE_SYS, true, "object");
276      }
277      @Override
278      public LispObject execute(LispObject arg)
279      {
280        return Fixnum.getInstance(arg.psxhash());
281      }
282    };
283
284  private static final Primitive HASH_TABLE_P
285    = new pf_hash_table_p();
286  @DocString(name="hash-table-p",
287             args="object",
288             doc="Whether OBJECT is an instance of a hash-table.")
289  private static final class pf_hash_table_p extends Primitive {
290      pf_hash_table_p(){
291        super(Symbol.HASH_TABLE_P,"object");
292      }
293      @Override
294      public LispObject execute(LispObject arg)
295      {
296          if (arg instanceof WeakHashTable) return T;
297          return arg instanceof HashTable ? T : NIL;
298      }
299    };
300
301  private static final Primitive HASH_TABLE_ENTRIES
302    = new pf_hash_table_entries();
303  @DocString(name="hah-table-entries",
304             args="hash-table",
305             doc="Returns a list of all key/values pairs in HASH-TABLE.")
306  private static final class pf_hash_table_entries extends Primitive {
307      pf_hash_table_entries() {
308        super("hash-table-entries", PACKAGE_SYS, false);
309      }
310      @Override
311      public LispObject execute(LispObject arg)
312      {
313          if (arg instanceof WeakHashTable) {
314              return ((WeakHashTable)arg).ENTRIES();
315          }
316          return checkHashTable(arg).ENTRIES();
317      }
318    };
319
320  private static final Primitive HASH_TABLE_TEST
321    = new pf_hash_table_test();
322  @DocString(name="hash-table-test",
323             args="hash-table",
324             doc="Return the test used for the keys of HASH-TABLE.")
325  private static final class pf_hash_table_test extends Primitive {
326      pf_hash_table_test() {
327        super(Symbol.HASH_TABLE_TEST, "hash-table");
328      }
329      public LispObject execute(LispObject arg)
330      {
331          if (arg instanceof WeakHashTable) {
332              return ((WeakHashTable)arg).getTest();
333          }
334          return checkHashTable(arg).getTest();
335      }
336    };
337
338  private static final Primitive HASH_TABLE_SIZE
339    = new pf_hash_table_size();
340  @DocString(name="hash-table-size",
341             args="hash-table",
342             doc="Returns the number of storage buckets in HASH-TABLE.")
343  private static final class pf_hash_table_size extends Primitive {
344      pf_hash_table_size() {
345        super(Symbol.HASH_TABLE_SIZE, "hash-table");
346      }
347      @Override
348      public LispObject execute(LispObject arg)
349      {
350          if (arg instanceof WeakHashTable) {
351              return Fixnum.getInstance(((WeakHashTable)arg).getSize());
352          }
353          return Fixnum.getInstance(checkHashTable(arg).getSize());
354      }
355    };
356
357  private static final Primitive HASH_TABLE_REHASH_SIZE
358    = new pf_hash_table_rehash_size();
359  @DocString(name="hash-table-rehash-size",
360             args="hash-table")
361  private static final class pf_hash_table_rehash_size extends Primitive {
362      pf_hash_table_rehash_size() {
363        super(Symbol.HASH_TABLE_REHASH_SIZE, "hash-table");
364      }
365      @Override
366      public LispObject execute(LispObject arg)
367      {
368          if (arg instanceof WeakHashTable) {
369              return ((WeakHashTable)arg).getRehashSize();
370          }
371          return checkHashTable(arg).getRehashSize();
372      }
373    };
374
375  private static final Primitive HASH_TABLE_REHASH_THRESHOLD
376    = new pf_hash_table_rehash_threshold();
377  @DocString(name="hash-table-rehash-threshold",
378             args="hash-table")
379  private static final class pf_hash_table_rehash_threshold extends Primitive {
380      pf_hash_table_rehash_threshold() {
381        super(Symbol.HASH_TABLE_REHASH_THRESHOLD, "hash-table");
382      }
383      @Override
384      public LispObject execute(LispObject arg)
385      {
386          if (arg instanceof WeakHashTable) {
387              return ((WeakHashTable)arg).getRehashThreshold();
388          }
389          return checkHashTable(arg).getRehashThreshold();
390      }
391    };
392
393  private static final Primitive MAPHASH
394    = new pf_maphash();
395  @DocString(name="maphash",
396             args="function hash-table",
397             doc="Iterates over all entries in the hash-table. For each entry,"
398             + " the function is called with two arguments--the key and the"
399             + " value of that entry.")
400  private static final class pf_maphash extends Primitive {
401      pf_maphash() {
402        super(Symbol.MAPHASH, "function hash-table");
403      }
404      @Override
405      public LispObject execute(LispObject first, LispObject second)
406      {
407          if (second instanceof WeakHashTable) {
408              return ((WeakHashTable)second).MAPHASH(first);
409          }
410        return checkHashTable(second).MAPHASH(first);
411      }
412    };
413
414  private static final Primitive HASH_TABLE_WEAKNESS
415    = new pf_hash_table_weakness();
416  @DocString(name="hash-table-weakness",
417             args="hash-table",
418             doc="Return weakness property of HASH-TABLE, or NIL if it has none.")
419  private static final class pf_hash_table_weakness extends Primitive {
420      pf_hash_table_weakness() {
421          super(Symbol.HASH_TABLE_WEAKNESS, "hash-table");
422      }
423      @Override
424      public LispObject execute(LispObject first) 
425      {
426          if (first instanceof HashTable) {
427              return NIL;
428          } else if (first instanceof WeakHashTable) {
429              return ((WeakHashTable)first).getWeakness();
430          }
431          return error(new TypeError(first, Symbol.HASH_TABLE));
432      }
433  };
434
435  protected static HashTable checkHashTable(LispObject ht) {
436    if (ht instanceof HashTable) return (HashTable)ht;
437    type_error(ht, Symbol.HASH_TABLE);   
438    return null;
439  }
440}
Note: See TracBrowser for help on using the repository browser.