Announcing Mudballs

 This post is to announce the release of Mudballs, a collection of Common Lisp code for managing systems.  It is currently in an early stage of development and still has a long way to go but is currently able to compile,  load, document, download and install systems across Windows, Linux and Mac OSX. Mudballs supports the following implementations 

• Lispworks on Mac OSX, Linux and Windows.
  
• SBCL on Mac OSX and Linux.
• CMUCL on Mac OSX and Linux.
• CLISP on Linux and Windows (Mac OSX as well provided  you have FFI).
• ClozureCL/OpenMCL on Mac OSX, Linux and Windows.
• AllegroCL on Mac OSX, Linux and Windows.

 

 As it currently stands it is not ASDF compatible (not ideal, I know) but ASDF support is planned for the future. It is available from http://mudballs.com  which contains enough information to get the intrepid lisper on his or  her way.

 

 As a small taste, the following is now possible from a freshly installed Lisp with Mudballs loaded.

> (mb:install :hunchentoot)
> (hunchentoot:start-server :port 8080)

P.S.  Prizes for anyone that can come up with a logo which doesn't look like a pile of excrement.

Lisp in Lisp

One of the fantastic things about Common Lisp is discovering how you can write parts of the language in the language itself and I'm not talking about implementing number parsing or some library function but rather a languages control structures. A nice and relatively simple one, is implementing handler-case[1] in portable Common Lisp[2].

(defvar *handlers* () "Alist of condition name to handler")
(defvar *old-handlers* () "Var to save the bindings of *handlers*")

(defclass root-error () 
  ((message :initarg :message :accessor message-of :initform "Unknown"))
  (:documentation "Our base error class."))

(defun raise (class text)
  "signals an error of class CLASS with message TEXT."
  (let ((handler (get-handler class)))
    (if handler
        (invoke-handler handler (make-instance class :message text))
        ;; This is our 'we crash now'
        (error text))))

;; We implement our handlers as functions.
(defun invoke-handler (handler class)
  (funcall handler class))

(defun get-handler (class)
  "Finds the first handler on *handlers* which is registered with a class
which CLASS is a subtype of."
  (cdr (find-if (lambda (handler) (subtypep class handler))
                *handlers* :key 'car)))

(defun add-handlers (&rest handlers)
  "Takes a list of (class . handler) forms and creates a new
list which can be used as *handlers*"
  (append handlers *handlers*))

;;; And all that is left now is to implement trycatch

(defmacro trycatch (form &body error-bindings)
  (let* ((block (gensym "BLOCK"))
         ;; turns each handler into a list of (tmpvar classname handler-fn)
         ;; its important that we save the state of *handlers* to prevent
         ;; using the handler bindings we are a part of  if we signal an error 
         ;; from within a handler.
         (binds (loop for (name args . body) in error-bindings
                      collect (list (gensym) name `(lambda ,args
                                                     (let ((*handlers* *old-handlers*))
                                                       (return-from ,block (progn ,@body))))))))
    `(block ,block
       (let* ((*old-handlers* *handlers*)
              ;; binds our tmpvar to the handler-function
              ,@(mapcar (lambda (bind) (list (first bind) (third bind)))
                        binds))
         ;; and add (classname . handler-fn) to *handlers*
         (let ((*handlers* (add-handlers ,@(mapcar (lambda (bind)
                                                     `(cons ',(second bind) ,(first bind)))
                                                   binds))))
           ,form)))))

;and we now raise and catch errors
(trycatch (raise 'root-error "foo")
  (root-error (c) (format t  "WE GOT AN ERROR ~A" c)))

(defclass my-error (root-error) ())

(defun test-my-error () (raise 'my-error "Whoops!~%"))

(trycatch (test-my-error)
  (my-error (c) (format t "Great it works!~%")))

(trycatch (test-my-error)
  (root-error (c) (format t "And subtyping works too~%")))

(trycatch (trycatch (test-my-error)
            (root-error (c) (raise 'my-error "new-error"))
            (my-error (c) "INNER MY-ERROR HANDLER"))
  (my-error (c) "OUTER MY-ERROR HANDLER"))

;; should return "OUTER MY-ERROR HANDLER"

Next step handler-bind[3].

-------------------------------


[1] : http://www.lispworks.com/documentation/HyperSpec/Body/m_hand_1.htm
Slow and renamed to trycatch for namespace reasons.
[2] : hmmmm, is this the start of recursive Greenspunning?
[3] : http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm

-----
This post is courtesy of lispworks(5.0.2), emacs22 and lispdoc

ORF and values

As it turns out my previous post does not allow a values form as a place (the macro expands into invalid code).

So here is an updated version which behaves as follows.
When provided with a values form then for each place n, if n is nil
then n will be set to the nth value returned by the values-form.

eg.

(let ((a 1)
     b
     (c 3))
 (orf (values a b c) (values 4 2 5))
 (values a b c))

=> 1,2,3

And here it is in all it's glory.

(defmacro orf (place value-form &environment env)
 (multiple-value-bind (vars vals store-vars writer reader)
     (get-setf-expansion place env)
   (let ((tmp-var (loop repeat (length store-vars) collect (gensym))))
     `(let* (,@(mapcar 'list vars vals))
        (multiple-value-bind ,store-vars ,reader
          (multiple-value-bind ,tmp-var ,value-form
            ,@(loop for store in store-vars for val in tmp-var
                    collect `(unless  ,store (setf ,store ,val)))
            ,writer))))))

orf (a Common Lisp version of ||=)

I've recently been programming in ruby and one of the handy operators I've
been using has been ||= .

If you haven't seen it before think of it in terms of += .
So x ||= 3 is equivalent to x = x || 3.

I've found this pretty useful in a couple of cases and decided to write a
CL implementation of it. I give you ORF.



(defmacro orf (place value &environment env)
 (multiple-value-bind (vars vals store-vars writer reader)
   (get-setf-expansion place env)
 `(let* (,@(mapcar 'list vars vals)
         (,@store-vars (or ,reader ,value)))
    ,writer)))

So now (orf x 3) === (setf x (or x 3))

with the minor caveat that x will only being evaluated once.

Truly, Lisp is the Borg of programming languages.

Format

Format is one of those features in Common Lisp that people seem to have a love/hate relationship with, the other being loop. Both have their own mini languages that are not especially lispy. I'm still not too sure where I stand in this debate but being able to say things like this is still pretty incredible.

(defun print-diamond (str x &optional c a (max (1+ x)) (star "*"))
  (format str "~&~[~:;~:*~vT~v@{~A ~:*~}~3@*~v,v/print-diamond/~:*~v[~:;~@*~vT~v@{~A ~:*~}~%~]~]"
          x (- max x) star max star (1- x)))

Now for an explanation of that format string.
Bear with me this is hairy.

• ~& : Conditional newline (insert newline if we aren't at the start of a line)


• ~[ : Process the nth clause (seperated by ~:). ~:; specifies a default clause. This consumes the argument x. This directive causes print-diamond to stop processing when x is zero.
  


• ~:* : Backup 1 argument (unconsumes the argument x)


• ~vT : Insert arg number of spaces (this reconsumes the first argument ie. x)


• ~v@{ : Iterate v times, v is (- max x).


• ~A : Print 1 element


• ~:* : Backup 1 element (The effects of the last 3 directives is to print star (- max x) times)


• ~} : End loop


• ~3@ : Move to the 3rd argument (star)


• ~v,v/print-diamond/ : The recursive call. invoke print-diamond again with max, star and (1- x), This is equivalent to calling (print-diamond stream (1- x) nil nil max star)


• ~:* : Backup 1 argument (unconsumes (1- x))


• ~v[ : Conditional processing based (1- x).


• ~@* : Go to the start of the argument list.


• ~vT : Insert arg number of spaces (this consumes the first argument again)


• ~v@{ : Iterate v times, v is (- max x).
  
  
  • ~A : Print 1 element
  
  
  • ~:* : Backup 1 element (The effects of the last 3 directives is to print star (- max x) times)
  
  
• ~} : End loop


• ~% : Insert a new line


• ~] : End conditional processing


• ~] End conditional processing

Whew, brain freeze.

now we can do (print-diamond t 10)

         *
        * *
       * * *
      * * * *
     * * * * *
    * * * * * *
   * * * * * * *
  * * * * * * * *
 * * * * * * * * *
* * * * * * * * * *
 * * * * * * * * *
  * * * * * * * *
   * * * * * * *
    * * * * * *
     * * * * *
      * * * *
       * * *
        * *
         *

darjeeling

This looks as if it could be quite interesting.

The ability to convert Ruby to Common Lisp (or ideally just load ruby files) should put paid to complaints about the lack of libraries in CL.

Of course it could turn out to be absolutely nothing but I'm going to keep an eye on it.

Lispworks 5.1 Personal Edition

At last, Lispworks Ltd has announced the release of Lispworks 5.1 Personal Edition!

New features
- Threading now uses pthread on Linux
- FreeBSD port
- Support for Intel Mac's

More here