[alexandria-devel] Re: length=1

[Attila Lendvai]

>  > 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>