--- 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
--- 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))
--- 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 ;;;;
--- 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))))))))
+