Changeset 2729

Show
Ignore:
Timestamp:
03/13/08 17:28:04 (10 months ago)
Author:
ksprotte
Message:

some GROUP-ON enhancements

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/datastore/src/utils/utils.lisp

    r2711 r2729  
    266266        collect (subseq group 0 num))) 
    267267 
    268 (defun group-on (list &key (test #'eql) (key #'identity)) 
    269   (let ((hash (make-hash-table :test test))) 
     268(defun group-on (list &key (test #'eql) (key #'identity) (include-key t)) 
     269  (let ((hash (make-hash-table :test test)) 
     270        keys) 
    270271    (dolist (el list) 
    271       (push el (gethash (funcall key el) hash))) 
    272     (loop for key being the hash-key of hash using (hash-value val) 
    273           collect (cons key val)))) 
     272      (let ((key (funcall key el))) 
     273        (unless (nth-value 1 (gethash key hash)) 
     274          (push key keys)) 
     275        (push el (gethash key hash))))     
     276    (mapcar (lambda (key) (let ((keys (nreverse (gethash key hash)))) 
     277                            (if include-key 
     278                                (cons key keys) 
     279                                keys))) 
     280            (nreverse keys)))) 
    274281 
    275282(defun count-multiple (objects &rest keys)