Dynamic Bindings

Common Lisp has an important language feature called dynamic binding. It is possible to rebind a dynamic variable somewhere on the call stack and downstream functions will see that new value, and when the stack is unwound, the old value is brought back.

While Common Lisp does not specify multi-threading, it seems to be a consensus among various implementations that dynamic bindings are thread-local, allowing for controlling the computing context in a safe way.

Before we start experiments, let's define a package to isolate our namespace:

(defpackage "EU.TURTLEWARE.BLOG/DLET"
  (:local-nicknames ("MOP" #+closer-mop "C2MOP"
                           #+(and (not closer-mop) ecl) "MOP"
                           #+(and (not closer-mop) ccl) "CCL"
                           #+(and (not closer-mop) sbcl) "SB-MOP"))
  (:use "CL"))
(in-package "EU.TURTLEWARE.BLOG/DLET")

Dynamic binding of variables is transparent to the programmer, because the operator LET is used for both lexical and dynamic bindings. For example:

(defvar *dynamic-variable* 42)

(defun test ()
  (let ((*dynamic-variable* 15)
        (lexical-variable 12))
    (lambda ()
      (print (cons *dynamic-variable* lexical-variable)))))

(funcall (test))
;;; (42 . 12)

(let ((*dynamic-variable* 'xx))
  (funcall (test)))
;;; (xx . 12)

Additionally the language specifies a special operator PROGV that gives the programmer a control over the dynamic binding mechanism, by allowing passing the dynamic variable by value instead of its name. Dynamic variables are represented by symbols:

(progv (list '*dynamic-variable*) (list 'zz)
  (funcall (test)))
;;; (zz . 12)

The problem

Nowadays it is common to encapsulate the state in the instance of a class. Sometimes that state is dynamic. It would be nice if we could use dynamic binding to control it. That said slots are not variables, and if there are many objects of the same class with different states, then using dynamic variables defined with DEFVAR is not feasible.

Consider the following classes which we want to be thread-safe:

(defgeneric call-with-ink (cont window ink))

(defclass window-1 ()
  ((ink :initform 'red :accessor ink)))

(defmethod call-with-ink (cont (win window-1) ink)
  (let ((old-ink (ink win)))
    (setf (ink win) ink)
    (unwind-protect (funcall cont)
      (setf (ink win) old-ink))))

(defclass window-2 ()
  ())

(defvar *ink* 'blue)
(defmethod ink ((window window-2)) *ink*)

(defmethod call-with-ink (cont (win window-2) ink)
  (let ((*ink* ink))
    (funcall cont)))

The first example is clearly not thread safe. If we access the WINDOW-1 instance from multiple threads, then they will overwrite a value of the slot INK.

The second example is not good either, because when we have many instances of WINDOW-2 then they share the binding. Nesting CALL-WITH-INK will overwrite the binding of another window.

The solution

The solution is to use PROGV:

(defclass window-3 ()
  ((ink :initform (gensym))))

(defmethod initialize-instance :after ((win window-3) &key)
  (setf (symbol-value (slot-value win 'ink)) 'red))

(defmethod call-with-ink (cont (win window-3) ink)
  (progv (list (slot-value win 'ink)) (list ink)
    (funcall cont)))

This way each instance has its own dynamic variable that may be rebound with a designated operator CALL-WITH-INK. It is thread-safe and private. We may add some syntactic sugar so it is more similar to let:

(defmacro dlet (bindings &body body)
  (loop for (var val) in bindings
        collect var into vars
        collect val into vals
        finally (return `(progv (list ,@vars) (list ,@vals)
                           ,@body))))

(defmacro dset (&rest pairs)
  `(setf ,@(loop for (var val) on pairs by #'cddr
                 collect `(symbol-value ,var)
                 collect val)))

(defmacro dref (variable)
  `(symbol-value ,variable))

Dynamic slots

While meta-classes are not easily composable, it is worth noting that we can mold it better into the language by specifying that slot itself has a dynamic value. This way CLOS aficionados will have a new tool in their arsenal.

The approach we'll take is that a fresh symbol is stored as the value of each instance-allocated slot, and then accessors for the slot value will use these symbols as a dynamic variable. Here are low-level accessors:

;;; Accessing and binding symbols behind the slot. We don't use SLOT-VALUE,
;;; because it will return the _value_ of the dynamic variable, and not the
;;; variable itself.
(defun slot-dvar (object slotd)
  (mop:standard-instance-access
   object (mop:slot-definition-location slotd)))

(defun slot-dvar* (object slot-name)
  (let* ((class (class-of object))
         (slotd (find slot-name (mop:class-slots class)
                      :key #'mop:slot-definition-name)))
    (slot-dvar object slotd)))

(defmacro slot-dlet (bindings &body body)
  `(dlet ,(loop for ((object slot-name) val) in bindings
                 collect `((slot-dvar* ,object ,slot-name) ,val))
     ,@body))

Now we'll define the meta-class. We need that to specialize functions responsible for processing slot definitions and the instance allocation. Notice, that we make use of a kludge to communicate between COMPUTE-EFFECTIVE-SLOT-DEFINITION and EFFECTIVE-SLOT-DEFINITION-CLASS – this is because the latter has no access to the direct slot definitions.

;;; The metaclass CLASS-WITH-DYNAMIC-SLOTS specifies alternative effective slot
;;; definitions for slots with an initarg :dynamic.
(defclass class-with-dynamic-slots (standard-class) ())

;;; Class with dynamic slots may be subclasses of the standard class.
(defmethod mop:validate-superclass ((class class-with-dynamic-slots)
                                    (super standard-class))
  t)

;;; When allocating the instance we initialize all slots to a fresh symbol that
;;; represents the dynamic variable.
(defmethod allocate-instance ((class class-with-dynamic-slots) &rest initargs)
  (declare (ignore initargs))
  (let ((object (call-next-method)))
    (loop for slotd in (mop:class-slots class)
          when (typep slotd 'dynamic-effective-slot) do
            (setf (mop:standard-instance-access
                   object
                   (mop:slot-definition-location slotd))
                  (gensym (string (mop:slot-definition-name slotd)))))
    object))

;;; To improve potential composability of CLASS-WITH-DYNAMIC-SLOTS with other
;;; metaclasses we treat specially only slots that has :DYNAMIC in initargs,
;;; otherwise we call the next method.
(defmethod mop:direct-slot-definition-class
    ((class class-with-dynamic-slots) &rest initargs)
  (loop for (key val) on initargs by #'cddr
        when (eq key :dynamic)
          do (return-from mop:direct-slot-definition-class
               (find-class 'dynamic-direct-slot)))
  (call-next-method))

;;; The metaobject protocol did not specify an elegant way to communicate
;;; between the direct slot definition and the effective slot definition.
;;; Luckily we have dynamic bindings! :-)
(defvar *kludge/mop-deficiency/dynamic-slot-p* nil)
(defmethod mop:compute-effective-slot-definition
    ((class class-with-dynamic-slots)
     name
     direct-slotds)
  (if (typep (first direct-slotds) 'dynamic-direct-slot)
      (let* ((*kludge/mop-deficiency/dynamic-slot-p* t))
        (call-next-method))
      (call-next-method)))

(defmethod mop:effective-slot-definition-class
    ((class class-with-dynamic-slots) &rest initargs)
  (declare (ignore initargs))
  (if *kludge/mop-deficiency/dynamic-slot-p*
      (find-class 'dynamic-effective-slot)
      (call-next-method)))

Finally we define a direct and an effective slot classes, and specialize slot accessors that are invoked by the instance accessors.

;;; There is a considerable boilerplate involving customizing slots.
;;;
;;; - direct slot definition: local to a single defclass form
;;;
;;; - effective slot definition: combination of all direct slots with the same
;;;   name in the class and its superclasses
;;;
(defclass dynamic-direct-slot (mop:standard-direct-slot-definition)
  ((dynamic :initform nil :initarg :dynamic :reader dynamic-slot-p)))

;;; DYNAMIC-EFFECTIVE-SLOT is implemented to return as slot-value values of the
;;; dynamic variable that is stored with the instance.
;;;
;;; It would be nice if we could specify :ALLOCATION :DYNAMIC for the slot, but
;;; then STANDARD-INSTANCE-ACCESS would go belly up. We could make a clever
;;; workaround, but who cares?
(defclass dynamic-effective-slot (mop:standard-effective-slot-definition)
  ())

(defmethod mop:slot-value-using-class
    ((class class-with-dynamic-slots)
     object
     (slotd dynamic-effective-slot))
  (dref (slot-dvar object slotd)))

(defmethod (setf mop:slot-value-using-class)
    (new-value
     (class class-with-dynamic-slots)
     object
     (slotd dynamic-effective-slot))
  (dset (slot-dvar object slotd) new-value))

(defmethod mop:slot-boundp-using-class
  ((class class-with-dynamic-slots)
   object
   (slotd dynamic-effective-slot))
  (boundp (slot-dvar object slotd)))

(defmethod mop:slot-makunbound-using-class
  ((class class-with-dynamic-slots)
   object
   (slotd dynamic-effective-slot))
  (makunbound (slot-dvar object slotd)))

With this, we can finally define a class with slots that have dynamic values. What's more, we may bind them like dynamic variables.

;;; Let there be light.
(defclass window-4 ()
  ((ink :initform 'red :dynamic t :accessor ink)
   (normal :initform 'normal :accessor normal))
  (:metaclass class-with-dynamic-slots))

(let ((object (make-instance 'window-4)))
  (slot-dlet (((object 'ink) 15))
    (print (ink object)))
  (print (ink object)))

ContextL provides a similar solution with dynamic slots, although it provides much more, like layered classes. This example is much more self-contained.

The context

Lately I'm working on the repaint queue for McCLIM. While doing so I've decided to make stream operations thread-safe, so it is possible to draw on the stream and write to it from arbitrary thread asynchronously. The access to the output record history needs to be clearly locked, so that may be solved by the mutex. Graphics state is another story, consider the following functions running from separate threads:

(defun team-red ()
  (with-drawing-options (stream :ink +dark-red+)
    (loop for i from 0 below 50000 do
      (write-string (format nil "XXX: ~5d~%" i) stream))))

(defun team-blue ()
  (with-drawing-options (stream :ink +dark-blue+)
    (loop for i from 0 below 50000 do
      (write-string (format nil "YYY: ~5d~%" i) stream))))

(defun team-pink ()
  (with-drawing-options (stream :ink +deep-pink+)
    (loop for i from 0 below 25000 do
      (case (random 2)
        (0 (draw-rectangle* stream 200 (* i 100) 250 (+ (* i 100) 50)))
        (1 (draw-circle* stream 225 (+ (* i 100) 25) 25))))))

(defun gonow (stream)
  (window-clear stream)
  (time (let ((a (clim-sys:make-process #'team-red))
              (b (clim-sys:make-process #'team-blue))
              (c (clim-sys:make-process #'team-grue)))
          (bt:join-thread a)
          (bt:join-thread b)
          (bt:join-thread c)
          (format stream "done!~%")))  )

Operations like WRITE-STRING and DRAW-RECTANGLE can be implemented by holding a lock over the shared resource without much disruption. The drawing color on the other hand is set outside of the loop, so if we had locked the graphics state with a lock, then these functions would be serialized despite being called from different processes. The solution to this problem is to make graphics context a dynamic slot that is accessed with WITH-DRAWING-OPTIONS.

Summary

I hope that I've convinced you that dynamic variables are cool (I'm sure that majority of readers here are already convinced), and that dynamic slots are even cooler :-). Watch forward to the upcoming McCLIM release!

If you like technical writeups like this, please consider supporting me on Patreon.