Created
January 7, 2026 09:05
-
-
Save psilord/3ccc0adc6d23624ce2d726986aa0d113 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; TODO: This function really needs some documentation. It is used to | |
| ;; partition a pile of forms in a list into group based upon a categorization | |
| ;; function. | |
| (defun sieve (pred sequ &key (key #'identity) | |
| (collector nil) | |
| (values t) | |
| (pred-range-sort nil) | |
| (initial-key-pool nil) ;; ensure all buckets present! | |
| (result-transformer-func #'identity) | |
| (decorate-position nil)) | |
| (let ((result (make-hash-table :test #'equal))) | |
| ;; Initialize the key pool if supplied. | |
| (when initial-key-pool | |
| (dolist (initial-key initial-key-pool) | |
| (setf (gethash initial-key result) nil))) | |
| (flet ((separator-func (elem pos) | |
| (let ((decision (funcall pred (funcall key elem)))) | |
| (let ((presentp (nth-value 1 (gethash decision result)))) | |
| (unless presentp | |
| (setf (gethash decision result) nil)) | |
| (push (if decorate-position | |
| (list pos elem) | |
| elem) | |
| (gethash decision result)))))) | |
| (loop :for elem :in sequ | |
| :for pos :by 1 | |
| :do (separator-func elem pos)) | |
| (let ((result-list nil)) | |
| (maphash (lambda (k v) | |
| (push (list k (nreverse v)) result-list)) | |
| result) | |
| (let* ((sorted-result-list | |
| (if pred-range-sort | |
| (stable-sort result-list pred-range-sort :key #'first) | |
| result-list)) | |
| (transformed-result-list | |
| (mapcar (lambda (entry) | |
| (list (first entry) | |
| (funcall result-transformer-func | |
| (second entry)))) | |
| sorted-result-list)) | |
| (collected-list | |
| (if collector | |
| (mapcar collector transformed-result-list) | |
| transformed-result-list))) | |
| (if values | |
| (values-list collected-list) | |
| collected-list)))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment