source: branches/streams/abcl/src/org/armedbear/lisp/HashTableFunctions.java

Last change on this file was 14466, checked in by rschlatte, 12 years ago

call type_error when possible
  • 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 14466 2013-04-24 12:50:40Z rschlatte $
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 type_error(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.