From 7ff1807a5461447fed6d10b4520907058a853e37 Mon Sep 17 00:00:00 2001
From: Attila Lendvai <attila.lendvai@gmail.com>
Date: Thu, 10 Apr 2008 20:28:01 +0300
Subject: [PATCH] Added length

---
 package.lisp   |  1 +
 sequences.lisp | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 tests.lisp     | 38 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 93 insertions(+)

diff --git a/package.lisp b/package.lisp
index b5f2d7d..cc25cf6 100644
--- a/package.lisp
+++ b/package.lisp
@@ -99,6 +99,7 @@
    #:removef
    #:rotate
    #:sequence-of-length-p
+   #:length=
    #:shuffle
    #:starts-with
    #:starts-with-subseq
diff --git a/sequences.lisp b/sequences.lisp
index d275759..be6ff12 100644
--- a/sequences.lisp
+++ b/sequences.lisp
@@ -118,6 +118,60 @@ is not a sequence"
     (list (null sequence))
     (sequence (zerop (length sequence)))))
 
+(defun length= (&rest sequences)
+  "Takes any number of sequences or integers in any order. Returns true iff
+the length of all the sequences and the integers are equal. Hint: there's a
+compiler macro that expands into more efficient code if the first argument
+is a literal integer."
+  (declare (dynamic-extent sequences)
+           (inline sequence-of-length-p)
+           (optimize speed))
+  (unless (cdr sequences)
+    (error "You must call LENGTH= with at least two arguments"))
+  ;; There's room for optimization here: multiple list arguments could be
+  ;; traversed in parallel.
+  (let* ((first (pop sequences))
+         (current (if (integerp first)
+                      first
+                      (length first))))
+    (declare (type array-index current))
+    (dolist (el sequences)
+      (if (integerp el)
+          (unless (= el current)
+            (return-from length= nil))
+          (unless (sequence-of-length-p el current)
+            (return-from length= nil)))))
+  t)
+
+(define-compiler-macro length= (&whole form length &rest sequences)
+  (cond
+    ((zerop (length sequences))
+     form)
+    (t
+     (let ((optimizedp (integerp length)))
+       (with-unique-names (tmp current)
+         (declare (ignorable current))
+         `(locally
+              (declare (inline sequence-of-length-p))
+            (let ((,tmp)
+                  ,@(unless optimizedp
+                     `((,current ,length))))
+              ,@(unless optimizedp
+                  `((unless (integerp ,current)
+                      (setf ,current (length ,current)))))
+              (and
+               ,@(loop
+                    :for sequence :in sequences
+                    :collect `(progn
+                                (setf ,tmp ,sequence)
+                                (if (integerp ,tmp)
+                                    (= ,tmp ,(if optimizedp
+                                                 length
+                                                 current))
+                                    (sequence-of-length-p ,tmp ,(if optimizedp
+                                                                    length
+                                                                    current)))))))))))))
+
 (defun sequence-of-length-p (sequence length)
   "Return true if SEQUENCE is a sequence of length LENGTH. Signals an error if
 SEQUENCE is not a sequence. Returns FALSE for circular lists."
diff --git a/tests.lisp b/tests.lisp
index dba64c7..66a2cdc 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1025,6 +1025,44 @@
                   4))
   (t t t t t t nil nil nil nil))
 
+(deftest length=.1
+    (mapcar #'length=
+            (list nil
+                  #()
+                  (list 1)
+                  (vector 1)
+                  (list 1 2)
+                  (vector 1 2)
+                  (list 1 2)
+                  (vector 1 2)
+                  (list 1 2)
+                  (vector 1 2))
+            (list 0
+                  0
+                  1
+                  1
+                  2
+                  2
+                  1
+                  1
+                  4
+                  4))
+  (t t t t t t nil nil nil nil))
+
+(deftest length=.2
+    ;; test the compiler macro
+    (macrolet ((x (&rest args)
+                 (funcall
+                  (compile nil
+                           `(lambda ()
+                              (length= ,@args))))))
+      (list (x 2 '(1 2))
+            (x '(1 2) '(3 4))
+            (x '(1 2) 2)
+            (x '(1 2) 2 '(3 4))
+            (x 1 2 3)))
+  (t t t t nil))
+
 (deftest copy-sequence.1
     (let ((l (list 1 2 3))
           (v (vector #\a #\b #\c)))
-- 
2.11.4.GIT