Mudballs 3

Well, I've finally pushed Mudballs 3 out the door and, while it contains a large number of changes and many improvements, this post isn't only about the work that has been done in the past few months but will also touch on where Mudballs will be going in the months to come.

The bad news is that, once again and for the very last time,  Mudballs users will be required to reinstall the mudballs distribution as various internals have been moved around, I'm terribly sorry about this and I've done my best to ensure that this is the last time that it will happen. Please note that nothing will break if you do not upgrade but the old repository will no longer be updated.

As always Mudballs is available from http://mudballs.com/#installing.

Lets first look at the changes that have made their way into the repository.

1. ASDF Support: This is a big one, Mudballs now includes a sysdef.asdf system which provides an ASDF package (or more precisely, a SYSDEF.ASDF package with the nickname ASDF) to provide ASDF support. To be more precise defsystem, operate and  the various component and action classes are exported and provide the same service you would normally expect from ASDF. The biggest drawback that it has at the moment is that when specializing methods on operate invoking `call-next-method` will have undefined consequences (read that as `Don't call call-next-method`).


2. Single File Systems: Mudballs can now be used to load single files on your computer. Mudballs will now search on the list *search-paths*   for systems when a relative portable pathname is supplied.  As an example, given a *search-paths* of '("~/Lisp/") and a file named #P"~/Lisp/workfiles/cc-validate.lisp" I can compile and load this file using the following form.  

   (mb:load ";workfiles;cc-validate")

    Internally a component is created in mudballs and is operated upon and can be looked up using find-system.   The component which is created can be customized by adding a (mb:component . options) form to the top of the file.  As an example, a small file which needs :cl-ppcre can be customized by adding the following form to the top of the file.  

   #+mudballs (mb:component (:needs :cl-ppcre))

    It is worth noting that SINGLE-FILE-SYSTEM is not, in fact, a subclass of SYSTEM but rather a subclass of LISP-SOURCE-FILE.


3. Multiple parent classes: DEFINE-SYSTEM now accepts any number of parent classes. This will create an anonymous class which extends the provided classes. eg.

   (define-system :my-system (core-system-mixin system)  .....)

   Will create a new system which extends both core-system-mixin and system.


4. FOR Option:  In an attempt to remove the need for #+ and #- reader macros in system definitions (which do not behave well with automating releases) a :FOR option has been added to components and to the syntax for defining dependencies which can be used to achieve that same goal as read time conditionalization. As an example, consider Edi Weitz's excellent :DRAKMA system which has a dependency on :USOCKET for all implementation other than Lispworks. Previously the needs form would have looked something like the following. 

    (:NEEDS #-lispworks :USOCKET)

       Using :FOR (which is now the preferred approach) the :NEEDS form will now look like this. 

    (:NEEDS (:USOCKET (:FOR (:NOT :LISPWORKS)))) 

   Granted this is somewhat more verbose (although somewhat less so when replacing a #+ conditionalization) it does mean that the system dependencies are now portably inspectable. This option is applicable to ALL instances of components, including modules and files. It is also worth noting the value for the FOR option can be anything which is suitable to sysdef::featurep.


5. NAMED-MODULE: The named-module is a new subclass of module which provides a way to specify the directory of the module per implementation,  this is designed to provide a more introspectable alternative to the reader conditionalization macros. As an example, CLOSER-MOP has the following NAMED-MODULE in it's COMPONENTS list. 
   

   (COMPAT NAMED-MODULE  
     (:NAMES :ALLEGRO :CLISP :LISPWORKS
             ((:OR :MCL :OPENMCL) "mcl")  
             ((:OR :CMU :SBCL) "pcl"))  
     (:COMPONENTS "closer-mop-packages" "closer-mop"))

   Each entry in the :NAMES option is expected to be either a symbol which, when matched using featurep, will use the string-downcase'd  version of the symbol as the directory name. When a list is provided then the first element in the list is the argument which will be tested using featurep and the second is the name to use if it matches.


6. REQUIRES Option: The requires option has gone through a number of changes and has now been resurrected from a deprecated nickname  for :NEEDS to portable way to `CL:REQUIRE` implementation specific libraries which you have a dependency on. Previously this was only handled for SBCL by defining SBCL systems in a system-definition file. This file has now been dropped and the :REQUIRES option is now the preferred  way to load implementation specific requirements.  As an example usocket has a dependency on SB-BSD-SOCKETS which used to be handled by having a

   (:NEEDS #+sbcl :SB-BSD-SOCKETS)

   option. This is now replaced by

   (:REQUIRES (:SB-BSD-SOCKETS (:FOR :SBCL)))



7. CONDUIT-SYSTEM's: A new subclass of System is now exported; this class, which performs the same task as asdf-system-connections,  provides a means to define a system which is loaded automatically when all of it's dependencies are loaded. A conduit system can be defined either by specifying CONDUIT-SYSTEM in the superclass list of define-system or by defining your system using DEFINE-CONDUIT-SYSTEM.


8. Portable Pathname Specifiers: Mudballs now provides a portable way of specifying pathnames when passing pathnames to the :config-file and :preferences-file options. In this naming scheme directory names are seperated by #\;'s (a semicolon) and mudballs will ensure that any path starting with #\~ (tilde) will have the result of (user-homedir-pathname) merged with the remaining namestring. Example. "~;mudballs;test.lisp" is a portable yet shorter way of specifying 
   

   
   (merge-pathnames (make-pathname :directory '(:relative "mudballs")
                                   :name "test" :type "lisp") 
                    (user-homedir-pathname))

Other Features and Changes

• FEATURE: system definitions files now are automatically compiled when mudballs changes. (this includes files added using wildcard-searcher)
  
• FEATURE: You no longer need to run sysdef:register-sysdefs when you add new systems. It is automatically run before find-system (some attempt has been made to ensure that it doesn't impact performance too heavily)
  
• BUG FIX: (:needs (:cl-ppcre :version "1.3")) is once again valid.
  
• UPDATE: The no-installed-component condition has been removed as it is a conceptual duplicate.
  
• UPDATE: redefining a system no longer creates a new instance of a SYSTEM but will reset and update the currently defined one if one exists.
  
• BUG FIX: redefining a system will not cause the system to be considered un-operated upon.
  
• NEWS: Mudballs now waits until the last possible moment before loading system definitions, this now results in faster startup times.
  
• And many other small changes and fixes.
  

The Future

Now that we've gotten the past and present out of the way lets look to the future. Mudballs, while having had a large portion of work dedicated to operating upon systems, does NOT have 'operating on systems' as it's primary goal. Mudballs is primarily about Distribution and distributing Common Lisp systems in particular, which is 

1. It's biggest difference to ASDF and 
   
2. a far more useful problem that needs solving.
   

So what does this mean? It means that mudballs users can expect, in the near future, a portion of mudballs.com dedicated to the creation of projects and the uploading of new versions of systems which will automatically provide new definition files and downloadable mudballs on mudballs.com.

This will allow any writer of Common Lisp code to upload their system and make it available (with correct version information) to the rest of the world, complete with automatically generated documentation and links to the various releases. This, not so small, feature should go along way to providing Common Lispers with something which is at least converging on CPAN.

This is all being done with one thing in mind: Repeatability.

This is currently the biggest shortcoming of the ASDF family, in that the installation of an arbitrary set of systems cannot be reliably reproduced, which makes troubleshooting library combination issues incredibly difficult; and of course the more systems you have installed the more likely it becomes that what you have will differ from a maintainer which makes having dependencies on systems an inherently risky affair.

I know I'm not the only person who's had a particular system fail only to be told by the maintainer that `It works for me` followed by a list of the versions he is using. This is typically followed by the `Vain attempt to find these exact versions` dance [1] which is all too often followed by the `I give up, hands in the air` shuffle. As it stands, ASDF and friends just do not help here and this is the situation Mudballs is intended to solve.

Mudballs primary purpose is not System Definition but Repeatable System Distribution.

As always comments and investments of time are welcome and you can reach myself and other Mudballs users at the Mudballs Google Group.

Enjoy,

 Sean.

1) Don't even get me started about systems whose primary form of distribution is `Fresh checkout from VC tool of choice`.

A Mudballs Update

Yes, I know it's late but better late than never right.

Anyway, I have just uploaded the 'Christmas Cheer' release of mudballs which, unfortunately, will require a fresh install of mudballs for existing users as there was a rather egregious oversight regarding the updating of systems.

Noteworthy Features

• A publicly editable wiki has now been made available at http://redmine.mudballs.com/wiki/mudballs/   New pages can be created by opening the appropriate URL. For example, http://redmine.mudballs.com/wiki/mudballs/hunchentoot will  show an option for creating a new page. 
• The start of a mudballs FAQ can be found on it's wiki page: http://redmine.mudballs.com/wiki/mudballs/FAQ.
  
• down-casing of pathnames has been fixed. Down-casing will now only happen for components named with symbols.
  
• New versions of all systems, including core systems such as :cl-ppcre, can now be updated without having to reinstall mudballs.
  
• (mb:install :cl-ppcre :file "/path/to/file") now works.
  
• The output path of component is now calculated correctly (including honoring the :fasl-output-root preference).
  
• Uninstalled systems are no longer considered  for an operation if there is an installed version of the system present unless explicitly requested using the :version keyword.
  
• The fasl-path of system definition files is no longer the same as components of a system as this was conflicting with the output of compiling components.
  
• And other small fixes

As always mudballs is available for download from the releases directory and instructions can be found here.

Please let me know if any server on mudballs.com is not responding as my hosting provider is being a little flaky of late.

Thanks to the following people for reports and ideas.

- Magnus Malm

- Luke Renn

- Leigh Smith

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.

Case Conversion Considered Useful

One of the stranger[1] features of Common Lisp is that the CL reader, by default, will convert symbols to uppercase[2] which can be a little surprising to newcomers, and inevitably leads misconceptions regarding case (in)sensitivity.

One of the advantages of this automatic case conversion is that it allows us to use case as syntactic markers.

Here's a simple example (ignore the non idiomatic use of CL).

(defun filter (test list)
 (let ((result ()))
   (dolist (elt list result)
     (when (funcall test elt)
       (push elt result)))))

Did you notice the return form?
This happens to be one of those constructs that is quite easy to overlook when reading through code, it doesn't happen often but it does happen[3].

However, if we change it to this.

(defun filter (test list)
 (let ((result ()))
   (dolist (elt list RESULT)
     (when (funcall test elt)
       (push elt result)))))

the result form 'leaps' out of the page which makes it very difficult to miss.

It's the code equivalent of wearing a silly hat.

---

1: Stranger, as in, 'This isn't like C/Java/Python/Ruby'.
2: This is only the default and can be changed using readtable-case
3: Well it happens to me, ok.

Ruby Quiz 144 (in CL)

There was a small posting on c.l.l asking if anyone felt like completing Ruby quiz 144 in CL and after eric's solution I thought I'd give it a go.

This needs :cl-ppcre and :alexandria (and :lisp-unit to run the tests)
Apologies for formatting screwiness.

(defpackage :time-window (:use :cl :cl-ppcre :alexandria)
  (:export #:in-window-p))

(in-package :time-window)

;(defparameter *window* "Sat-Mon; Mon Wed 0700-0900; Thu 0700-0900 1000-1200")

;; This works by converting a spec (like the one above) into it's seperate components (split by ;)
;; and converting each spec into distinct time and day parts (expanding day ranges as we go)
;; so the above would be converted into the following
;; ((nil                       ("Sat" "Sun" "Mon"))
;;  (("0700-0900")             ("Mon" "Wed"))
;;  (("0700-0900" "1000-1200") ("Thu")))
;; We can then walk through each converted spec ensuring that the time specified falls into
;; the time/day specified.

(defun in-window-p (time window)
  (some (lambda (spec)
          (every (lambda (part)
                   (if (null part)
                       t ;; since (some (constantly t) ()) is nil
                       (some (curry 'time-within time) part)))
                 spec))
        (mapcar (lambda (split)
                  (group-by-type (split " " (string-trim " " split))))
                (split ";" window))))

(defun group-by-type (list)
  (loop for spec in list
        :when (time-range-p spec) :collect spec :into times
        :when (single-day-p spec) :collect spec :into days
        :when (day-range-p spec) :append (days-of spec) :into days
        :finally (return (list times days))))

(defparameter *days*
  '(("Mon" . 0) ("Tue" . 1) ("Wed" . 2) ("Thu" . 3) ("Fri" . 4) ("Sat" . 5) ("Sun" . 6)))

(defparameter *day-ring* (let ((list (copy-list *days*)))
                           (setf (cdr (last list)) list)
                           list))

(defun single-day-p (spec)
  (assoc spec *days* :test 'string=))

(defun day<-spec (spec)
  (cdr (single-day-p spec)))

(defun day-range-p (spec)
  (and (= (count #\- spec) 1)
       (every 'single-day-p (split "-" spec))))

(defun days-of (spec)
  (assert (day-range-p spec))
  (destructuring-bind (start stop) (split "-" spec)
    (loop :for (day . nil) :in (member start *day-ring* :key 'first :test 'string=)
          :collect day
          :until (string= day stop))))

(defun single-time-p (spec)
  (every 'digit-char-p spec))

(defun time-range-p (spec)
  (and (= 1 (count #\- spec))
       (every 'single-time-p (split "-" spec))))

(defun time-in-range (hour minute start stop)
  (flet ((to-mins (x) (+ (* 60 (parse-integer (subseq x 0 2)))
                         (parse-integer (subseq x 2 4)))))
    (<= (to-mins start) (+ (* 60 hour) minute) (1- (to-mins stop)))))

(defun time-within (time spec)
  (multiple-value-bind (sec minute hour date month year day)
      (decode-universal-time time 0)
    (declare (ignore sec date month year))
    (cond ((single-day-p spec) (= day (day<-spec spec)))
          ((time-range-p spec)
           (apply #'time-in-range hour minute (split "-" spec))))))


;;; and a small test package
(defpackage :time-window.tests (:use :time-window :lisp-unit :cl))
(in-package :time-window.tests)

;; Tests
(define-test window-tests
  (let ((window "Sat-Sun; Mon Wed 0700-0900; Thu 0700-0900 1000-1200"))
    (flet ((in (sec hour date month year)
             (in-window-p (encode-universal-time 0 sec hour date month year 0) window)))
    (assert-false (in 0 8 25 9 2007))
    (assert-true  (in 0 8 26 9 2007))
    (assert-false (in 0 11 26 9 2007))
    (assert-false (in 59 6 27 9 2007))
    (assert-true (in 0 7 27 9 2007))
    (assert-true (in 59 8 27 9 2007))
    (assert-false (in 0 9 27 9 2007))
    (assert-true (in 0 11 27 9 2007))
    (assert-true (in 0 11 29 9 2007))
    (assert-true (in 0 0 29 9 2007))
    (assert-true (in 59 23 29 9 2007))
    )))

(define-test window-tests2
  (let ((window "Fri-Mon"))
    (flet ((in (date month year)
             (in-window-p (encode-universal-time 0 0 0 date month year 0) window)))
      (assert-false (in 27 9 2007))
      (assert-true (in 28 9 2007))
      (assert-true (in 29 9 2007))
      (assert-true (in 30 9 2007))
      (assert-true (in 1 10 2007))
      (assert-false (in 2 10 2007)))))

(run-tests)

Nothing flashy but it does remind me how useful circular lists can be.
Comments, as always, are welcomed.

---
This post brought to you by Lispworks 5.0.2

Closures + Lambda < CLOS

There's a blog post floating around the web[1] on how Closures + Lambda make up all the OO programming tools you'll ever want or need. Now this is a long running theme[2] in the Lisp family and really is a testament to how flexible Common Lisp (or any other language which shares these traits) is

.... however ....

the majority of these are for pedagogical purposes[3] and should never be seriously
compared with a fully fledged object system. It's seems to be in vogue to consider
CLOS elephantine[4] and complex but the truth is that at the surface CLOS is wonderfully simple.

We have classes with slots (read instance variables) created with defclass, we create
instances of these classes with make-instance. We access (and change) the slots of these
instances using slot-value and create methods for the classes using defmethod.

Simple, yes? Not complex or elephantine, Yes?

You can read more of course (all in the CLHS) and discover the object initialization protocol
and how the classes of objects can be changed on the fly, you can find out how to customize
the initialization of your classes and add accessors to your slots.
You can dig deeper and you'll discover the MOP and discover how to change the behaviour of
slot access and class definition.

But remember that you do not need to understand any of this in order to
define classes, create instances, access slots and define methods!

So next time you are rolling your own Object System because someone considers CLOS too slow,
or too large, stop and give CLOS a try, you may just like it.


--------------------
[1] : See here and here .
[2] : And is implemented in PAIP and On Lisp among others.
[3] : For a full OO implementation in CL see KR which is a prototype based object system with valuepropogation.
[4] : Or big, slow[5] or klunky
[5] : This myth has officially been debunked.

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

Hunchentoot and packages

Over the past couple of years I've been experimenting with a number of CL
http servers and have recently turned to hunchentoot as my platform of choice
which, like the rest of Edi's packages, has found it's way into my heart.

One of the things I've often found rather annoying however (not with
Hunchentoot specifically, this is present in all of the CL web servers
I've experimented with) is that publishing a URL is a twofold process:

a) define your handler function (or something similar) and
b) register that handler with a particular URL.

Now all this becomes a little repetitive so here is a new publisher function
which allows you to publish your package on a particular URL so that any
requests to URL's 'below' that one will be resolved to a function in your package.

We play on one of the less remarked upon CL features (or lack of restrictions)
which allows symbols to start with a #\/ (a forward slash, to those not used to
the CL character macro reader) so we can publish our package on /test define a
function named /foo and automagically have requests to /test/foo mapped
to our /foo handler.

(modified 30/5/2007 16:00)
eg.

(asdf:oos 'asdf:load-op :hunchentoot)
(asdf:oos 'asdf:load-op :cl-who)

(defpackage :pack-test (:use :cl :hunchentoot :cl-who))
(in-package :pack-test)


(defun index ()
  #'(lambda ()
      (with-html-output-to-string (x)
        (:html "The index page"))))

(defun seq-last (seq)
  (aref seq (1- (length seq))))

(defun string->handler (string package)
  (when (string= string "/") (return-from string->handler (index)))
  (multiple-value-bind (sym type) (find-symbol string package)
    (when (and (not (eql type :inherited))
               (fboundp sym))
      (symbol-function sym))))
                                  
(defun create-package-dispatcher (prefix)
  (check-type prefix string)
  (assert (eql (seq-last prefix) #\/) (prefix) "Prefix must end in a / (forward slash)")
  #'(lambda (request)
      (let* ((function (script-name request))
             (mismatch (mismatch (script-name request) prefix
                                 :test #'char=)))
        (when (or (null mismatch)
                  (>= mismatch (length prefix)))
          (string->handler (string-upcase (subseq function (1- (length prefix))))
                           *package*)))))

(push (create-package-dispatcher "/test/") *dispatch-table*)

(defun /index ()
  (with-html-output-to-string (out)
    (:html (:head (:title "Welcome"))
           (:body (:h2 "This is my welcome page")))))

(defvar *server* (start-server :port 8080))

and now browsing to http://localhost:8080/test/index should give you a
nice new welcome page and adding a new URL is a simple 1 step process.


---
This post is courtesy of lispworks(5.0.2), hunchentoot(0.9.2) and cl-who (0.4.4)

asdf-install & Windows

Thanks to Nate's latest release of archive we can now use asdf-install on Windows
without resorting to cygwin or gnu-tar. Just add the following to your .asdf-install.

(asdf:oos 'asdf:load-op :gzip-stream)
(asdf:oos 'asdf:load-op :archive :version "0.6")

(defun asdf-install-extractor (to-dir tarball)
(let ((name nil))
  (gzip-stream:with-open-gzip-file (ins tarball)
    (archive:with-open-archive (archive ins)
      (let ((*default-pathname-defaults* (pathname to-dir)))
        (archive:do-archive-entries (entry archive name)
          (archive:extract-entry archive entry)
          (unless name (setf name (archive:name entry)))))))
  ;; we use string instead of namestring because
  ;; asdf-install searches for /'s and not \'s
  ;; which will break on windows
  (string name)))

(push 'asdf-install-extractor asdf-install:*tar-extractors*)

You will still get an error along the lines of
"'gpg' is not recognized as an internal or external command,"
but select the continue restart and all should be fine and dandy.


---
This post is courtesy of lispworks(5.0.2), gzip-stream(0.1), asdf-install(0.5.5) and archive(0.6).

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)

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