Changeset 13309
- Timestamp:
- 06/07/11 15:38:11 (12 years ago)
- Location:
- trunk/abcl
- Files:
-
- 2 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/abcl.asd
r13261 r13309 56 56 (:file "wild-pathnames" :depends-on 57 57 ("file-system-tests")) 58 #+abcl 59 (:file "weak-hash-tables") 58 60 #+abcl 59 61 (:file "pathname-tests" :depends-on -
trunk/abcl/src/org/armedbear/lisp/HashTableFunctions.java
r12970 r13309 47 47 Symbol.EQUALP.getSymbolFunction(); 48 48 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 53 57 @Override 54 58 public LispObject execute(LispObject test, LispObject size, 55 LispObject rehashSize, LispObject rehashThreshold)56 59 LispObject rehashSize, 60 LispObject rehashThreshold) 57 61 { 58 62 final int n = Fixnum.getValue(size); … … 70 74 }; 71 75 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 76 119 @Override 77 120 public LispObject execute(LispObject key, LispObject ht) 78 121 79 122 { 123 if (ht instanceof WeakHashTable) { 124 return ((WeakHashTable)ht).gethash(key); 125 } 80 126 return checkHashTable(ht).gethash(key); 81 127 } … … 84 130 public LispObject execute(LispObject key, LispObject ht, 85 131 LispObject defaultValue) 86 87 { 132 { 133 if (ht instanceof WeakHashTable) { 134 return ((WeakHashTable)ht).gethash(key, defaultValue); 135 } 88 136 return checkHashTable(ht).gethash(key, defaultValue); 89 137 } 90 138 }; 91 139 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 } 106 163 } 107 164 }; 108 165 109 166 // ### 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 } 114 177 @Override 115 178 public LispObject execute(LispObject key, LispObject ht, 116 179 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); 120 185 } 121 186 @Override 122 187 public LispObject execute(LispObject key, LispObject ht, 123 188 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 } 146 223 @Override 147 224 public LispObject execute(LispObject ht) 148 225 { 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 } 161 250 return Fixnum.getInstance(checkHashTable(arg).getCount()); 162 251 } 163 252 }; 164 253 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 } 169 262 @Override 170 263 public LispObject execute(LispObject arg) … … 174 267 }; 175 268 176 // ### psxhash object => hash-code177 269 // 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 } 181 278 @Override 182 279 public LispObject execute(LispObject arg) … … 186 283 }; 187 284 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 } 206 317 return checkHashTable(arg).ENTRIES(); 207 318 } 208 319 }; 209 320 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 } 217 335 return checkHashTable(arg).getTest(); 218 336 } 219 337 }; 220 338 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 } 228 354 return Fixnum.getInstance(checkHashTable(arg).getSize()); 229 355 } 230 356 }; 231 357 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 } 239 372 return checkHashTable(arg).getRehashSize(); 240 373 } 241 374 }; 242 375 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 } 250 390 return checkHashTable(arg).getRehashThreshold(); 251 391 } 252 392 }; 253 393 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 } 258 405 @Override 259 406 public LispObject execute(LispObject first, LispObject second) 260 261 { 407 { 408 if (second instanceof WeakHashTable) { 409 return ((WeakHashTable)second).MAPHASH(first); 410 } 262 411 return checkHashTable(second).MAPHASH(first); 263 412 } 264 413 }; 265 414 266 protected static HashTable checkHashTable(LispObject ht) {267 415 protected static HashTable checkHashTable(LispObject ht) { 416 if (ht instanceof HashTable) return (HashTable)ht; 268 417 type_error(ht, Symbol.HASH_TABLE); 269 return null; 418 return null; 419 } 270 420 } 271 } -
trunk/abcl/src/org/armedbear/lisp/Keyword.java
r13028 r13309 99 99 JAVA_1_7 = internKeyword("JAVA-1.7"), 100 100 KEY = internKeyword("KEY"), 101 KEY_AND_VALUE = internKeyword("KEY-AND-VALUE"), 102 KEY_OR_VALUE = internKeyword("KEY-OR-VALUE"), 101 103 LINUX = internKeyword("LINUX"), 102 104 LOAD_TOPLEVEL = internKeyword("LOAD-TOPLEVEL"), … … 145 147 UPCASE = internKeyword("UPCASE"), 146 148 USE = internKeyword("USE"), 149 VALUE = internKeyword("VALUE"), 147 150 VERSION = internKeyword("VERSION"), 148 151 WILD = internKeyword("WILD"), -
trunk/abcl/src/org/armedbear/lisp/make-hash-table.lisp
r11391 r13309 33 33 34 34 (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)) 36 37 (setf test (coerce-to-function test)) 37 38 (unless (and (integerp size) (>= size 0)) 38 39 (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.