Fragments: Posts tagged 'releases'

A timing macro for Common Lisp

2025-11-27T11:50:16Z

For a long time I’ve used a little macro to time chunks of code to avoid an endless succession of boilerplate functions to do this. I’ve finally published the wretched thing.

If you’re writing programs where you care about performance, you often want to be able to make programatic comparisons of performance. time doesn’t do this, since it just reports things. Instead you want something that runs a bit of code a bunch of times and then returns the average time, with ‘a bunch of times’ being controllable. timing is that macro. Here is a simple example:

(defun dotimes/in-naturals-ratio (&key (iters 10000000) (tries 1000))
  (declare (type fixnum iters)
           (optimize speed))
  (/
   (timing (:n tries)
     (let ((s 0))                       ;avoid optimizing loop away
       (declare (type fixnum s))
       (dotimes (i iters s)
         (incf s))))
   (timing (:n tries)
     (let ((s 0))
       (declare (type fixnum s))
       (for ((_ (in-naturals iters t)))
         (incf s))))))

and then, for instance

> (dotimes/in-naturals-ratio)
1.0073159

All timing does is to wrap up its body into a function and then call a function which calls this function the number of times you specify and averages the time, returning that average as a float.

There are some options which let it print a progress note every given number of calls, wrap a call to time around things so you get, for instance, GC reporting, and subtract away the same number of calls to an empty function to try and account for overhead (in practice this is not very useful).

That’s all it is. It’s available in version 10 of my Lisp tools:

documentation here;
git repo here;
tarball here.

Tracing the expansion of external macros

2025-10-10T10:39:18Z

I have improved my trace-macroexpand system so you can say, in effect ‘trace the expansion of only the macros in the interface to a given package’. This is a fairly useful thing.

Tracing macroexpansion in Common Lisp is a pretty useful thing to be able to do, in my experience. It is completely possible to do this in portable CL via *macroexpand-hook*: you simply put your tracing function on this hook, making sure it actually does expand the macro. trace-macroexpand does just this, and lets you specify which macros you want to be traced.

It has always allowed you to say ‘trace all macros whose home package is this package’. That’s less useful than you might think:

it means that not only macros whose names are exported from the packqge are traced, but any macros in its guts are also traced, which generally a user of the package should not be interested in;
it doesn’t trace macros which are exported from a package but whose home package is not that package.

Very often the second thing is exactly what you want: you want to be able to say ‘let me see the expansion of macros in the public interface to this package, but I don’t care about the internal details of it’.

It can now do exactly that.

trace-macro-package now takes a list of package specifiers. If a package specifier is a list of one or more other package specifiers, then it changes their meaning to be ‘trace the exports of these packages only’.

Here is an example:

> (find-symbol "FOR" :org.tfeb.star)
for
:external

> (symbol-package *)
#<The ORG.TFEB.STAR/IMPL package, 188/512 internal, 6/16 external>

> (trace-macroexpand t)
nil

> (setf *trace-macroexpand-per-line-prefix* "| ")
"| "

> (trace-macro-package :org.tfeb.star)
("ORG.TFEB.STAR")

> (for ((_ (in-naturals 10))))
nil

> (untrace-macro-package :org.tfeb.star)
nil

> (trace-macro-package '(:org.tfeb.star))
(("ORG.TFEB.STAR"))

> (for ((_ (in-naturals 10))))
| (for (#))
|  -> (multiple-value-bind (#:<v>) 0 ...)
nil

As well as this, both trace-macro-package and untrace-macro-package now canonicalise the specifiers they are given, which means, for instance that (trace-macro-package '("FOO" "BAR")) is exactly the same as (trace-macro-package '("FOO") '("BAR")): this means that things like

> (trace-macro-package '("FOO" "BAR"))

[...]

> (untrace-macro-package '("FOO"))

will work properly.

This change is in version 10.9.0 of the TFEB.ORG Lisp hax, git repo.

Optional per-line prefix for trace-macroexpand

2025-10-08T16:52:23Z

My macroexpansion tracer can now print per-line prefixes when tracing, which can make things more readable.

I find trace-macroexpand pretty useful: if you write Lisp with lots of nontrivial macros¹ then it can be fairly hard to understand what’s going on when something is not working properly. trace-macroexpand lets you see this either for individual macros or many of them. It can, portably, trace any macro including ones defined by CL, which is even nicer.

However it’s not always easy to distinguish its output from other output. So, I realised I could add a per-line prefix which can help distinguish its output. Here is an example.

> (defvar *a* (cons nil nil))
*a*

> (trace-macroexpand t)
nil

> (trace-macro setf)
(setf)

> (setf (car *a*) 10)
(setf (car *a*) 10)
 -> (system::%rplaca *a* 10)
10

> (setf *trace-macroexpand-per-line-prefix* "| ")
(setf *trace-macroexpand-per-line-prefix* "| ")
 -> (let* (#) (setq *trace-macroexpand-per-line-prefix* #:|Store-Var-1692|))
"| "

> (setf (car *a*) 11)
| (setf (car *a*) 11)
|  -> (system::%rplaca *a* 11)
11

This is in version 10.8.1² of the TFEB.ORG Lisp hax, git repo.

If you aren’t doing that, why are you writing Lisp at all? ↩
10.8.0 had a stupid bug. ↩

Defaulting places in Common Lisp

2025-10-07T11:50:22Z

Or: less boilerplate.

Common Lisp (CL) has a general notion of a place, which is a form which has a value or values and into which a value or values can be stored. Variables are places, but so are forms like (car c): (setf (car c) 2) will store 2 into the car of the cons bound to c. Places can even store multiple values:

(let ((a 1) (b 3))
  (setf (values a b) (values 3 4))
  (values a b))

for instance. Here the place is (values a b) which is a place composed of two other places.

This is a really useful notion, not only because places mean the language no longer needs all sorts of special-purpose mutation functions — rplaca still exists for compatibility but there is no sethash or aset — but because you can implement your own places which behave just like the ones the language provides.

Here’s an example of a place called a ‘wrapped alist’: it’s just a cons whose cdr is an alist. It’s done like this so storing works in general (think about empty alists).

(defun make-wrapped-alist (&optional (for-alist '()))
  (cons nil for-alist))

(defun wrapped-alist-alist (wa)
  (cdr wa))

(defun wav (item wrapped-alist &key (test nil testp) (default nil))
  (let ((found (if testp
                   (assoc item (cdr wrapped-alist) :test test)
                 (assoc item (cdr wrapped-alist)))))
    (if found
        (values (cdr found) t)
      (values default nil))))

(defun (setf wav) (new item wrapped-alist &key (test nil testp) default)
  (declare (ignore default))
  (let ((found (if testp
                   (assoc item (cdr wrapped-alist) :test test)
                 (assoc item (cdr wrapped-alist)))))
    (if found
        (setf (cdr found) new)
      (progn
        (push (cons item new) (cdr wrapped-alist))
        new))))

I will use these wrapped alist places in the examples below.

Defaulting places

Quite often, a place has a default value or a way of indicating that there is no value in it, and you want to be able to say ‘if this place has not been stored into, then store this into it’. In the case of hash tables, the indicator is that gethash returns a second value of nil, and that is the same for av and my wrapped alists.

Sometimes this is not a problem, especially when the accessor for a place lets you provide a default:

(defun symbol-counts (l)
  (let ((table (make-hash-table)))
    (dolist (e l)
      (when (symbolp e)
        (incf (gethash e table 0))))
    (collecting
      (maphash (lambda (k v)
                 (collect (cons k v)))
               table))))

(defun symbol-counts/probably-slower (l)
  (let ((wa (make-wrapped-alist)))
    (dolist (e l)
      (when (symbolp e)
        (incf (av e wa :default 0))))
    (wrapped-alist-alist wa)))

But sometimes it is a problem. Consider the case where the fallback thing you want to store is expensive, or has side-effects. Now you need to write some boilerplate code:

(unless (nth-value 1 (wav item wa)
    (setf (wav item wa) (compute-complicated-thing))))

The wrong way

Well, boilerplate is bad. So you might want to replace this by a macro:

(defmacro defaulting/wrong (place-form value-form)
  ;; This just assumes that PLACE-FORM returns NIL if it has no value:
  ;; in real life you need to be cleverer.
  `(or ,place-form
       (setf ,place-form ,value-form)))

This is not only limited, but incorrect. It’s incorrect because it multiply evaluates subforms to place-form. Consider this:

(let ((i 0) (table (make-hash-table)))
  (defaulting/wrong (gethash (incf i) table) 3))

Well, using wrapped alists it’s easy to see what this is doing wrong:

> (let ((i 0) (wa (make-wrapped-alist)))
    (defaulting/wrong (wav (incf i) wa) 3)
    (wrapped-alist-alist wa))
((2 . 3))

So, not great. The boilerplate you’d need to write is:

> (let ((i 0) (wa (make-wrapped-alist)))
    (let ((k (incf i)))
      (unless (wav k wa)
        (setf (wav k wa) 3)))
    (wrapped-alist-alist wa))
((1 . 3))

The right way

The problem is that any such defaulting macro doesn’t know anything about the place it’s defaulting. So it can’t know which subforms of the place it needs to stash values for.

Well, it turns out that the designers of CL thought of this, and they provided the tool you need, which is get-setf-expansion. Given a place and optionally an environment, this will tell you exactly what you need to know to both read from that place and write to it, and to do so multiple times if need be.

get-setf-expansion is what you need to be able to write your own setf:

(defmacro assign (&rest pairs &environment e)
  ;; This should be SETF give or take
  `(progn
     ,@(collecting
         (for ((tail (on-list pairs :by #'cddr)))
           (destructuring-bind (place-form value-form . _) tail
             (declare (ignore _))
             (multiple-value-bind (vars vals store-vars writer-form reader-form)
                 (get-setf-expansion place-form e)
               (declare (ignore reader-form))
               (collect
                `(let* ,(mapcar #'list vars vals)
                   (multiple-value-bind ,store-vars ,value-form
                     ,writer-form)))))))))

But you can also use it to write defaulting properly. Here is a much fancier version of it, which is now correct (I hope):

(defmacro defaulting (place value-form
                            &body options
                            &key test default-value nth-value &environment e)
  (declare (ignore options))            ;just for indent
  (multiple-value-bind (tvars tforms store-variables storing-form accessing-form)
      (get-setf-expansion place e)
    `(let* ,(mapcar #'list tvars tforms)
         (when ,(cond
                 ((and test nth-value)
                  `(not (funcall ,test ,default-value (nth-value ,nth-value ,accessing-form))))
                 (test
                  `(not (multiple-value-call ,test ,default-value ,accessing-form)))
                 ((and default-value nth-value)
                  `(eql ,default-value (nth-value ,nth-value ,accessing-form)))
                 (default-value
                  `(eql ,default-value ,accessing-form))
                 (nth-value
                  `(not (nth-value ,nth-value ,accessing-form)))
                 (t
                  `(not ,accessing-form)))
           (multiple-value-bind ,store-variables ,value-form
             ,storing-form))
         ,accessing-form)))

So now:

> (let ((i 0) (wa (make-wrapped-alist)))
    (defaulting (wav (incf i) wa) 3)
    (wrapped-alist-alist wa))

Or, using options to this defaulting to tell it the value to be checked:

> (let ((i 0) (wa (make-wrapped-alist)))
    (defaulting (wav (incf i) wa) 3 :nth-value 1)
    (wrapped-alist-alist wa))
((1 . 3))

Finally, you can see the expansion using trace-macroexpand:

> (let ((a (make-wrapped-alist)))
    (defaulting (wav 'k a) 3 :nth-value 1))
(defaulting (wav 'k a)
    3
  :nth-value 1)
 -> (let* ((#:a1 a))
      (when (not (nth-value 1 (wav 'k #:a1)))
        (multiple-value-bind (#:new0) 3 (funcall #'(setf wav) #:new0 'k #:a1)))
      (wav 'k #:a1))
3
t

and this is obviously correct.

This macro exists in org.tfeb.hax.utilities, the git repo for which is tfeb.org/computer/repos/tfeb-lisp-hax.git. Note it is not in the archived GitHub repo.

This is version 10.7.0 of the TFEB.ORG Lisp hax.