/[cmucl]/src/code/hash.lisp
ViewVC logotype

Diff of /src/code/hash.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by wlott, Sat Nov 24 08:43:20 1990 UTC revision 1.8 by wlott, Tue Dec 4 12:30:43 1990 UTC
# Line 13  Line 13 
13  (in-package 'lisp)  (in-package 'lisp)
14  (export '(hash-table hash-table-p make-hash-table  (export '(hash-table hash-table-p make-hash-table
15            gethash remhash maphash clrhash            gethash remhash maphash clrhash
16            hash-table-count sxhash))            hash-table-count sxhash
17              with-hash-table-iterator))
18    
19  ;;; Vector subtype codes.  ;;; Vector subtype codes.
20    
# Line 449  Line 450 
450       (typecase s-expr       (typecase s-expr
451         (string (sxhash-string s-expr))         (string (sxhash-string s-expr))
452         (t (array-rank s-expr))))         (t (array-rank s-expr))))
     #+nil  
     (compiled-function (%primitive header-length s-expr))  
453      ;; Everything else.      ;; Everything else.
454      (t 42)))      (t 42)))
455    
456    
457    
458    ;;;; WITH-HASH-TABLE-ITERATOR
459    
460    (defmacro with-hash-table-iterator ((function hash-table) &body body)
461      "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body)
462       provides a method of manually looping over the elements of a hash-table.
463       function is bound to a generator-macro that, withing the scope of the
464       invocation, returns three values.  First, whether there are any more objects
465       in the hash-table, second, the key, and third, the value."
466      (let ((counter (gensym))
467            (pointer (gensym))
468            (table (gensym))
469            (size (gensym))
470            (the-table (gensym)))
471        `(let* ((,the-table ,hash-table)
472                (,table (hash-table-table ,the-table))
473                (,size (hash-table-size ,the-table))
474                (,counter 0)
475                (,pointer nil))
476           (macrolet ((,function ()
477                         `(loop
478                            (when (= ,',counter ,',size) (return))
479                            (let ((bucket (or ,',pointer
480                                              (aref ,',table ,',counter))))
481                              (when bucket
482                                (cond ((cdr bucket)
483                                       (setf ,',pointer (cdr bucket)))
484                                      (t
485                                       (setf ,',pointer nil)
486                                       (incf ,',counter)))
487                                (return (values t (caar bucket) (cdar bucket)))))
488                            (incf ,',counter))))
489             ,@body))))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5