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?

score 3 · Answer 1 · answered Mar 23 '12 at 02:50

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.

Wow, thanks for the extensive comment! I probably need to brush up more on my sequence/list operations; using `MEMBER` to get a sublist like that is very neat. — Asherah, Mar 23 '12 at 02:59

score 1 · Accepted Answer · answered Mar 22 '12 at 23:57

1

Since declaration parsing can be tricky, there is a library called parse-declarations that helps with it. It's available from Quicklisp.

(ql:quickload "parse-declarations-1.0")

The parse-body function is particularly relevant to your question.

answered Mar 22 '12 at 23:57

Matthias Benkard

15,497
4
39
47

Thanks! This looks like the ticket! This has provoked another question which I'll post separately. – Asherah Mar 23 '12 at 00:02

Kaz · Answer 3 · 2012-03-23T05:32:15.310

1

No answer is complete without the ritualistic sacrifice to the loop deity:

(defun separate-decls-and-body (body)
  (loop for sub-body on body
        for form = (first sub-body) 
        until (or (atom form) (not (eq (first form) 'declare)))
        collecting form into decls
        finally (return (values decls sub-body))))

edited Mar 23 '12 at 05:32

answered Mar 23 '12 at 03:06

Kaz

55,781
9
100
149

Neater way of prying a DECLARE from a &body

3 Answers3