3 Examples

DO

As first example, we provide an implementation of DO. Notice that CLHS 3.3.4 specifies that the step-forms, end-test-form, and result-forms of a DO expression must be evaluated in the scope of the local declarations given.

Thus:

  (defmacro do ((&rest bindings) (end-test-form &body result-forms) &body decls-and-body
                 &environment macro-env)
    (let ((loop-tag (gensym "DO-LOOP+")))
      (multiple-value-bind (statements decls)
          (parse-declarations::parse-body decls-and-body :documentation nil)
        `(prog ,(loop for binding in bindings
                      collect (destructuring-bind (var &optional init step) binding
                                (declare (ignore step))
                                `(,var ,init)))
            ,@(build-declarations 'declare (parse-declarations decls macro-env))
            ,loop-tag
            (when ,end-test-form (return (progn ,@result-forms)))
            ,@statements
            (psetq ,@(loop for binding in bindings
                           appending (destructuring-bind (var &optional init step) binding
                                       (declare (ignore init))
                                       (when step `(,var ,step)))))
            (go ,loop-tag)))))

In this example, all we had to do is to split a &BODY argument up into the real body forms and the declarations, because, conceptually, we only had to splice in a few new forms before the actual body forms. The declarations as such aren't touched.

Notice that the expression ,@(build-declarations 'declare (parse-declarations decls macro-env)) could (and should!) have been written much easier as a simple ,@decls. We wanted this to be a first and very simple introduction to the basic operators of the Parse-Declarations library, though.

LET*

Next we implement LET* which is a more interesting example as it's an example of a non-trivial binding construct. A naive implementor would just go off making a LET* form expand into nested LET forms. That would, however, be broken with respect to declarations which must be nested alongside the bindings they affect.

With the :affecting parameter of filter-declaration-env, we can easily extract only those declarations which affect a given binding. Thus:

  (defmacro let* (bindings &body body &environment macro-env)
    (flet ((normalize-binding (binding)
             (cond ((symbolp binding)    `(,binding nil))
                   ((null (cdr binding)) `(,(car binding) nil))
                   (t binding))))
      (multiple-value-bind (real-body decls) (parse-declarations::parse-body body :documentation nil)
        (let ((decl-env (parse-declarations decls macro-env)))
          (check-declaration-env decl-env :unknown-allowed nil :warn-only t)
          (labels ((generate-nested-lets (bindings &optional used-binding-names)
                     (if (null bindings)
                         `(locally
                              ,@(build-declarations 'declare
                                  (filter-declaration-env decl-env :include :free)
                                  (filter-declaration-env decl-env :include :bound
                                                          :not-affecting used-binding-names))
                            ,@real-body)
                         (destructuring-bind ((var value) . more-bindings) bindings
                           `(let ((,var ,value))
                              ,@(build-declarations 'declare
                                  (filter-declaration-env decl-env :affecting `(,var)))
                              ,(generate-nested-lets more-bindings (cons var used-binding-names)))))))
            (generate-nested-lets (mapcar #'normalize-binding bindings)))))))

We warn about unknown declaration specifiers, as we don't know which binding such a specifier affects. Hence, we can't know where it is supposed to be located. We could move these into the base case—which may sometimes be exactly the right decision—, but we feel that a user looking at the macroexpansion might be tricked thinking that the right thing is done even though it isn't.

For the base case, we splice in all free declaration specifiers and all bound declaration specifiers which affect bindings not established by the LET* form. These, plus the ignored unknown declaration specifiers and the bound declaration specifiers affecting bindings established by the LET* form, constitute all possible specifiers. So we haven't forgot any.

OPTIMIZE-DECLARATION-ENV

As last example, we show how to change the treatment of standard declaration specifiers.

We want to write a function which takes a list of optimize qualities and which adapts a given declaration-env to these qualities. Existing qualities in that declaration-env are changed, and if no qualities are given, the qualities are added. I.e.:

  (defun optimize-declaration-env (declaration-env qualities &aux result-env)
    (flet ((ensure-car (thing) (if (consp thing) (car thing) thing)))
      (setq result-env
            (map-declaration-env
             #'(lambda (id args ctx)   ; CTX of OPTIMIZE are the qualities.
                 (if (eq id 'optimize)
                     (values id args `(,@qualities ,@(set-difference ctx qualities :key #'ensure-car)))
                     (values id args ctx)))
             declaration-env))
      (if (declaration-env.policy result-env)
          result-env
          (merge-declaration-envs result-env (parse-declarations `((optimize ,@qualities)) nil
                                                                 :nostrip t)))))