How to properly use symbol property lists in common lisp macros

55 views Asked by At

I am writing a Common Lisp macro define-computation which defines functions in a specific way and marks them by adding a property :computation to the property list of the symbol of the defined function.

The define-computation is looking for forms which are funcalls of a function with the :computation property set and wrap them with a specific code.

When I work in the REPL my code below is working as expected and macroexpansion allows me to validate that the defined-computation is properly wrapped by supervise-computation:

CL-USER> (macroexpand-1 '(define-computation c-2 ()
  (c-1)
  (format t "~&Compute something 2")))
(PROG1
    (DEFUN C-2 ()
      (DECLARE (OPTIMIZE (SAFETY 3) (SPACE 3)))
      (SUPERVISE-COMPUTATION
        (C-1))
      (FORMAT T "~&Compute something 2"))
  (EXPORT 'C-2)
  (SETF (GET 'C-2 :COMPUTATION) T))
T

However when my code is organised in an ADSF system so that c-1 and c-2 are in a file and c-3 in another, I see that the code generated for c-2 is actually not wrapping c-1.

(PROG1
    (DEFUN C-2 ()
      (DECLARE (OPTIMIZE (SAFETY 3) (SPACE 3)))
      (C-1)
      (FORMAT T "~&Compute something 2"))
  (EXPORT 'C-2)
  (SETF (GET 'C-2 :COMPUTATION) T))

It seems to be true with SBCL and CCL64.

I am guessing this is caused by the interaction of macro expansion and loading/compiling logic but I am not well-versed enough in these aspects of Lisp to explain and solve the undesired behaviour.

Given the code below, how can I organise it in an ADSF module so that C-1, and C-2 are defined in a file and C-3 in another, and so that the macro-expansion of C-2 features the form (SUPERVISE-COMPUTATION (C-1)) instead of just (C-1) when the system is loaded. (Again, evaluating the form below in the REPL will not display the problem.)

(defmacro supervise-computation (&body body-forms)
  "Supervise the computation BODY-FORMS."
  `(progn
     (format t "~&---> Computation starts")
     ,@body-forms
     (format t "~&---> Computation stops")))

(defun define-computation/wrap-computation-forms (body-forms)
  "Walks through BODY-FORMS and wrap computation forms in a fixture."
  (labels
      ((is-funcall-p (form)
         (when (and (listp form) (not (null form)) (symbolp (first form)) (listp (rest form)))
           (case (first form)
             ((funcall apply)
              (second form))
             (t (first form)))))
       (is-computation-form-p (form)
         (get (is-funcall-p form) :computation))
       (wrap-computation-forms (form)
         (cond
       ((is-computation-form-p form)
        `(supervise-computation ,form))
           ((is-funcall-p form)
            (cons (first form) (mapcar #'wrap-computation-forms (rest form))))
           (t
        form))))
    (mapcar #'wrap-computation-forms body-forms)))

(defmacro define-computation (computation-name computation-args &body body)
  `(prog1
       (defun ,computation-name ,computation-args
     (declare (optimize (safety 3) (space 3)))
     ,@(define-computation/wrap-computation-forms body))
     (export (quote ,computation-name))
     (setf (get (quote ,computation-name) :computation) t)))

(define-computation c-1 ()
  (format t "~&Compute something 1"))

(define-computation c-2 ()
  (c-1)
  (format t "~&Compute something 2"))

(define-computation c-3 ()
  (c-2)
  (format t "~&Compute something 3"))
1

There are 1 answers

0
Michaël Le Barbier On

Sleeping over it and looking at other people's code (thank you anaphora) I could figure out a better way to write the macro is

(defmacro define-computation (computation-name computation-args &body body)
  (setf (get computation-name :computation) t)
  `(prog1
      (defun ,computation-name ,computation-args
       (declare (optimize (safety 3) (space 3)))
       ,@(define-computation/wrap-computation-forms body)
      (export (quote ,computation-name))))

This ensures the property is set at macro evaluation time.