# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468588054 0
# Node ID d1a73b73b4c7fce4387b3ca0e084905f0a52938e
# Parent  bc2e3a4dc208f8450d18b13c36aed75f51ef0c8f
Dammit reddit

diff -r bc2e3a4dc208 -r d1a73b73b4c7 make-quickutils.lisp
--- a/make-quickutils.lisp	Fri Jul 08 20:17:45 2016 +0000
+++ b/make-quickutils.lisp	Fri Jul 15 13:07:34 2016 +0000
@@ -9,6 +9,7 @@
                ; :ensure-boolean
                :with-gensyms
                :once-only
+               :emptyp
                ; :iota
                :curry
                :rcurry
diff -r bc2e3a4dc208 -r d1a73b73b4c7 package.lisp
--- a/package.lisp	Fri Jul 08 20:17:45 2016 +0000
+++ b/package.lisp	Fri Jul 15 13:07:34 2016 +0000
@@ -34,6 +34,8 @@
     #:run-time
     #:since-start-into
     #:per-iteration-into
+    #:in-lists
+    #:in-sequences
     #:%)
   (:shadowing-import-from #:iterate
     #:in))
diff -r bc2e3a4dc208 -r d1a73b73b4c7 quickutils.lisp
--- a/quickutils.lisp	Fri Jul 08 20:17:45 2016 +0000
+++ b/quickutils.lisp	Fri Jul 15 13:07:34 2016 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:WITH-GENSYMS :ONCE-ONLY :CURRY :RCURRY :N-GRAMS) :ensure-package T :package "MAZES.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:WITH-GENSYMS :ONCE-ONLY :EMPTYP :CURRY :RCURRY :N-GRAMS) :ensure-package T :package "MAZES.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "MAZES.QUICKUTILS")
@@ -15,8 +15,8 @@
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:STRING-DESIGNATOR :WITH-GENSYMS
                                          :MAKE-GENSYM-LIST :ONCE-ONLY
-                                         :ENSURE-FUNCTION :CURRY :RCURRY :TAKE
-                                         :N-GRAMS))))
+                                         :NON-ZERO-P :EMPTYP :ENSURE-FUNCTION
+                                         :CURRY :RCURRY :TAKE :N-GRAMS))))
 
   (deftype string-designator ()
     "A string designator type. A string designator is either a string, a symbol,
@@ -108,6 +108,20 @@
                     names-and-forms gensyms)
                ,@forms)))))
   
+
+  (defun non-zero-p (n)
+    "Check if `n` is non-zero."
+    (not (zerop n)))
+  
+
+  (defgeneric emptyp (object)
+    (:documentation "Determine if `object` is empty.")
+    (:method ((x null)) t)
+    (:method ((x cons)) nil)
+    (:method ((x vector)) (zerop (length x))) ; STRING :< VECTOR
+    (:method ((x array)) (notany #'non-zero-p (array-dimensions x)))
+    (:method ((x hash-table)) (zerop (hash-table-count x))))
+  
 (eval-when (:compile-toplevel :load-toplevel :execute)
   ;;; To propagate return type and allow the compiler to eliminate the IF when
   ;;; it is known if the argument is function or not.
@@ -175,6 +189,7 @@
                       :collect (subseq sequence i (+ i n))))))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(with-gensyms with-unique-names once-only curry rcurry n-grams)))
+  (export '(with-gensyms with-unique-names once-only emptyp curry rcurry
+            n-grams)))
 
 ;;;; END OF quickutils.lisp ;;;;
diff -r bc2e3a4dc208 -r d1a73b73b4c7 src/utils.lisp
--- a/src/utils.lisp	Fri Jul 08 20:17:45 2016 +0000
+++ b/src/utils.lisp	Fri Jul 15 13:07:34 2016 +0000
@@ -210,3 +210,39 @@
            `(for ,per = (- ,current-time ,previous-time)))
         ,(when (and (null var) (null per))
            `(finally (return ,since)))))))
+
+
+(defmacro-driver (FOR var IN-LISTS lists)
+  (let ((kwd (if generate 'generate 'for)))
+    (with-gensyms (list)
+      `(progn
+        (generate ,list :in (remove nil (list ,@lists)))
+        (,kwd ,var next (progn (when (null ,list)
+                                 (next ,list))
+                               (pop ,list)))))))
+
+
+(defun seq-done-p (seq len idx)
+  (if idx
+    (= idx len)
+    (null seq)))
+
+(defmacro-driver (FOR var IN-SEQUENCES seqs)
+  (let ((kwd (if generate 'generate 'for)))
+    (with-gensyms (seq len idx)
+      `(progn
+        (with ,len = nil)
+        (with ,idx = nil)
+        (generate ,seq :in (remove-if #'emptyp (list ,@seqs)))
+        (,kwd ,var next
+         (progn
+           (when (seq-done-p ,seq ,len ,idx)
+             (etypecase (next ,seq)
+               (cons (setf ,len nil ,idx nil))
+               (sequence (setf ,len (length ,seq)
+                               ,idx 0))))
+           (if ,idx
+             (prog1 (elt ,seq ,idx)
+               (incf ,idx))
+             (pop ,seq))))))))
+