Neater way of prying a DECLARE from a &body

Question

I'm writing a macro that generates a DEFUN call—accordingly, I want to ensure that any DECLAREs in the body to the macro get placed immediately after the DEFUN. Here's what I have:

(defmacro defsynced (name (&rest args) &body body)
  (let* ((decl (if (eql (caar body) 'cl:declare)
                   (list (car body))))
         (body (if decl
                   (cdr body)
                   body)))
    `(defun ,name ,args
       ,@decl
       (bordeaux-threads:with-lock-held (*request-lock*)
         ,@body))))

Unfortunately it's rather ugly and not necessarily obvious what's happening here. Is there a nicer way you can think of?

Answer 1

Your solution is not complete because there can be one or more declarations.

Though you can use some off the shelf function for this, it makes for a good study of a technique that can be useful in similar situations.

If you have a list of the form

(alpha beta x epsilon ... omega)

where x is an item of interest on which you want to split the list, you can use the member function to find the sublist which starts with x and then the ldiff function to fetch the prefix of that list (alpha beta) which excludes (x epsilon omega). First step:

(member-if-not (lambda (x) (eq x 'declare)) '(declare declare 3 4 5))

-> (3 4 5)

Of course, we are looking for (declare ...) not declare. We can't use :key #'car for this because forms might not be conses, so:

(member-if-not (lambda (x) (and (consp x) (eq (car x) 'declare)))
               '((declare foo) (declare bar) 3 4 5))
-> (3 4 5)

Now how to get the declarations and the remaining forms by themselves:

(defun separate-decls-and-body (body)
  (let* ((just-the-code (member-if-not (lambda (x)
                                         (and (consp x) (eq (car x) 'declare)))
                                        body))
         (just-the-decls (ldiff body just-the-code)))
    (values just-the-decls just-the-code)))

Tests:

> (separate-decls-and-body '((declare (optimize (speed 3))) (declare (type)) 1 2 3))
((DECLARE (OPTIMIZE (SPEED 3))) (DECLARE (TYPE))) ;
(1 2 3)

> (separate-decls-and-body '((declare (optimize (speed 3)))))
((DECLARE (OPTIMIZE (SPEED 3)))) ;
NIL

> (separate-decls-and-body '())
NIL ;
NIL

> (separate-decls-and-body '(1 2 3))
NIL ;
(1 2 3)

The member family and ldiff are your friends. ldiff is based on the fact that member returns a substructure of the original list and not a copy; it just marches down the list looking for that pointer, and returns all prior items as a new list.