i've got this recorded and ready to be pushed. unless soemone has
additional comments, i'll push it eventually.
ok, seems like i wasn't really that happy with it after all. i almost
pushed it when i tried to use it in a situation where the sequence
argument was a bigger form and the literal length was lost far away in
the noise. so i wanted to transpose the two arguments as the = sign in
the name suggests, but obviously i couldn't.
then i thought of turning length= into a function that takes &rest
arguments and each argument can be either an integer or a sequence.
you can find the current implementation at the end of the mail, but
i'm not sure vetoers will like it... it's somewhat dwim-ish in that it
accepts both integers and sequences at any position, but on the other
hand anything else feels crippled from the user point of view.
--
attila
(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)))))))))))))
some macroexpansions:
DEV> (pprint (swank::compiler-macroexpand-1 `(length= 1 '(1 2))))
(LOCALLY
(DECLARE (INLINE SEQUENCE-OF-LENGTH-P))
(LET ((#:TMP3027))
(AND
(PROGN
(SETF #:TMP3027 '(1 2))
(IF (INTEGERP #:TMP3027) (= #:TMP3027 1)
(SEQUENCE-OF-LENGTH-P #:TMP3027 1))))))
; No value
DEV> (pprint (swank::compiler-macroexpand-1 `(length= '(1 2) 1)))
(LOCALLY
(DECLARE (INLINE SEQUENCE-OF-LENGTH-P))
(LET ((#:TMP3029) (#:CURRENT3030 '(1 2)))
(UNLESS (INTEGERP #:CURRENT3030)
(SETF #:CURRENT3030 (LENGTH #:CURRENT3030)))
(AND
(PROGN
(SETF #:TMP3029 1)
(IF (INTEGERP #:TMP3029) (= #:TMP3029 #:CURRENT3030)
(SEQUENCE-OF-LENGTH-P #:TMP3029 #:CURRENT3030))))))
; No value
DEV>
