Michael J. Forster

Compiling lparallel under SBCL 1.0.50

Mon, 08 Apr 2013 21:44:00 -0500

Previously I wrote that lparallel 2.3.2 failed to compile for me under SBCL 1.0.50. James was kind enough to contact me by email to say that he has fixed that. I’m guessing we’ll see that in a future Quicklisp update.

In the near future, I plan to write about my grokking and use of lparallel in a commercial project.

Upgrading SBCL and loading lparallel

Thu, 04 Apr 2013 10:46:00 -0500

lparallel 2.3.2 failed to compile with my SBCL 1.0.50 installation:

CL-USER&gt; (ql:quickload "lparallel")
To load "lparallel":
  Load 1 ASDF system:
    lparallel
; Loading "lparallel"
[package alexandria.0.dev]........................
[package bordeaux-threads]........................
[package lparallel.util]..........................
[package lparallel.thread-util]...................
[package lparallel.raw-queue].....................
[package lparallel.cons-queue]....................
[package lparallel.vector-queue]..................
[package lparallel.queue].........................
[package lparallel.biased-queue]..................
[package lparallel.counter].......................
[package lparallel.spin-queue]....................
[package lparallel.kernel]........................
[package lparallel.kernel-util]...................
[package lparallel.ptree].........................
[package lparallel.promise].......................
[package lparallel.defpun]........................
[package lparallel.cognate].......................
[package lparallel].........

; file: /home/mjf/quicklisp/dists/quicklisp/software/lparallel-20130312-git/src/spin-queue/cas-spin-queue.lisp
; in: DEFUN PUSH-SPIN-QUEUE
;     (LPARALLEL.SPIN-QUEUE::CAS
;      (LPARALLEL.SPIN-QUEUE::NODE-CDR
;       (LPARALLEL.SPIN-QUEUE::SPIN-QUEUE-TAIL LPARALLEL.SPIN-QUEUE::QUEUE))
;      NIL LPARALLEL.SPIN-QUEUE::NEW)
; --&gt; EQ 
; ==&gt;
;   (COMPARE-AND-SWAP
;    (LPARALLEL.SPIN-QUEUE::NODE-CDR
;     (LPARALLEL.SPIN-QUEUE::SPIN-QUEUE-TAIL LPARALLEL.SPIN-QUEUE::QUEUE))
;    NIL LPARALLEL.SPIN-QUEUE::NEW)
; 
; caught ERROR:
;   during macroexpansion of (SB-EXT:COMPARE-AND-SWAP (NODE-CDR #) NIL ...). Use
;   *BREAK-ON-SIGNALS* to intercept:
;   
;    Invalid first argument to COMPARE-AND-SWAP: (NODE-CDR (SPIN-QUEUE-TAIL QUEUE)).
; 
; compilation unit aborted
;   caught 1 fatal ERROR condition
;   caught 1 ERROR condition
; Evaluation aborted on #.

We deploy applications on more recent versions of SBCL, so there was no reason to not upgrade. However, warned by Christophe Rhodes’s post, I chose to avoid version 1.1.6. I downloaded 1.1.5 and tweaked my copy of the Slackbuilds SBCL script to build it.

Following the upgrade, I was able to load lparallel and run its tests successfully.

Kids, Hacking, and Mars Rovers (and Lisp ;-)

Sun, 17 Feb 2013 16:56:00 -0600

Work has kept me from writing about this until now. In late January, I volunteered to run a “Computer Programmers” cluster for thirteen grade seven and eight students at a local early and middle years school. We would meet for an hour six times over five weeks.

On the first day, to keep the focus on programming rather than computers (and to break the ice), we played a game inspired by NASA’s Curiosity rover. After watching short video about rover driver Vandi Verma, students paired up and took turns playing the roles of programmer and rover. The goal, initially, was to program a rover to circumnavigate the rectangular room. Then, programmers tested their rovers on different levels of the terraced octagonal pit in the middle of the room.

A programmer wrote the program on a sheet of paper in the rover language. When handed the paper, the rover began to interpret the program, reading it from top to bottom, following each instruction before going on to the next. Additionally, a rover would listen for its programmer to say “REBOOT”, a powerful command that would terminate the current program and instruct the rover to return to home base.

Rover 1.0

Rover 1.0 had a very limited language:

(STEP)

Rover steps forward, one foot immediately in front of the other.
(TURN-LEFT degrees)

Rover turns left degrees.
(TURN-RIGHT degrees)

Rover turns right degrees.
(REBOOT)

Rover stops whatever it’s doing and returns to home base.

Everyone succeeded in driving her rover around the perimeter of the room:

(STEP)
(STEP)
...
(STEP)
(TURN-RIGHT 90)
(STEP)
(STEP)
...
(STEP)
(TURN-RIGHT 90)
(STEP)
(STEP)
...
(STEP)
(TURN-RIGHT 90)
(STEP)
(STEP)
...
(STEP)

However, navigating the different levels of the pit required a major rewrite, and this was all the more tedious given the limited Rover 1.0 language.

Rover 2.0

We upgraded the rover language, adding three very useful operations:

(SENSE-OBSTACLE)

A test that is true if the rover’s front foot touches an obstacle and false otherwise.
(IF test then-command else-command)

Do the test. If it’s true, do then-command. If it’s not, do else-command.
(REPEAT count commands)

Do the list of commands, in order, then do them again, a total of count times.

With these in hand, most students eliminated the individual step commands for each side of the room:

(REPEAT 40 (STEP))
(TURN-RIGHT 90)
(REPEAT 35 (STEP))
(TURN-RIGHT 90)
(REPEAT 40 (STEP))
(TURN-RIGHT 90)
(REPEAT 35 (STEP))

Some recognised that that pit was a regular octagon and used nested loops:

(REPEAT 8
    (REPEAT 16 (STEP))
    (TURN-RIGHT 45))

Finally, following a little demonstration and Socratic method, a few of them discovered how to handle the room or any of the levels of the pit with a single change:

(REPEAT 40
    (IF (SENSE-OBSTACLE)
         (TURN-RIGHT 45)
         (REPEAT 4 (STEP)))

(REPEAT 32
    (IF (SENSE-OBSTACLE)
         (TURN-RIGHT 45)
         (REPEAT 4 (STEP)))

Lisp?

What has any of this to do with Lisp… besides the parentheses? In this case, it’s about the parentheses: the students neither asked nor complained about them.

L-99: P07 - Flatten a nested list structure

Sun, 09 Dec 2012 21:33:00 -0600

The seventh L-99 problem, MY-FLATTEN, highlights the richness of Common Lisp’s operators on conses.

In Common Lisp, a structure of conses can represent either: a) a list, where the car of each cons points to the element, and the cdr points to the next cons or a terminating atom; or b) a tree, where the car and cdr, both, can point to subtrees of conses or to atoms, the leaves of the tree.

MY-FLATTEN is defined not for trees but for lists, possibly with nested lists as elements. MY-FLATTEN must observe the separate list structures of the list and any nested lists: the first cons of a nested list is not part of the structure of the parent list.

To illustrate, compare the expected behaviour of MY-FLATTEN with a function LEAVES that traverses a tree, collecting the terminal atoms:

(defun leaves (tree)
  (labels ((recur (tree list)
             (if (consp tree)
                 (recur (car tree) (recur (cdr tree) list))
                 (cons tree list))))
    (recur tree '())))

(leaves '(a (b (c . d) nil e) nil . f))
=> (A B C D NIL E NIL NIL F)

(my-flatten '(a (b (c . d) nil e) nil . f))
=> (A B C D NIL E NIL F)

(leaves 'a)
=> A

(my-flatten 'a) ; TYPE-ERROR

When the list literal above is interpreted as a tree, the terminal NILs are revealed; they aren’t by MY-FLATTEN.

Note, in the above example, that MY-FLATTEN is assumed to accept proper or dotted lists and nested lists, and that the resulting “flattened” list will not be dotted in any case.

MY-FLATTEN, then, should work as follows:

(my-flatten 42) ; TYPE-ERROR
(my-flatten '()) => '()
(my-flatten '(a b c d e)) => (A B C D E)
(my-flatten '(a b c d nil e nil)) => (A B C D NIL E NIL)
(my-flatten '(a b c d . e)) => (A B C D E)
(my-flatten '((a) b c d e)) => (A B C D E)
(my-flatten '(a (b) c d e)) => (A B C D E)
(my-flatten '(a b (c) d e)) => (A B C D E)
(my-flatten '(a b c (d) e)) => (A B C D E)
(my-flatten '(a b c d (e))) => (A B C D E)
(my-flatten '(a b (c) d . e)) => (A B C D E)
(my-flatten '(a b c (d) . e)) => (A B C D E)
(my-flatten '(a b c (d . e))) => (A B C D E)
(my-flatten '(a (b (c d) e))) => (A B C D E)
(my-flatten '(a (b (c d) . e))) => (A B C D E)
(my-flatten '(a (b (c . d) e))) => (A B C D E)
(my-flatten '(a (b (c . d) nil e) nil)) => (A B C D NIL E NIL)

Compared to LEAVES, the definition of MY-FLATTEN is complicated by handling nested list structures and dotted lists.

The following skeleton identifies the cases for traversing a proper or dotted list structure and letting REST blame MY-FLATTEN if the argument, list, is not a list (FIRST and REST are used instead of CAR and CDR to emphasise the traversal of lists rather than trees):

(defun my-flatten (list)
  (labels ((recur (list new-list)
             (cond ((consp (rest list))
                    ;; follow list structure
                    ... list ... new-list ...)

                   ((not (null (rest list)))
                    ;; last cons of dotted list
                    ... list ... new-list ...)

                   ((consp list)
                    ;; last cons of proper list
                    ... list ... new-list ...)

                   (t
                    ;; terminating NIL of proper list
                    new-list))))
    (nreverse (recur list '()))))

In each of the first three cases, before proceeding, MY-FLATTEN must flatten a nested list if one exists:

(defun my-flatten (list)
  (labels ((recur (list new-list)
             (cond ((consp (rest list))
                    (if (consp (first list))
                        ;; flatten nested list, then follow list
                        ;; structure
                        ... list ... new-list ...
                        ;; follow list structure
                        ... list ... new-list ...))

                   ((not (null (rest list)))
                    (if (consp (first list))
                        ;; flatten nested list, then last cons of
                        ;; dotted list
                        ... list ... new-list ...
                        ;; last cons of dotted list
                        ... list ... new-list ...))

                   ((consp list)
                    (if (consp (first list))
                        ;; flatten nested list, then last cons of
                        ;; proper list
                        ... list ... new-list ...
                        ;; last cons of proper list
                        ... list ... new-list ...))

                   (t
                    new-list))))
    (nreverse (recur list '()))))

Finally, then:

(defun my-flatten (list)
  (labels ((recur (list new-list)
             (cond ((consp (rest list))
                    (if (consp (first list))
                        (recur (rest list)
                               (recur (first list) new-list))
                        (recur (rest list)
                               (cons (first list) new-list))))
                   ((not (null (rest list)))
                    (if (consp (first list))
                        (cons (rest list)
                              (recur (first list) new-list))
                        (cons (rest list)
                              (cons (first list) new-list))))
                   ((consp list)
                    (if (consp (first list))
                        (recur (first list) new-list)
                        (cons (first list) new-list)))
                   (t
                    new-list))))
    (nreverse (recur list '()))))

MY-FLATTEN should exhibit time and space complexities, both, of O(n^m), where “n” is the length of a list, top level or nested, and “m” is the depth of nesting. The run times (non-GC) and consed bytes of the following rough benchmarks suggest as much:

(defun benchmark (function data count)
  (let ((result))
    (cl-user::gc :all t)
    (time (dotimes (i count) (setf result (funcall function data))))))

CL-USER> (compile 'my-flatten)
=> MY-FLATTEN

CL-USER> (dolist (n '(100 1000 10000))
           (benchmark #'my-flatten (loop for i below n collect i) 1000))
Evaluation took:
  0.002 seconds of real time
  0.001000 seconds of total run time (0.001000 user, 0.000000 system)
  50.00% CPU
  3,252,278 processor cycles
  798,720 bytes consed

Evaluation took:
  0.013 seconds of real time
  0.012998 seconds of total run time (0.012998 user, 0.000000 system)
  100.00% CPU
  25,410,202 processor cycles
  7,999,488 bytes consed

Evaluation took:
  0.164 seconds of real time
  0.164975 seconds of total run time (0.160976 user, 0.003999 system)
  [ Run times consist of 0.030 seconds GC time, and 0.135 seconds non-GC time. ]
  100.61% CPU
  327,087,555 processor cycles
  80,010,016 bytes consed

=> NIL

CL-USER> (progn
          (benchmark #'my-flatten
                     (loop for i below 100 collect i)
                     1000)
          (benchmark #'my-flatten
                     (loop for i below 100 collect
                           (loop for j below 100 collect j))
                     1000)
          (benchmark #'my-flatten
                     (loop for i below 100 collect
                           (loop for j below 100 collect
                                 (loop for k below 100 collect k)))
                     1000))
Evaluation took:
  0.002 seconds of real time
  0.001999 seconds of total run time (0.001999 user, 0.000000 system)
  100.00% CPU
  3,193,193 processor cycles
  798,720 bytes consed

Evaluation took:
  0.163 seconds of real time
  0.164975 seconds of total run time (0.152977 user, 0.011998 system)
  [ Run times consist of 0.031 seconds GC time, and 0.134 seconds non-GC time. ]
  101.23% CPU
  326,155,035 processor cycles
  80,006,376 bytes consed

Evaluation took:
  74.040 seconds of real time
  74.008748 seconds of total run time (66.343914 user, 7.664834 system)
  [ Run times consist of 58.111 seconds GC time, and 15.898 seconds non-GC time. ]
  99.96% CPU
  147,707,388,885 processor cycles
  8,000,104,416 bytes consed

=> NIL

Rewriting MY-FLATTEN using tail recursive calls would not reduce the order of growth in space required to construct the resulting list; the list must be built regardless. Doing so, however, would, in most Common Lisp implementations, prevent exhaustion of the call stack.

The L-99 solution is simpler than MY-FLATTEN, but it doesn’t solve the same problem: it fails on dotted lists and discards elements that are NIL.

Pascal J. Bourguignon provides four alternative solutions. Of the three recursive implementations only that with the worst performance works on dotted lists. The iterative one, referred to here as PJB-FLATTEN-3, avoids stack exhaustion and works on dotted lists. However, the behaviour of PJB-FLATTEN-3 belies its intent.

While the source and comment for PJB-FLATTEN-3 name its parameter “tree”, it certainly doesn’t collect the leaves of a Common Lisp tree:

CL-USER> (PB-FLATTEN-3 'NIL)
=> NIL ; Expected (NIL)

CL-USER> (PB-FLATTEN-3 '(A B C D E))
=> (A B C D E) ; Expected (A B C D E NIL)

CL-USER> (PB-FLATTEN-3 '(A (B (C . D) NIL E) NIL))
=> (A B C D E) ; Expected (A B C D NIL E NIL NIL NIL)

Building an Application with the Closure Library... and Lisp!

Thu, 04 Oct 2012 14:33:00 -0500

Using the project directory and Hunchentoot infrastructure I created previously, I will use Common Lisp to write the notepad application described in Google’s Building an Application with the Closure Library.

The Google tutorial illustrates the Closure namespace mechanism, DOM construction, and use of a Closure Library class. I’m interested in the first two features, in particular.

A First Pass

I start by creating and editing a notepad.lisp file to define Hunchentoot easy handlers corresponding to the notepad.html and notepad.js from the tutorial:

(hunchentoot:define-easy-handler (notepad-js :uri "/notepad.js") ()
  (setf (hunchentoot:content-type*) "text/javascript")
  (ps:ps
    (ps:chain goog (provide "tutorial.notepad"))

    (ps:chain goog (require "goog.dom"))
    (ps:chain goog (require "goog.ui.Zippy"))

    (setf (ps:@ tutorial notepad append-notes)
          (lambda (data note-container)
            (dolist (datum data)
              (ps:chain goog dom
                        (append-child note-container
                                      (ps:chain tutorial notepad
                                                (make-note-dom datum)))))))

    (setf (ps:@ tutorial notepad make-note-dom)
          (lambda (note-datum)
            (let ((header-element
                   (ps:chain goog dom
                             (create-dom "div"
                                         (ps:create :style "background-color:#EEE")
                                         (ps:@ note-datum :title))))
                  (content-element
                   (ps:chain goog dom
                             (create-dom "div"
                                         nil
                                         (ps:@ note-datum :content)))))
              (ps:new (ps:chain goog ui (-Zippy header-element content-element)))
              (ps:chain goog dom
                        (create-dom "div"
                                    nil
                                    header-element
                                    content-element)))))))

(hunchentoot:define-easy-handler (notepad-html :uri "/notepad.html") ()
  (cl-who:with-html-output-to-string (*standard-output* nil :prologue t)
    (:html
     (:head
      (:title "Notepad")
      (:script :src "/js/goog/base.js")
      (:script :src "/notepad.js"))
     (:body
      (:div :id "notes")
      (:script
        (cl-who:str
         (ps:ps
           (defun main ()
             (let ((note-data
                    (list (ps:create :title "Note 1"
                                     :content "Content of Note 1")
                          (ps:create :title "Note 2"
                                     :content "Content of Note 2")))
                   (note-list-element
                    (ps:chain goog dom (get-element "notes"))))
               (ps:chain tutorial notepad
                         (append-notes note-data
                                       note-list-element))))
           (main))))))))

Next, I add notepad.lisp to the components list of the system definition in grok-google-closure-lisp.asd. Then, I stop the Hunchentoot acceptor, reload the project, and start the Hunchentoot acceptor:

GROK-GOOGLE-CLOSURE-LISP> (stop)
GROK-GOOGLE-CLOSURE-LISP> (ql:quickload "grok-google-closure-lisp")
...
=> ("grok-google-closure-lisp")
GROK-GOOGLE-CLOSURE-LISP> (start)

Now, I can browse the application URL http://localhost:4242/notepad.html.

I want to note that I did not translate the tutorial’s Javascript to Parenscript directly. That was deliberate.

The debate over the pros and cons (even the definition) of OOP rages elsewhere, but, here, I am concerned only with the simplicity, directness, and clarity of the program. I think the tutorial is less simple, direct, and clear than it could be.

To begin with, the definition of main() represents note data simply enough. However, the call to makeNotes() doesn’t just make notes (it doesn’t even make notes, it makes DOM nodes), it also, ultimately, appends them to the parent DOM.

Of course, makeNotes() doesn’t append the nodes itself: the makeNoteDom() method of the Note object does that, after it constructs the node from its internal data, and using a reference to the parent DOM included in the data for each note!

Why do makeNotes() and makeNoteDom() make DOM nodes and have the side effect of changing the parent DOM? Why does the Note object have and use a reference to the parent DOM?

One more annoyance (a smaller one): Why does makeNotes() build and return an unused array of the constructed nodes?

This, as Rich Hickey might say, is complected.

Thus, I represent and access the data as a list of property lists (which Parenscript will translate to an array of Javascript objects) and eliminate the Note constructor, I use MAKE-NOTE-DOM only to construct a DOM node from a note and eliminate the note field referencing the parent DOM, and I have APPEND-NOTES append the constructed nodes to the parent DOM.

I also want to draw attention to the definitions of APPEND-NOTES and MAKE-NOTE-DOM. To work with Closure’s namespace convention I use goog.provide() and, rather than DEFUNing the functions, I assign anonymous functions to those property names in the namespace object:

(ps:chain goog (provide "tutorial.notepad"))
...

(setf (ps:@ tutorial notepad append-notes)
      (lambda (data note-container)
        ...))

(setf (ps:@ tutorial notepad make-note-dom)
      (lambda (note-datum)
        ...))

Then, of course, rather than calling the functions directly, I must use Parenscript’s CHAIN to access the property in the namespace:

(ps:chain tutorial notepad
          (append-notes note-data
                        note-list-element))

I would like to suppress these details of defining functions in a Closure-like namespace.

Parenscript Namespaces

Parenscript offers a mechanism to prefix Javascript names when translating symbols in a Lisp package. Using that, I can rewrite the function definitions, storing them in a tutorial-notepad.paren file:

(in-package "TUTORIAL.NOTEPAD")

(ps:chain goog (require "goog.dom"))
(ps:chain goog (require "goog.ui.Zippy"))

(defun tutorial.notepad::append-notes (data note-container)
  (dolist (datum data)
    (ps:chain goog dom
              (append-child note-container
                            (ps:chain tutorial
                                      notepad
                                      (make-note-dom datum))))))

(defun tutorial.notepad::make-note-dom (note-datum)
  (let ((header-element
         (ps:chain goog dom
                   (create-dom "div"
                               (ps:create :style "background-color:#EEE")
                               (ps:@ note-datum :title))))
        (content-element
         (ps:chain goog dom
                   (create-dom "div"
                               nil
                               (ps:@ note-datum :content)))))
    (ps:new (ps:chain goog ui (-Zippy header-element content-element)))
    (ps:chain goog dom
              (create-dom "div"
                          nil
                          header-element
                          content-element))))

Then, I can define a Lisp package, set the Parenscript prefix, and compile the tutoral-notepad.paren file:

(defpackage #:tutorial.notepad
  (:use #:cl))
(in-package #:tutorial.notepad)
(setf (ps:ps-package-prefix "TUTORIAL.NOTEPAD")
      "tutorial.notepad.")
(ps:ps-compile-file "/tmp/tutorial-notepad.paren")
=> ...

However, that won’t work. It doesn’t provide the Closure namespace. It prefixes all symbols in the package, including those from external Javascript libraries, generating

tutorial.notepad.goog.require('goog.dom');
tutorial.notepad.goog.require('goog.ui.Zippy');

instead of

goog.require('goog.dom');
goog.require('goog.ui.Zippy');

Finally, it defines a Javascript function with a prefixed name rather than assigning an anonymous function to the property in the namespace, generating

function tutorial.notepad.appendNotes(tutorial.notepad.data,
                                      tutorial.notepad.noteContainer) {
    for (var tutorial.notepad.datum = null, _js_idx4 = 0;
         _js_idx4 < tutorial.notepad.data.length;
         _js_idx4 += 1) {
        tutorial.notepad.datum = tutorial.notepad.data[_js_idx4];
        tutorial.notepad.goog.tutorial.notepad.dom.tutorial.notepad.appendChild(tutorial.notepad.noteContainer,
            tutorial.notepad.tutorial.tutorial.notepad.notepad.tutorial.notepad.makeNoteDom(tutorial.notepad.datum));
    };
};

instead of

tutorial.notepad.appendNotes = function (data, noteContainer) {
    for (var datum = null, _js_idx101 = 0;
          _js_idx101 < data.length;
         _js_idx101 += 1) {
        datum = data[_js_idx101];
        goog.dom.appendChild(noteContainer, tutorial.notepad.makeNoteDom(datum));
    };
};

A Simple Solution to a Simple Problem

Tempting as it is to consider patching Parenscript to address the above issues, it’s important to remember that Parenscript trades complete translation of Common Lisp for a reduction in Javascript runtime overhead.

Following Parenscript’s lead (and, indeed, that of Common Lisp’s DEFUN), I can write a Parenscript macro (using DEFPSMACRO) that simply hides the details of building a function and assigning it to a name in the namespace:

(ps:defpsmacro defun-in-namespace (namespace-list lambda-list &body body)
  "Defines a new function with the fully qualified Google
namespace /namespace-list/.  Assumes the namespace has been
defined via goog.provide()."
  `(setf (ps:@ ,@namespace-list)
         (lambda (,@lambda-list)
           ,@body)))

Then, I can define the functions in the NOTEPAD-JS handler as follows:

(defun-in-namespace (tutorial notepad append-notes) (data note-container)
  (dolist (datum data)
    (ps:chain goog dom
              (append-child note-container
                            (ps:chain tutorial notepad
                                      (make-note-dom datum))))))

(defun-in-namespace (tutorial notepad make-note-dom) (note-datum)
  (let ((header-element
         (ps:chain goog dom
                   (create-dom "div"
                               (ps:create :style "background-color:#EEE")
                               (ps:@ note-datum :title))))
        (content-element
         (ps:chain goog dom
                   (create-dom "div"
                               nil
                               (ps:@ note-datum :content)))))
    (ps:new (ps:chain goog ui (-Zippy header-element content-element)))
    (ps:chain goog dom
              (create-dom "div"
                          nil
                          header-element
                          content-element))))

ASDF Mismagic

Fri, 21 Sep 2012 07:08:00 -0500

Late last night, while reading Evolving ASDF: More Cooperation, Less Coordination, ASDF:SYSTEM-RELATIVE-PATHNAME caught my eye. Handy piece of magic, that, I thought as I pondered the hardwired pathname variables littering specials.lisp files on my drives.

Or not. Fortunately, I had seen Zach Beane’s post on Resource access and ASDF earlier that day, and I agree: ASDF should not serve as a utility library.

So, I begin this morning with a little mundane editing, the following lifted shamelessly from Zach’s post:

(defpackage #:app-config (:export #:*base-directory*))
(defparameter app-config:*base-directory*
  (make-pathname :name nil :type nil :defaults *load-truename*))

Getting Started with Google Closure... and Lisp!

Thu, 20 Sep 2012 10:15:00 -0500

At Shared Logic, we use Google’s Closure Tools and Common Lisp to write and deploy rich web applications. In this article I demonstrate our approach by writing the Hello, World! described in Google’s Getting Started with the Closure Library.

First, I create a project directory and download the Closure Library:

mkdir -p ~/src/mjf/grok-google-closure-lisp/closure
cd ~/src/mjf/grok-google-closure-lisp/closure

svn checkout http://closure-library.googlecode.com/svn/trunk/ \
    closure-library

By convention and regardless of web server infrastructure, we serve static resources from a www sub-directory tree. Here, I link in the Javascript root of the Closure Library:

mkdir -p ~/src/mjf/grok-google-closure-lisp/www/js
cd ~/src/mjf/grok-google-closure-lisp/www/js
ln -s ../../closure/closure-library/closure/goog .

Second, I create a Lisp project using Zach Beane’s Quicklisp and Quickproject. I will use Hunchentoot to serve the application, CL-WHO to generate the HTML, and Parenscript to generate the Javascript:

CL-USER> (ql:quickload "quickproject")
...
=> ("quickproject")

CL-USER> (quickproject:make-project
          "~/src/mjf/grok-google-closure-lisp/"
          :depends-on '(hunchentoot cl-who
          parenscript))
=> "grok-google-closure-lisp"

CL-USER> (ql:quickload "grok-google-closure-lisp")
...
=> ("grok-google-closure-lisp")

CL-USER> (in-package #:grok-google-closure-lisp)
=> #<PACKAGE "GROK-GOOGLE-CLOSURE-LISP">

Third, I edit the grok-google-closure-lisp.lisp file to tweak some Hunchentoot settings and define variables and utility functions to manage the Hunchentoot acceptor and the dispatch table. I add a folder dispatcher to Hunchentoot’s DISPATCH-TABLE to serve static Javascript files:

;;;; grok-google-closure-lisp.lisp

(in-package #:grok-google-closure-lisp)

;;; "grok-google-closure-lisp" goes here. Hacks and glory await!

(setf hunchentoot:*catch-errors-p* nil) ; T for production
(setf hunchentoot:*show-lisp-errors-p* t)
(setf hunchentoot:*show-lisp-backtraces-p* t)

(defparameter *project-pathname*
  (merge-pathnames "src/mjf/grok-google-closure-lisp/"
                   (user-homedir-pathname)))

(defparameter *http-port* 4242)

(defvar *my-acceptor* nil)

(defun start ()
  (unless *my-acceptor*
    (push (hunchentoot:create-folder-dispatcher-and-handler
           "/js/"
          (merge-pathnames "www/js/"
                           *project-pathname*))
      hunchentoot:*dispatch-table*)
    (setf *my-acceptor*
          (hunchentoot:start (make-instance
                              'hunchentoot:easy-acceptor
                              :port *http-port*)))))

(defun stop ()
  (when *my-acceptor*
    (hunchentoot:stop *my-acceptor*)
    (setf hunchentoot:*dispatch-table*
          (last hunchentoot:*dispatch-table*))
    (setf *my-acceptor* nil)))

Fourth, I create and edit a hello.lisp file to define Hunchentoot easy handlers corresponding to the hello.js and hello.html from the Google example. I modify the script URLs according to our convention:

;;;; hello.lisp

(in-package #:grok-google-closure-lisp)

(hunchentoot:define-easy-handler (hello-js :uri "/hello.js") ()
  (setf (hunchentoot:content-type*) "text/javascript")
  (ps:ps
    (ps:chain goog (require "goog.dom"))

    (defun say-hi ()
      (let ((new-header
             (ps:chain goog dom
                       (create-dom "h1"
                                   (ps:create
                                    :style "background-color:")
                                    "Hello world!"))))
        (ps:chain goog dom
                  (append-child (ps:@ document body)
                                new-header))))))

(hunchentoot:define-easy-handler (hello :uri "/hello") ()
  (cl-who:with-html-output-to-string (*standard-output* nil :prologue t)
    (:html
     (:head
      (:script :src "/js/goog/base.js")
      (:script :src "/hello.js"))
     (:body :onload (ps:ps-inline (say-hi))))))

Fifth, I add hello.lisp to the components list of the system definition in grok-google-closure-lisp.asd, reload the project, and start the Hunchentoot acceptor:

GROK-GOOGLE-CLOSURE-LISP> (ql:quickload "grok-google-closure-lisp")
...
=> ("grok-google-closure-lisp")

GROK-GOOGLE-CLOSURE-LISP> (start)

Finally, I can browse the application URL http://localhost:4242/hello.

Yes, the Parenscript definition is a few lines longer than hello.js, and, yes, I could shorten it with Lisp macros. However, I have a better plan.

The Closure API, too, is more verbose than that of JQuery, Prototype, YUI, and other Javascript libraries. However, the latter are libraries only, and their use of terse naming conventions and minifiers to control code growth and its impact on performance is limited. The Closure Library is intended for use with the Closure Compiler, which provides greater optimisation than minification alone, including dead code elimination.

As Google does with it’s compiler, I will trade some terseness now for much greater gain later using Lisp’s magic in creating embedded domain specific languages. More to come.

L-99: P06 - Find out whether a list is a palindrome

Sun, 16 Sep 2012 11:05:00 -0500

The sixth L-99 problem is to write a predicate that detects a list that is a palindrome: a sequence that can be read the same way forward or backward.

The simplest (and an efficient) solution is right there in the definition of a palindrome, but it’s easy to “follow your nose” through the construction of palindromes and end up writing something more complicated. The real lesson of the sixth L-99 problem is less about lists and more about “forests” and “trees”.

The problem description immediately restricts us to a list representation, and, although it isn’t specified, I’ll assume the list must be proper. LIST-PALINDROME-P should work as follows:

(list-palindrome-p 42) ; TYPE-ERROR: 42
(list-palindrome-p '(a b c d . e)) ; TYPE-ERROR: E
(list-palindrome-p '()) => T
(list-palindrome-p '(a b b a)) => T
(list-palindrome-p '(a b c b a)) => T
(list-palindrome-p '(a b c b a b)) => NIL

First, I’ll write a utility function to construct palindrome lists:

(defparameter *alphabet* "abcdefghijklmnopqrstuvwxyz")

(defparameter *alphabet-length* 26)

(defun random-character ()
  (elt *alphabet*
       (random *alphabet-length*)))

(defun make-palindrome (length)
  (let ((l '()))
    (multiple-value-bind (quotient remainder)
        (floor length 2)
      (dotimes (i quotient)
        (push (random-character) l))
      (let ((middle (if (plusp remainder)
                        (list (random-character))
                        '())))
        (append l middle (reverse l))))))

CL-USER> (make-palindrome 11)
=> (#\y #\i #\z #\d #\j #\y #\j #\d #\z #\i #\y)

While scratching that out, I was thinking about a point in the Wikipedia article on palindromes:

In addition, the set of palindromes may not be reliably tested by a deterministic pushdown automaton and is not LR(k)-parsable. When reading a palindrome from left-to-right, it is, in essence, impossible to locate the “middle” until the entire word has been read completely.

The middle… right! If I can find the middle of the list, I can traverse the list from both ends at once, comparing corresponding elements. If a pair of elements differs, the list is not a palindrome; otherwise, when the pointers meet or pass, I have a palindrome. Easy enough to write:

(defun list-palindrome-p (list)
  (do ((i 0 (1+ i))
       (j (1- (length list)) (1- j)))
      ((or (= i j) (< j i)) t)
    (unless (equal (nth i list)
                   (nth j list))
      (return nil))))

That will run in O(1) space and O(n^2) time. To measure the performance gain, if any, of the list-specific accessor NTH, I wrote a version using the more general ELT sequence accessor:

(defun seq-palindrome-p (seq)
  (do ((i 0 (1+ i))
       (j (1- (length seq)) (1- j)))
      ((or (= i j) (< j i)) t)
    (unless (equal (elt seq i)
                   (elt seq j))
      (return nil))))

To measure the performance hit of list element access, O(n) on average, I wrote a vector-based version using the SVREF vector accessor:

(defun vector-palindrome-p (vector)
  (do ((i 0 (1+ i))
       (j (1- (length vector)) (1- j)))
      ((or (= i j) (< j i)) t)
    (unless (equal (svref vector i)
                   (svref vector j))
      (return nil))))

Here are some benchmarks under SBCL 1.0.50 on my machine:

CL-USER> (compile 'list-palindrome-p)
=> LIST-PALINDROME-P

CL-USER> (compile 'seq-palindrome-p)
=> SEQ-PALINDROME-P

CL-USER> (compile 'vector-palindrome-p)
=> VECTOR-PALINDROME-P

CL-USER> (defparameter *palindrome* (make-palindrome 100001))
=> ...

CL-USER> (defparameter *vpalindrome* (coerce *palindrome* 'vector))
=> *VPALINDROME*

CL-USER> (defparameter *result* nil)
=> *RESULT*

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000 (setf *result* (list-palindrome-p *palindrome*)))))
Evaluation took:
  9.641 seconds of real time
  10.133459 seconds of total run time (10.133459 user, 0.000000 system)
  105.10% CPU
  19,234,325,700 processor cycles
  66,096 bytes consed
=> T

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000 (setf *result* (seq-palindrome-p *palindrome*)))))
Evaluation took:
  38.109 seconds of real time
  39.323022 seconds of total run time (39.323022 user, 0.000000 system)
  103.19% CPU
  76,026,725,220 processor cycles
  254,312 bytes consed
=> T

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000 (setf *result* (vector-palindrome-p *vpalindrome*)))))
Evaluation took:
  0.002 seconds of real time
  0.002000 seconds of total run time (0.002000 user, 0.000000 system)
  100.00% CPU
  3,609,922 processor cycles
  0 bytes consed
=> T

The list-specific accessor NTH is faster and conses less than ELT. Unsurprisingly, where repeated arbitrary element access is required, a vector is the better choice. VECTOR-PALINDROME-P runs in O(n) time and O(1) space.

However, I can write a list-based solution that is simpler and faster than LIST-PALINDROME-P. It trades space (O(n)) for speed (O(n)). As I noted above, a palindrome is a sequence that reads the same forward or backward:

(defun simple-list-palindrome-p (list)
  (equal list (reverse list)))

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000 (setf *result* (simple-list-palindrome-p *palindrome*)))))
Evaluation took:
  0.002 seconds of real time
  0.002000 seconds of total run time (0.002000 user, 0.000000 system)
  100.00% CPU
  4,399,568 processor cycles
  802,816 bytes consed

#l-99

L-99: P05 - Reverse a list

Sun, 17 Jun 2012 15:07:00 -0500

CL’s REVERSE returns a new sequence of elements in reverse order from the given sequence. The given sequence must be proper, either a proper list or vector, and REVERSE should be prepared to signal a TYPE-ERROR otherwise.

L-99’s REVERSE-A-LIST is a list-only version of REVERSE and should work as follows:

(reverse-a-list 42) ; TYPE-ERROR: 42
(reverse-a-list '(a b c d . e)) ; TYPE-ERROR: E
(reverse-a-list '()) => NIL
(reverse-a-list '(a b c d e)) => (E D C B A)
(reverse-a-list '(a (b c) d e)) => (E D (B C) A)

Constructing the reverse of a list can be simple and efficient if you realise that it occurs in the direction (tail to head) opposing the traversal of the original list (head to tail). Recursion juxtaposes these two operations elegantly:

(defun reverse-a-list (list)
  (labels ((recur (list1 reversed)
             (if (null list1)
                 reversed
                 (recur (cdr list1)
                        (cons (car list1) reversed)))))
    (recur list '())))

However, an imperative solution needn’t be inelegant thanks to CL’s DOLIST:

(defun reverse-a-list-1 (list)
  (let ((reversed '()))
    (dolist (x list reversed)
      (push x reversed))))

Here are some benchmarks under SBCL 1.0.50 on my machine:

CL-USER> (compile 'reverse-a-list)
=> REVERSE-A-LIST

CL-USER> (compile 'reverse-a-list-1)
=> REVERSE-A-LIST-1

CL-USER> (defvar *list* (loop for i below 1000000 collect i))
=> ...

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000) (setf *list2* (reverse *list*))))
Evaluation took:
  68.795 seconds of real time
  68.730550 seconds of total run time (62.520495 user, 6.210055 system)
  [ Run times consist of 59.584 seconds GC time, and 9.147 seconds non-GC time. ]
  99.91% CPU
  137,244,569,535 processor cycles
  8,000,125,152 bytes consed
=> NIL

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000) (setf *list2* (reverse-a-list *list*))))
Evaluation took:
  69.083 seconds of real time
  69.000510 seconds of total run time (62.492499 user, 6.508011 system)
  [ Run times consist of 59.851 seconds GC time, and 9.150 seconds non-GC time. ]
  99.88% CPU
  137,819,915,692 processor cycles
  8,000,128,320 bytes consed
=> NIL

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000) (setf *list2* (reverse-a-list-2 *list*))))
Evaluation took:
  68.533 seconds of real time
  68.494587 seconds of total run time (62.094560 user, 6.400027 system)
  [ Run times consist of 59.382 seconds GC time, and 9.113 seconds non-GC time. ]
  99.94% CPU
  136,721,884,103 processor cycles
  8,000,122,856 bytes consed
=> NIL

Dead Code is Fast Code

Sun, 17 Jun 2012 08:53:00 -0500

I use the TIME macro to benchmark my L-99 solutions, as the ANSI CL Specification advises, not “for marketing comparisons” but “for tuning purposes.” I want to know how well a solution that I optimise for simplicity fares against others, especially a standard CL function.

Still, for my purposes, I could improve my methodology. I should run the benchmarks on both of the CL implementations that I use for work, SBCL and LispWorks. I should invoke the garbage collector before each run to reduce the impact of previous runs. And, as I just discovered, I shouldn’t benchmark dead code, because dead code is deceptively quick!

Consider the following, run under SBCL 1.0.50 on my machine:

CL-USER> (defvar *list* (loop for i below 1000000 collect i))
=> ...

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000) (last *list*)))
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  6,052 processor cycles
  0 bytes consed
=> NIL

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000) (reverse *list*)))
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  14,783 processor cycles
  0 bytes consed
=> NIL

I didn’t expect LAST to take very long or cons much, but REVERSE should have ticked and consed a detectable amount since it returns a fresh list. If I introduce a O(1) side effect into the loop, then I get different results:

CL-USER> (gc :all t)
=> NIL

CL-USER> (time (dotimes (i 1000) (setf *list2* (last *list*))))
Evaluation took:
  2.430 seconds of real time
  2.429630 seconds of total run time (2.427631 user, 0.001999 system)
  100.00% CPU
  4,847,069,902 processor cycles
  13,008 bytes consed
=> NIL

CL-USER> (time (dotimes (i 1000) (setf *list2* (reverse *list*))))
Evaluation took:
  68.795 seconds of real time
  68.730550 seconds of total run time (62.520495 user, 6.210055 system)
  [ Run times consist of 59.584 seconds GC time, and 9.147 seconds non-GC time. ]
  99.91% CPU
  137,244,569,535 processor cycles
  8,000,125,152 bytes consed
=> NIL

It seems that SBCL eliminates dead code evaluated in the REPL. LispWorks 6.0.1 on my machine does not appear to do so:

CL-USER 10 > (defvar *list* (loop for i below 1000000 collect i))
=> ...

CL-USER 11 > (gc-if-needed)
=> NIL

CL-USER 12 > (time (dotimes (i 1000) (last *list*)))
Timing the evaluation of (DOTIMES (I 1000) (LAST *LIST*))

User time    =        2.957
System time  =        0.002
Elapsed time =        2.944
Allocation   = 46864 bytes
0 Page faults
Calls to %EVAL    15056
NIL

CL-USER 13 > (gc-if-needed)
=> NIL

CL-USER 14 > (time (dotimes (i 1000) (reverse *list*)))
Timing the evaluation of (DOTIMES (I 1000) (REVERSE *LIST*))

User time    =       29.313
System time  =        0.054
Elapsed time =       29.398
Allocation   = 18446744072824721376 bytes
0 Page faults
Calls to %EVAL    15056
NIL

Indeed, introducing the same side effect as before does not change the results appreciably:

CL-USER 15 > (gc-if-needed)
=> NIL

CL-USER 16 > (time (dotimes (i 1000) (setf *list2* (last *list*))))
Timing the evaluation of (DOTIMES (I 1000) (SETF *LIST2* (LAST *LIST*)))

User time    =        2.981
System time  =        0.002
Elapsed time =        2.963
Allocation   = 1411712 bytes
0 Page faults
Calls to %EVAL    19056
NIL

CL-USER 17 > (gc-if-needed)
=> NIL

CL-USER 18 > (time (dotimes (i 1000) (setf *list2* (reverse *list*))))
Timing the evaluation of (DOTIMES (I 1000) (SETF *LIST2* (REVERSE *LIST*)))

User time    =       38.678
System time  =        0.012
Elapsed time =       38.682
Allocation   = 18446744072826093508 bytes
0 Page faults
Calls to %EVAL    19056
NIL

I will be sure to include this simple side effect in future L-99 benchmarks.