From 05412f20f9159a740f86d8ebaf89e8ac98b909e8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 25 Jun 2022 09:06:02 -0700 Subject: MULTIPLE-VALUE-MAPCAN: rework for less list traversal in many cases Signed-off-by: Sean Whitton --- src/util.lisp | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) (limited to 'src') 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) -- cgit v1.2.3