aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2022-06-25 09:06:02 -0700
committerSean Whitton <spwhitton@spwhitton.name>2022-06-27 13:26:16 -0700
commit05412f20f9159a740f86d8ebaf89e8ac98b909e8 (patch)
tree8e6d90e96949fb22a85175799e99ffeca58dd5a3
parent600df5068c5f49a102b74468a4e8d55152e8e1e6 (diff)
downloadconsfigurator-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.lisp31
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)