While SLIME is most of the time able to indent Common Lisp correctly, it will sometimes trip on custom forms. Let us see how we can customize indentation.

In the process of writing my PostgreSQL client in Common Lisp, I wrote a READ-MESSAGE-CASE macro which reads a message from a stream and execute code depending on the type of the message:

(defmacro read-message-case ((message stream) &rest forms)
  `(let ((,message (read-message ,stream)))
     (case (car ,message)
       (:error-response
        (backend-error (cdr ,message)))
       (:notice-response
        nil)
       ,@forms
       (t
        (error 'unexpected-message :message ,message)))))

This macro is quite useful: all message loops can use it to automatically handle error responses, notices, and signal unexpected messages.

But SLIME does not know how to indent READ-MESSAGE-CASE, so by default it will align all message forms on the first argument:

(read-message-case (message stream)
                   (:authentication-ok
                     (return))
                   (:authentication-cleartext-password
                     (unless password
                       (error 'missing-password))
                     (write-password-message password stream)))

While we want it aligned the same way as HANDLER-CASE:

(read-message-case (message stream)
  (:authentication-ok
    (return))
  (:authentication-cleartext-password
    (unless password
      (error 'missing-password))
    (write-password-message password stream)))

Good news, SLIME indentation is defined as a list of rules. Each rule associates an indentation specification (a S-expression describing how to indent the form) to a symbol and store it as the common-lisp-indent-function property of the symbol.

You can obtain the indentation rule of a Common Lisp symbol easily. For example, executing (get 'defun 'common-lisp-indent-function) (e.g. in IELM or with eval-expression) yields (4 &lambda &body). This indicates that DEFUN forms are to be indented as follows:

• The first argument of DEFUN (the function name) is indented by four spaces.
• The second argument (the list of function arguments) is indented as a lambda list.
• The rest of the arguments are indented based on the lisp-body-indent custom variable, which controls the indentation of the body of a lambda form (two spaces by default).

You can refer to the documentation of the common-lisp-indent-function Emacs function (defined in SLIME of course) for a complete description of the format.

We want READ-MESSAGE-CASE to be indented the same way as HANDLER-CASE, whose indentation specification is (4 &rest (&whole 2 &lambda &body)) (in short, an argument and a list of lambda lists). Fortunately there is a way to specify that a form must be indented the same way as another form, using (as <symbol>).

Let us first define a function to set the indentation specification of a symbol:

(defun g-common-lisp-indent (symbol indent)
  "Set the indentation of SYMBOL to INDENT."
  (put symbol 'common-lisp-indent-function indent))

Then use it for READ-MESSAGE-CASE:

(g-common-lisp-indent 'read-message-case '(as handler-case))

While it is in general best to avoid custom indentation, exceptions are sometimes necessary for readability. And SLIME makes it easy.

23 Jan 2023 6:00pm GMT

Table of Contents

1. Introduction
2. Defining method combinations - the short form
3. Defining method combinations - the long form
   1. The Hooker
   2. The Memoizer
4. Conclusions

Update [2023-01-23]

Christophe Rhodes pointed out that "The Hooker" method combination is not conforming because there are multiple methods with the same "role" that can't be ordered and that have different qualifiers:

Note that two methods with identical specializers, but with different qualifiers, are not ordered by the algorithm described in Step 2 of the method selection and combination process described in Section 7.6.6 (Method Selection and Combination). Normally the two methods play different roles in the effective method because they have different qualifiers, and no matter how they are ordered in the result of Step 2, the effective method is the same. If the two methods play the same role and their order matters, an error is signaled. This happens as part of the qualifier pattern matching in define-method-combination.

http://www.lispworks.com/documentation/HyperSpec/Body/m_defi_4.htm

So instead of using qualifier patterns we should use qualifier predicates. They are not a subject of the above paragraph because of its last sentence (there is also an example in the spec that has multiple methods with a predicate). So instead of

(define-method-combination hooker ()
  (... (hook-before (:before*)) ...) ...)

the method combination should use:

(defun hook-before-p (method-qualifier)
  (typep method-qualifier '(cons (eql :before) (cons t null))))

(define-method-combination hooker ()
  (... (hook-before hook-before-p) ...) ...)

and other "hook" groups should also use predicates.

Another thing worth mentioning is that both ECL and SBCL addressed issues with the qualifier pattern matching and :arguments since the publication of this blog post.

Introduction

Method combinations are used to compute the effective method for a generic function. An effective method is a body of the generic function that combines a set of applicable methods computed based on the invocation arguments.

For example we may have a function responsible for reporting the object status and each method focuses on a different aspect of the object. In that case we may want to append all results into a list:

(defgeneric status (object)
  (:method-combination append))

(defclass base-car ()
  ((engine-status :initarg :engine :accessor engine-status)
   (wheels-status :initarg :wheels :accessor wheels-status)
   (fuel-level :initarg :fuel :accessor fuel-level))
  (:default-initargs :engine 'ok :wheels 'ok :fuel 'full))

(defmethod status append ((object base-car))
  (list :engine (engine-status object)
        :wheels (wheels-status object)
        :fuel (fuel-level object)))

(defclass premium-car (base-car)
  ((gps-status :initarg :gps :accessor gps-status)
   (nitro-level :initarg :nitro :accessor nitro-level))
  (:default-initargs :gps 'no-signal :nitro 'low))

(defmethod status append ((object premium-car))
  (list :gps (gps-status object)
        :nitro (nitro-level object)))

CL-USER> (status (make-instance 'premium-car))
(:GPS NO-SIGNAL :NITRO LOW :ENGINE OK :WHEELS OK :FUEL FULL)

CL-USER> (status (make-instance 'base-car))
(:ENGINE OK :WHEELS OK :FUEL FULL)

The effective method may look like this:

(append (call-method #<method status-for-premium-car>)
        (call-method #<method status-for-base-car>   ))

Note that append is a function so all methods are called. It is possible to use other operators (for example a macro and) and then the invocation of particular methods may be conditional:

(and (call-method #<method can-repair-p-for-premium-car>)
     (call-method #<method can-repair-p-for-base-car>   ))

Defining method combinations - the short form

The short form allows us to define a method combination in the spirit of the previous example:

(OPERATOR (call-method #<m1>)
          (call-method #<m2>)
          ...)

For example we may want to return as the second value the count of odd numbers:

(defun sum-and-count-odd (&rest args)
  (values (reduce #'+ args)
          (count-if #'oddp args)))

(define-method-combination sum-and-count-odd)

(defclass a () ())
(defclass b (a) ())
(defclass c (b) ())

(defgeneric num (o)
  (:method-combination sum-and-count-odd)
  (:method sum-and-count-odd ((o a)) 1)
  (:method sum-and-count-odd ((o b)) 2)
  (:method sum-and-count-odd ((o c)) 3)
  (:method :around ((o c))
    (print "haa!")
    (call-next-method)))

(num (make-instance 'b)) ;; (values 3 1)
(num (make-instance 'c)) ;; (values 6 2)

Note that the short form supports also around methods. It is also important to note that effective methods are cached, that is unless the generic function or the method combination changes, the computation of the effective method may be called only once per the set of effective methods.

Admittedly these examples are not very useful. Usually we operate on data stored in instances and this is not a good abstraction to achieve that. Method combinations are useful to control method invocations and their results. Here is another example:

(defmacro majority-vote (&rest method-calls)
  (let* ((num-methods (length method-calls))
         (tie-methods (/ num-methods 2)))
    `(prog ((yes 0) (no 0))
        ,@(loop for invocation in method-calls
                append `((if ,invocation
                             (incf yes)
                             (incf no))
                         (cond
                           ((> yes ,tie-methods)
                            (return (values t yes no)))
                           ((> no ,tie-methods)
                            (return (values nil yes no))))))
        (error "we have a tie! ~d ~d" yes no))))

(define-method-combination majority-vote)

(defclass a () ())
(defclass b (a) ())
(defclass c (b) ())
(defclass d (c) ())

(defgeneric foo (object param)
  (:method-combination majority-vote)
  (:method majority-vote ((o a) param) nil)
  (:method majority-vote ((o b) param) t)
  (:method majority-vote ((o c) param) t)
  (:method majority-vote ((o d) param) nil))

(foo (make-instance 'a) :whatever) ; (values nil 0 1)
(foo (make-instance 'b) :whatever) ; #<error tie 1 1>
(foo (make-instance 'c) :whatever) ; (values t 2 0)
(foo (make-instance 'd) :whatever) ; #<error tie 2 2>

Defining method combinations - the long form

The long form is much more interesting. It allows us to specify numerous qualifiers and handle methods without any qualifiers at all.

The Hooker

Here we will define a method combination that allows us to define named hooks that are invoked before or after the method. It is possible to have any number of hooks for the same set of arguments (something we can't achieve with the standard :before and :after auxiliary methods):

(defun combine-auxiliary-methods (primary around before after)
  (labels ((call-primary ()
             `(call-method ,(first primary) ,(rest primary)))
           (call-methods (methods)
             (mapcar (lambda (method)
                       `(call-method ,method))
                     methods))
           (wrap-after (the-form)
             (if after
                 `(multiple-value-prog1 ,the-form
                    ,@(call-methods after))
                 the-form))
           (wrap-before (the-form)
             (if before
                 `(progn
                    ,@(call-methods before)
                    ,the-form)
                 the-form))
           (wrap-around (the-form)
             (if around
                 `(call-method ,(first around)
                               (,@(rest around)
                                (make-method ,the-form)))
                 the-form)))
    (wrap-around (wrap-after (wrap-before (call-primary))))))

(define-method-combination hooker ()
  ((normal-before (:before))
   (normal-after  (:after)
                  :order :most-specific-last)
   (normal-around (:around))
   (hook-before   (:before *))
   (hook-after    (:after  *)
                  :order :most-specific-last)
   (hook-around   (:around *))
   (primary () :required t))
  (let ((around (append hook-around normal-around))
        (before (append hook-before normal-before))
        (after  (append normal-after hook-after)))
    (combine-auxiliary-methods primary around before after)))

With this we may define a generic function and associated methods similar to other functions with an extra feature - we may provide named :before, :after and :around methods. Named auxiliary methods take a precedence over unnamed ones. Only after that the specialization is considered. There is one caveat - PCL-derived CLOS implementations (clasp, cmucl, ecl, sbcl) currently ([2023-01-18 śro]) have a bug preventing wildcard qualifier pattern symbol * from working. So better download ccl or wait for fixes. Here's an example for using it:

;;; The protocol.
(defgeneric note-buffer-dimensions-changed (buffer w h)
  (:method (b w h)
    (declare (ignore b w h))
    nil))

(defgeneric change-dimensions (buffer w h)
  (:method-combination hooker))

;;; The implementation of unspecialized methods.
(defmethod change-dimensions :after (buffer w h)
  (note-buffer-dimensions-changed buffer w h))

;;; The stanard class.
(defclass buffer ()
  ((w :initform 0 :accessor w)
   (h :initform 0 :accessor h)))

;;; The implementation for the standard class.
(defmethod change-dimensions ((buffer buffer) w h)
  (print "... Changing the buffer size ...")
  (setf (values (w buffer) (h buffer))
        (values w h)))

(defmethod note-buffer-dimensions-changed ((buffer buffer) w h)
  (declare (ignore buffer w h))
  (print "... Resizing the viewport ..."))

;;; Some dubious-quality third-party code that doesn't want to interfere with
;;; methods defined by the implementation.
(defmethod change-dimensions :after system (buffer w h)
  (print `(log :something-changed ,buffer ,w ,h)))

(defmethod change-dimensions :after my-hook ((buffer buffer) w h)
  (print `(send-email! :me ,buffer ,w ,h)))

CL-USER> (defvar *buffer* (make-instance 'buffer))
*BUFFER*
CL-USER> (change-dimensions *buffer* 10 30)

"... Changing the buffer size ..." 
"... Resizing the viewport ..." 
(LOG :SOMETHING-CHANGED #<BUFFER #x30200088220D> 10 30) 
(SEND-EMAIL! :ME #<BUFFER #x30200088220D> 10 30) 
10
30

The Memoizer

Another example (this time it will work on all implementations) is optional memoization of the function invocation. If we define a method with the qualifier :memoize then the result will be cached depending on arguments. The method combination allows also "normal" auxiliary functions by reusing the function combine-auxiliary-methods from the previous section.

The function ensure-memoized-result accepts the following arguments:

• test: compare generations
• memo: a form that returns the current generation
• cache-key: a list composed of a generic function and its arguments
• form: a form implementing the method to be called

When the current generation is nil that means that caching is disabled and we remove the result from the cache. Otherwise we use the test to compare the generation of a cached value and the current one - if they are the same, then the cached value is returned. Otherwise it is returned.

(defparameter *memo* (make-hash-table :test #'equal))
(defun ensure-memoized-result (test memo cache-key form)
  `(let ((new-generation ,memo))
     (if (null new-generation)
         (progn
           (remhash ,cache-key *memo*)
           ,form)
         (destructuring-bind (old-generation . cached-result)
             (gethash ,cache-key *memo* '(nil))
           (apply #'values
                  (if (,test old-generation new-generation)
                      cached-result
                      (rest
                       (setf (gethash ,cache-key *memo*)
                             (list* new-generation (multiple-value-list ,form))))))))))

The method with the qualifier :memoize is used to compute the current generation key. When there is no such method then the function behaves as if the standard method combination is used. The method combination accepts a single argument test, so it is possible to define different predicates for deciding whether the cache is up-to-date or not.

(define-method-combination memoizer (test)
  ((before (:before))
   (after  (:after) :order :most-specific-last)
   (around (:around))
   (memoize (:memoize))
   (primary () :required t))
  (:arguments &whole args)
  (:generic-function function)
  (let ((form (combine-auxiliary-methods primary around before after))
        (memo `(call-method ,(first memoize) ,(rest memoize)))
        (ckey `(list* ,function ,args)))
    (if memoize
        (ensure-memoized-result test memo ckey form)
        form)))

Now let's define a function with "our" method combination. We will use a counter to verify that values are indeed cached.

(defparameter *counter* 0)

(defgeneric test-function (arg &optional opt)
  (:method-combination memoizer eql))

(defmethod test-function ((arg integer) &optional opt)
  (list* `(:counter ,(incf *counter*)) arg opt))

CL-USER> (test-function 42)
((:COUNTER 1) 42)
CL-USER> (test-function 42)
((:COUNTER 2) 42)
CL-USER> (defmethod test-function :memoize ((arg integer) &optional (cache t))
           (and cache :gen-z))
#<STANDARD-METHOD TEST-FUNCTION :MEMOIZE (INTEGER)>
CL-USER> (test-function 42)
((:COUNTER 3) 42)
CL-USER> (test-function 42)
((:COUNTER 3) 42)
CL-USER> (test-function 42 nil)
((:COUNTER 4) 42)
CL-USER> (test-function 42)
((:COUNTER 3) 42)
CL-USER> (test-function 43)
((:COUNTER 5) 43)
CL-USER> (test-function 43)
((:COUNTER 5) 43)
CL-USER> (defmethod test-function :memoize ((arg (eql 43)) &optional (cache t))
           (and cache :gen-x))
#<STANDARD-METHOD TEST-FUNCTION :MEMOIZE ((EQL 43))>
CL-USER> (test-function 43)
((:COUNTER 6) 43)
CL-USER> (test-function 43)
((:COUNTER 6) 43)
CL-USER> (test-function 42)
((:COUNTER 3) 42)

Conclusions

Method combinations are a feature that is often overlooked but give a great deal of control over the generic function invocation. The fact that ccl is the only implementation from a few that I've tried which got method combinations "right" doesn't surprise me - I've always had an impression that it shines in many unexpected places.

18 Jan 2023 12:00am GMT

I was working on the terminal output for a Common Lisp logger, and I realized that SLIME does not interpret ANSI escape sequences.

This is not the end of the world, but having at least colors would be nice. Fortunately there is a library to do just that.

First let us install the package, here using use-package and straight.el.

(use-package slime-repl-ansi-color
  :straight t)

While in theory we are supposed to just add slime-repl-ansi-color to slime-contribs, it did not work for me, and I add to enable the minor mode manually.

If you already have a SLIME REPL hook, simply add (slime-repl-ansi-color-mode 1). If not, write an initialization function, and add it to the SLIME REPL initialization hook:

(defun g-init-slime-repl-mode ()
  (slime-repl-ansi-color-mode 1))
  
(add-hook 'slime-repl-mode-hook 'g-init-slime-repl-mode)

To test that it works as intended, fire up SLIME and print a simple message using ANSI escape sequences:

(let ((escape (code-char 27)))
  (format t "~C[1;33mHello world!~C[0m~%" escape escape))

While it is tempting to use the #\Esc character, it is part of the Common Lisp standard; therefore we use CODE-CHAR to obtain it from its ASCII numeric value. We use two escape sequences, the first one to set the bold flag and foreground color, and the second one to reset display status.

If everything works well, should you see a nice bold yellow message:

16 Jan 2023 6:00pm GMT