Commit 7ff1807a authored by Attila Lendvai's avatar Attila Lendvai
Browse files

Added length

parent 3aa4b145
......@@ -99,6 +99,7 @@
#:removef
#:rotate
#:sequence-of-length-p
#:length=
#:shuffle
#:starts-with
#:starts-with-subseq
......
......@@ -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."
......
......@@ -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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment