Xmas wish: generate depends.mk from .asd file

Touting a little Xmas wish into the snowy intertubes: Many kudos to anyone who writes a little tool to generate a depends.mk Makefile from an .asd file. (Similar to gcc's -M / -MM flags.)

A Conditional Situations Function API Pattern

I haven't written for a long time, and before Zach is going to weep my occasional mumblings from Planet Lisp, I thought I better sit down and share some API pattern that I have grown fond of.

The pattern addresses conditional code paths in a function's execution, in particular exceptional situations. Typically, there are the following ways you want to deal with a conditional situation:

• return a caller-specific value,
• signal an error as a structured way to transfer control,
• signal a warning or log a message and continue execution,
• signal a warning or log a message and return from execution,
• ignore the conditional situation and just continue execution,
• or perform some arbitrary caller-specific action.

Using the pattern, we will be able to express all those ways conveniently and concisely in the call to the function.

As illustrative example throughout this posting, we will use JOIN-THREAD. (It was the recent update of SBCL's JOIN-THREAD that reminded me on this pattern.)

JOIN-THREAD waits until the passed thread finishes its execution and returns the values of evaluating the last form in the thread. There are two exceptional situations involved:

1. as one does not necessarily want to wait forever, a caller can specify a timeout that might expire;
2. the thread might not have finished gracefully.

The pattern I want to introduce would make it have the following function interface:

(join-thread thread &key timeout on-timeout on-failure)

Where ON-TIMEOUT and ON-FAILURE can be either functions taking a condition object, or a non-function value that would essentially be interpreted as if (CONSTANTLY <the-value>) was passed.

The code invoking the ON-TIMEOUT callback might be written as follows:

(if (functionp on-timeout)
    (return-from join-thread (funcall on-timeout <timeout condition>))
    (return-from join-thread on-timeout))

Notice that the callback is invoked with a Condition object. Notice further that it's invoked in a tail position of the function being defined. This is true for exceptional situations; in the broader case of conditional situations, the function will usually continue further after having invoked the callback. (Passing a non-function value should result in returning that value even in the case of a mere conditional situations; it makes writing tests much easier that purport to exercise exactly that code path.)

Despite being an exceptional situation (i.e. just continuing is usually impossible), we might still want to provide the caller the ability to proceed further by using Common Lisp's restart system. E.g. to allow a caller to just plainly continue and hang on waiting on the thread forever, we could have written:

(if (functionp on-timeout)
    (with-simple-restart (continue "Ignore timeout, hang on thread ~S." thread)
      (return-from join-thread (funcall on-timeout <timeout condition>)))
    (return-from join-thread on-timeout))

And we can already express a variety of different behaviours. To simply return :TIMEOUT when the timeout expires, we call JOIN-THREAD as follows:

(join-thread <thread> ... :on-timeout ':timeout)

To signal an error on timeout, we call JOIN-THREAD as follows:

(join-thread <thread> ... :on-timeout #'error) ; this should probably be the default

To turn the timeout into a mere warning, it is unfortunately not enough to simply pass #'WARN because WARN is specified to require a condition of subtype Warning.

(join-thread <thread> ... :on-timeout #'warn)  ; caveat: won't do

This restriction on WARN is superfluous but it's there, and we can always define our own variant:

(declaim (inline alert))
(defun alert (datum &rest args)
  (let ((condition (apply #'coerce-to-condition datum args)))
    (if (not (typep condition 'warning))
        (cl:warn "~A" condition)
        (cl:warn condition))))

(join-thread <thread> ... :on-timeout #'alert)

Notice that the above call will display a message on timeout and return NIL. To display a message (or log it using some arbitrary log mechanism) and go on waiting, we could use the following functions:

(declaim (inline invoke-and-continue))
(defun invoke-and-continue (function condition)
  (funcall function condition)
  (continue condition)
  (error "BUG: could not find a CONTINUE restart for condition ~S." condition))

(defun alert+continue (condition)
  (invoke-and-continue #'alert condition))

(defun logg+continue (condition)
  (invoke-and-continue #'logg condition))

(join-thread <thread> ... :on-timeout #'alert+continue)
(join-thread <thread> ... :on-timeout #'logg+continue)

Another example would be ALERT+RESIGNAL which will resignal the condition. This can be useful during debugging when you want to display a condition's underlying message stemming from a certain function call that a handler higher up might catch -- just add :ON-TIMEOUT #'ALERT+RESIGNAL to the call.

If desired, one could add

(defvar *timeout-behaviour* #'error)
(defvar *failure-behaviour* #'error)

and make :ON-TIMEOUT and :ON-FAILURE default to these variables.

So what's nice about this pattern?

After all the CL equivalent would be

(handler-bind ((timeout #'alert+continue))
   (join-thread <thread> ...))

or

(handler-case (join-thread <thread> ...)
   (timeout () :timeout))

which may not be as concise but surely is not overly verbose either.

A couple of things.

For one, it's essentially Continuation Passing Style for exceptional situations which can be exactly what you want occasionally. Also the return-a-value case does not involve signaling a condition or an extra function call - which can make a difference. Likewise, handling an exceptional situation does not involve a non-local exit; just a function call and a local exit.

And another thing, it serves as a window of opportunity to document the exceptional situations in the function's docstring, and of course, it helps remembering these situations during automatic lambda list display.

And it's easier to change between different behaviours as it does not require changing a HANDLER-BIND to a HANDLER-CASE or vice versa, or having to add a BLOCK for explicit transfer of control out of a handler.

And, as mentioned before, the conciseness of the return-a-value case is very handy when writing tests.

It also makes code read more like prose. (He said, handwavingly^Wsternly.)

Use case for Restart-Bind

It's always a good day when you find a perfect use case for one Common
Lisp's less used operators. Lately I had the pleasure to find a good
opportunity for RESTART-BIND.

I've written a network simulator in a couple of hundreds lines of
Common Lisp (not counting our basic protocol and miscanellous stack)
to emulate mobile IP networks. We use it to review that our mobile
broadband accelerator is behaving the way we want it to behave. We
also use it in a complete virtual setup using UML instances for our
test suite as well as for the lab in our office.

For determinism purposes I wanted to be able to reseed the
*RANDOM-STATE* to its initial value by some means. And it turned out
that RESTART-BIND is just the right thing for that job:

(defun simulator (... &key (seed #xDEADBEEF) ...)
 (let ((*random-state* (sb-ext:seed-random-state seed)))
   (restart-bind
       ((reseed #'(lambda ()
                    (setf *random-state* (sb-ext:seed-random-state seed)))
         :report-function
           (formatter "Reseed *RANDOM-STATE* with initial :SEED value.")))
     ...)))

You can reseed manually by interrupting the network simulator and
using the RESEED restart, or you can reseed programmatically (e.g.
periodically after a certain time of inactivity) by

(invoke-restart 'reseed)

Can you feel that warm and fuzzy feeling? Just the right thing. :-)

PS.

Other fun note about restarts and RESTART-BIND. If you squint your
eyes, you will discover that restarts are essentially nothing else
than dynamically scoped local functions, and RESTART-BIND is basically
DYNAMIC-FLET.