diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2022-06-25 09:06:02 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-06-27 13:26:16 -0700 |
commit | 05412f20f9159a740f86d8ebaf89e8ac98b909e8 (patch) | |
tree | 8e6d90e96949fb22a85175799e99ffeca58dd5a3 | |
parent | 600df5068c5f49a102b74468a4e8d55152e8e1e6 (diff) | |
download | consfigurator-05412f20f9159a740f86d8ebaf89e8ac98b909e8.tar.gz |
MULTIPLE-VALUE-MAPCAN: rework for less list traversal in many cases
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/util.lisp | 31 |
1 files changed, 17 insertions, 14 deletions
diff --git a/src/util.lisp b/src/util.lisp index 61be8b7..c78005f 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -20,20 +20,23 @@ (defun multiple-value-mapcan (function &rest lists) "Variant of MAPCAN which preserves multiple return values." - (let ((lists (copy-list lists)) - (results (make-array '(2) :initial-element nil :adjustable t))) - (loop for new-results - = (multiple-value-list - (apply function - (loop for list on lists - if (car list) - collect (pop (car list)) - else do (return-from multiple-value-mapcan - (values-list (coerce results 'list)))))) - do (adjust-array results (max (length results) (length new-results)) - :initial-element nil) - (loop for result in new-results and i upfrom 0 - do (nconcf (aref results i) result))))) + (loop with lists = (copy-list lists) + with results = (make-array '(2) :initial-element nil :adjustable t) + for new = (multiple-value-list + (apply function + (maplist (lambda (lists) + (if (endp (car lists)) + (return + (values-list + (map 'list #'nreverse results))) + (pop (car lists)))) + lists))) + do (loop + initially + (adjust-array results (max (length results) (length new)) + :initial-element nil) + for result in new and i upfrom 0 do + (setf (aref results i) (nreconc result (aref results i)))))) (defun lines (text &optional trimfun (trimchars '(#\Space #\Tab))) (with-input-from-string (stream text) |