Parenthetical Curios

Oddities Explored in Common Lisp

Swank Deploys

SLIME and SWANK are incredible. Start a SWANK server in your application and Whammo! You've can connect to it from the comfort of Emacs. From there you can tinker with its insides to your heart's content. This is a beta-testing dream!

Except when it isn't. Recently I deployed a Common Lisp web application where I ran into some trouble.

Trouble The First: Connection Error

So say that my service is running on server.com and SWANK is listening on port 4040. Then to connect to it I have been using ssh port forwarding:

ssh -L 4040:localhost:4040 me@server.com

So that I can then do slime-connect with localhost and 4040 as its arguments.

You might be surprised, however if you were to have used the following ssh command, which lists the local host ip of 127.0.0.1, instead of localhost:

ssh -L 4040:127.0.0.1:4040 me@server.com

For whatever reason, this fails: ssh reports a connection error. So, I had to use localhost explicitly.

Trouble The Second: SWANK-REQUIRE

The second, and more irksome issue comes up when I actually succeed at connecting via slime-connect: I immediately drop into the slime debugger. The issue seems to be that SWANK is trying to load some code upon connection. Obviously, it is not going to be able to load code unless that code is present and available on the server.

In order to get the required code into the deployed binary, I do the following prior to executing save-lisp-and-die:


(swank:swank-require 
 '(SWANK-IO-PACKAGE::SWANK-INDENTATION
   SWANK-IO-PACKAGE::SWANK-TRACE-DIALOG
   SWANK-IO-PACKAGE::SWANK-PACKAGE-FU
   SWANK-IO-PACKAGE::SWANK-PRESENTATIONS
   SWANK-IO-PACKAGE::SWANK-MACROSTEP
   SWANK-IO-PACKAGE::SWANK-FUZZY
   SWANK-IO-PACKAGE::SWANK-FANCY-INSPECTOR
   SWANK-IO-PACKAGE::SWANK-C-P-C
   SWANK-IO-PACKAGE::SWANK-ARGLISTS
   SWANK-IO-PACKAGE::SWANK-REPL))

I got the list of required modules directly from the SLIME debugger. I recompiled, redeployed, and ta-dah! It works!

#commonlisp #emacs

WITH-PLIST

#commonlisp

When I'm deserializing JSON, I usually end up with a property list, also called a plist (I pronounce it “Pea List”). But extracting values from plists using getf over and over again gets tedious.

Common Lisp already has with-slots and with-accessors for convenient access to CLOS objects, so why not a with-plist for convenient access to plist values?

What should with-plist do exactly? Let's look at with-slots for guidance.

WITH-SLOTS as a Guide

Observe the following:


;; define a class to test with-slots with 
(defclass abc ()
  ((a :initform 0)
   (b :initform 0)
   (c :initform 0)))

(let ((ob (make-instance 'abc))) 
  ;; bind slots by name or give a local-name to a slot binding
  (with-slots (a (my-b b) (my-c c)) ob 
    (setf a 10     
          my-b 20 
          my-c 30) 
    (format t "a=~a, my-b=~a, my-c=~a~%" 
            a my-b my-c)) 
  (format t "ob's b = ~a~%" (slot-value ob 'b)))

;; the above prints:
;; a=10, my-b=20, my-c=30
;; ob's b = 20

So here you see that with-slots allows the programmer to associate accessors with an object's slots, optionally giving those accessors a name that differs from correpsonding slot's name. Furthermore, when those variables are mutated with setf, the object itself is also mutated. How does with-slots accomplish this?

To find out, lets crack it open with macroexpand and see what's inside:


(macroexpand 
 '(with-slots (a (my-b b) (my-c c)) ob 
   (setf a 10 
    my-b 20 
    my-c 30) 
   (format t "the OB has a=~a, b=~a, c=~a~%" 
    a my-b my-c)))

;; returns

(LET ((#:G252 OB))
  (DECLARE (IGNORABLE #:G252))
  (DECLARE (SB-PCL::%VARIABLE-REBINDING #:G252 OB))
  (SYMBOL-MACROLET ((A (SLOT-VALUE #:G252 'A))
                    (MY-B (SLOT-VALUE #:G252 'B))
                    (MY-C (SLOT-VALUE #:G252 'C)))
    (SETF A 10
          MY-B 20
          MY-C 30)
    (FORMAT T "the OB has a=~a, b=~a, c=~a~%" A MY-B MY-C)))

Ah-hah! It's symbol-macrolet!

The symbol macrolet replaces instances of the symbols a, my-b and my-c with slot access forms within the body of with-slots. We may profit from the same technique in the construction of with-plist.

But first, an hypothetical example of with-plist in use:

Using WITH-PLIST

Consider the following example:


(let ((pl
        (list 'name "Buckaroo Banzai"
              :age 29
              :|currentJob| "Astro-Spy Rocker")))
  (with-plist (name (age :age) (job :|currentJob|)) pl 
    (incf age) 
    (format t "~a the ~a had a birthday and is now ~a years old~%" 
            name job age) 
    pl))
;; prints out
;; Buckaroo Banzai the Astro-Spy Rocker had a birthday and is now 30 years old

;; and returns
;; (NAME "Buckaroo Banzai" :AGE 30 :|currentJob| "Astro-Spy Rocker")

Here you can see that with-plists should be able to access keys of differing types, associate names for those accessors, and update the plist by referencing those names.

If the key is an ordinary symbol (e.g name above), then you can use that symbol itself to name the accessor. Otherwise, if the key is a keyword symbol (e.g. :age and :|currentJob| above), then some kind of local name should be provided.

Otherwise it works just like with-slots.

A Draft of the Macro


(defmacro with-plist (keys plist &body body)
  (let* ((plist-var
           (gensym))
         (macrolet-bindings
           (loop for term in keys
                 when (consp term)  
                   collect (destructuring-bind (var key) term
                             `(,var (getf ,plist-var ',key)))
                 else
                   collect `(,term (getf ,plist-var ',term)))))
    `(let ((,plist-var ,plist))
       (symbol-macrolet ,macrolet-bindings ,@body))))

The macro first determines the names of the symbol-macrolet bindings before binding each one to a getf form that accesses the plist. Thats it!

Where's COND-LET?

I use alexandria's when-let macro more than any other common utility. After that, the next most commonly used export is if-let. It seems to me that there is a natural extension of these two macros to a cond-let. Before getting into it, however, here is an example of if-let in action:

(if-let (x (car some-list))
  (print x)
  (print "the list was empty"))

In the above if-let behaves just like if in the case that (car some-list) is NIL. But in the case that some-list has a car, that value is bound to the variable X, which can then be used.

when-let is just like when, but again, it lets you bind a variable as the result of the tested condition in case you want to use it later.

But where oh where is cond-let? Shouldn't there be one? I have found myself writing a version of cond-let a number of times in the past, usually stashed in my project's utility module. Today we'll explore an implementation that relies on the imperative macro.

But first …

Why COND-LET ?

Because sometimes you want to do something like this:


(cond
  ((cadr xs)
   (let ((x (cadr xs)))
     (do-stuff-with x)))
  ((car xs)
   (let ((x (car xs)))
     (do-stuff-with x)))
  (t
   (do-stuff-with NIL)))

The example, however contrived, illustrates an extension of when-let and if-let to the case of a cond pattern. The concept is that you often want to use the result a predicate's evaluation (here, more like a semipredicate) in the execution of code that is run on condition that predicate returned non-nil.

Seeing COND-LET

Here is a version of cond-let macro that I'm calling imperative-cond-let.


(defun do-list-stuff (xs) 
  (imperative-cond-let 
   ((:= x (cadr xs)) 
    (list :cadr x))
   ((:= x (car xs)) 
    (list :car x)) 
   (t 
    "it's NIL!")))

;; calling do-list-stuff

> (do-list-stuff (list 1 2))
(:CADR 2)

> (do-list-stuff (list 1))
(:CAR 1)

> (do-list-stuff nil)
"it's NIL!"

If you include several variables in those binding forms then the clause will execute in the case that each variable has a non-nil value:

(defun add-first-two (xs) 
  (imperative-cond-let 
    ((:= x (cadr xs) 
         y (car xs))
     (+ x y))
    ((:= x (car xs)) x)
    (t 
     0)))

;; calling add-first-two
> (add-first-two (list 1 2))
3
> (add-first-two (list 1))
1
> (add-first-two (list ))
0

Defining IMPERATIVE-COND-LET


(defmacro imperative-cond-let (&body clauses)
  (let ((imperative-body 
          (loop
            for (bindings . body) in clauses
            for vars = (unless (eq t bindings)
                         (loop for var in (rest bindings) by #'cddr
                               collect var))
            collect bindings
            collect `(when (and ,@vars) 
                       (return (progn ,@body))))))
    `(imperative ,@imperative-body)))

I like this implementation because of its parsimony. For each clause, the variables bound using the convensions of the imperative macro are extracted. They are then check to all be be non-nil via (and ,@vars) and, when they are, the clause body is run and returned. In the case of a clause beginning with t, no variables are collected so that (and) is called, which returns t.

Try it out yourself! Use macroexpand to see what it expands into.

#commonlisp

Getting Imperative

A few weeks ago I was messing around with CLOG when I noticed a peculiar pattern. In several the excellent examples that ship with CLOG, the let* form is used to emulate an imperative style of programming. A good example of this can be found here. The faint putrescence of a code smell wafted up from that example, and, I thought, “Darn it, it should be better. It can be better!”

Isn't Common Lisp a multi-paradigm language? Why shouldn't this imperative pattern be expressed more naturally?

The result of my curiosity is a rough draft of a macro, called imperative.

The IMPERATIVE Macro

The imperative macro allows for the interleaving of binding forms with arbitrary non-binding forms without deep nesting. Here is how it might be used:

(imperative 
  (:= x 10 
      y (+ x 20) 
      z (+ x 100)) 
  (print (list x y z))
  (setf x 100) 
  (print (list :x x))
  (:= x 101) 
  (print (list :x x)) 
  (list x y z))

;; which would print
;; (10 30 110) 
;; (:X 100) 
;; (:X 101) 

;; then return 
;; (101 30 110)

Under the hood, the macro just nests LET* forms. For example, a macroexpand-1 of the above yeilds:

(BLOCK NIL
  (LET* ((X 10) (Y (+ X 20)) (Z (+ X 100)))
    (PRINT (LIST X Y Z))
    (SETF X 100)
    (PRINT (LIST :X X))
    (LET* ((X 101))
      (PRINT (LIST :X X))
      (LIST X Y Z))))

The whole thing is inside of a BLOCK so that you can return early if you wish by calling (return &optional value) anywhere inside.

The macro

It's not perfect, but here's the macro in its current form:


(defmacro imperative (&body body)
   "Evaluate expressins in BODY in sequence. Expressions that look
 like (:= VAR1 EXPR1 ...) will expand into a LET* form whose bindings
 are valid for the rest of the BODY

 E.g.

 (imperative 
   (format t \"Welcome to IMPERATIVE\") 
   (terpri)
   (:= x 10 z (+ x 20))
   (format t \"X = ~a, Z = ~a~%\" x z)
   (:= y (+ z 20))
   (format t \"Y = ~a~%\" y)
   (list x y z))

 would evaluate to:

 Welcome to IMPERATIVE    ;; <-- printed to stdout
 X = 10, Z = 30
 Y = 50

(10 50 30)     ;; <-- return value

IMPERATIVE introduces an implicit, anonymous BLOCK, and hence can be
returned from.
 "
   (labels ((binding-form-p (form)
              (and (consp form)
                   (keywordp (first form))
                   (eql := (first form))))
            (collect-bindings (bindings)
              (loop for (var expr . more) on bindings by #'cddr
                    collect (list var expr)))
            (expander (body)
              (cond
                ((null body) body)
                ((binding-form-p (first body))
                 (list (list* 'let* (collect-bindings (rest (first body)))
                              (expander (rest body)))))
                (t
                 (cons (first body)
                       (expander (rest body)))))))
     `(block () ,@(expander body))))

Good enough as a first draft.

Deodorizing?

A partial re-write of the smelly example is here:


(imperative
  (:= last-tab nil
      t1  (create-button body :content "Tab1")
      t2  (create-button body :content "Tab2")
      t3  (create-button body :content "Tab3"))
  (create-br body)

  (:=  p1  (create-div body)
       p2  (create-div body)
       p3  (create-div body :content "Panel3 - Type here")
       f1  (create-form p1)
       fe1 (create-form-element
            f1 :text
            :label (create-label f1 :content "Fill in blank:")))
  (create-br f1)

  (:= fe2 (create-form-element
           f1 :color
           :value "#ffffff" 
           :label (create-label f1 :content "Pick a color:")))
  (create-br f1)
  (create-form-element f1 :submit :value "OK")
  (create-form-element f1 :reset :value "Start Again")
  ;; .. this is a long one, but you get the idea ...
  )

I can't tell whether or not the deodorizor smells any better.