Using Vim with Common Lisp

The Emacs-based Slime is an excellent IDE for Common Lisp up to the point of inducing people to switch from Vim to Emacs.

Personally I feel that there’s a need for either a full-featured vi written in Common Lisp (no, not GUI-only and written in Python, sorry) or a vi mode for Emacs that is consistent and also full-featured.

Until then you have several possiblities, most of which have been devised pretty recently:

  • Nekthuth uses the Swank/Slime model with a library on the Lisp side and a Python scripted Vim plugin on the editor side. It offers a bunch of good things, but I haven’t tried it, yet.
  • Limp seems to be the current star among Vim/Lisp bridges, with an active community. I’m going to try this soon.
  • Like Slime for Vim is a solution that relies almost solely on GNU Screen. No Hyperspec lookup or function completion without additional work, though.
  • Use some additional hints for a comfortable setup.

These approaches have varying implementation support. You’re always fine with SBCL, but Nekthuth, for example, doesn’t support other implementations.

I’m currently using the plain rlwrap approach but I might take advantage of some other approach soon.

Collecting ASDF system dependencies

Here’s a snippet that will recursively collect all dependencies of one or more ASDF systems:

(asdf:oos 'asdf:load-op 'asdf)
(asdf:oos 'asdf:load-op 'metatilities)
 
(defun direct-dependencies (component)
  (cdadr (asdf:component-depends-on 'asdf:load-op
                                    (asdf:find-component nil component))))
 
(defun normalize-system-id (id)
  (intern (symbol-name id) "KEYWORD"))
 
(defun %effective-dependencies (components)
  "Helper function."
  (when components
    (remove-duplicates
      (append components
              (%effective-dependencies
                (mapcar #'normalize-system-id
                        (remove-if #'null
                                   (metatilities:flatten
                                     (mapcar #'direct-dependencies
                                             components))))))
      :test #'eq)))
 
(defun effective-dependencies (components)
  "Find all dependencies needed for the list of COMPONENTS
(which may be an atom, too)."
  (let ((components (metatilities:ensure-list components)))
    (set-difference (%effective-dependencies components) components
                    :key #'normalize-system-id)))
 
;; usage
(effective-dependencies :weblocks)
 
(:LW-COMPAT :CLOSER-MOP :MOPTILITIES :METATILITIES-BASE :TRIVIAL-GRAY-STREAMS
 :ASDF-SYSTEM-CONNECTIONS :METABANG-DYNAMIC-CLASSES :FLEXI-STREAMS :CFFI
 :SB-GROVEL :CL-CONTAINERS :METABANG-BIND :CHUNGA :CL-BASE64 :CL-FAD :CL-PPCRE
 :CL+SSL :MD5 :RFC2388 :SB-BSD-SOCKETS :SB-POSIX :URL-REWRITE :PARENSCRIPT
 :FARE-UTILS :METATILITIES :HUNCHENTOOT :CL-WHO :CL-JSON :PURI :FARE-MATCHER
 :CL-CONT :ITERATE)

Smart dates in CL

Sometimes it’s convenient to present dates in a way that depends on their offset from the current time.

For example, in different resolutions: 23 seconds ago, one minute ago, two days ago.

Another example, making use of human naming conventions: yesterday, Monday (implicitly assuming the closest Monday before the current date).

In Common Lisp, without further babbling:

(load "time.lisp")
;; http://cybertiggyr.com/gene/pdl/time.lisp
;; you could also use, for example, CL-L10N.
 
(defmacro base-bind (unit-var amount (&rest var-and-radix) &body code)
  "Thanks to Alan Crowe for this wonderful macro."
  (if (endp var-and-radix)
    `(let ((,unit-var ,amount)) ,@code)
    (let ((transfer (gensym)))
      `(multiple-value-bind (,transfer ,unit-var)
         (floor ,amount ,(cadar var-and-radix))
         (base-bind ,(caar var-and-radix) ,transfer ,(cdr var-and-radix)
                    ,@code)))))
 
(defun smart-date (then)
  (let ((now (get-universal-time)))
    (base-bind now-sec now ((now-min 60) (now-hour 60) (now-day 24))
      (base-bind then-sec then ((then-min 60) (then-hour 60) (then-day 24))
        (base-bind diff-sec (- now then) ((diff-min 60) (diff-hour 60) (diff-day 24))
          (cond
            ;; add more stuff here (e.g. negative offsets) and modify to suit your needs
            ((> diff-day 6) (CYBERTIGGYR-TIME:format-time nil CYBERTIGGYR-TIME:*FORMAT-TIME-FULL* then))
            ((> diff-day 1) (CYBERTIGGYR-TIME:format-time nil "%A" then))
            ((= diff-day 1) "Yesterday")
            ((> diff-hour 0) (format nil "~Dh~Dm ago" diff-hour diff-min))
            ((> diff-min 0) (format nil "~Dm~Ds ago" diff-min diff-sec))
            (t (format nil "~D seconds ago" diff-sec))))))))
 
; demonstration/test
(loop for offset in (list 36 90 120 130 3599 3600 3601 86400 86500 173000 14290010)
      do (format t "~D: ~A~%" offset (smart-date (- (get-universal-time) offset))))
 
; output:
36: 36 seconds ago
90: 1m30s ago
120: 2m0s ago
130: 2m10s ago
3599: 59m59s ago
3600: 1h0m ago
3601: 1h0m ago
86400: Yesterday
86500: Yesterday
173000: Tuesday
14290010: Sunday, 2008 January 27, 03:06 +1

Again, I’d like to see solutions from other languages.

Batch-renaming files

I needed to number all image files in the current directory:

# current:
16090-04.png       PySolFC_1.png
h3teampysol_20080303103813.jpg  pysol.gif
pysol_420_2.gif 175928_large.jpeg  Pysol.jpg
linux-game-pysol03.png          pysol460_big2.jpg
 
# goal:
pysolfc1.png  pysolfc2.jpeg  pysolfc3.gif
pysolfc4.jpg  pysolfc5.png  pysolfc6.jpg
pysolfc7.png  pysolfc8.gif  pysolfc9.jpg

Surprisingly easy in Common Lisp:

(loop for file in (directory "*")
     for i from 1
     do (rename-file file (format nil "pysolfc~D" i)))

In plain sh programming, I would have had to extract directory component, basename and extension, modify the basename without the extension and put them all together again. And keep track of the index manually, too.

I suppose some shell guru might come up with a neat (and probably quite unreadable) solution, but I’d rather stick to Common Lisp.

I’m curious about other solutions, esp. in Shell (ZSH allowed!), Python, Ruby and less-known languages.

Porting Perl’s qq to Common Lisp

Perl has the useful qq operator which lets you specify an arbitrary delimiter for the string following it:

# here with exclamation mark:
qq!we "often" use "quotes" "here".!

In Common Lisp, this would be useful as well, especially in docstrings and when generating foreign language code (think JavaScript without Parenscript, for example).

Let over Lambda shows us the useful sharp-doublequote reader macro that lets #" and "# act as delimiters.

This already helps a lot and looks very good, but sometimes you have a lot of double quotes and the terminating combination "# inside one string.

Take a look at this piece of JQuery code in Lisp (CL-WHO html generation):

(:a :onclick (format nil "$(\"#content\").load(\"~A.clhp\"); return true;" id))

Sharp-doublequote won’t work here because of "#. We can’t use single quotes here either because Hunchentoot will delimited the onclick part with them. We could probably add a space between " and #, but it would be a kludge and might not work in other cases anyway.

The bottom line is that using a fixed character or character combination won’t work for all cases (except when the delimiter is really long like MIME boundary strings, but this is obviously impractical).

So letting the user choose the delimiter on a case-by-case basis is a smart decision (as long as it is not overused and clutters the code with all sorts of delimiters).

The following code provides this functionality:

(defun |#q-reader| (stream sub-char numarg)
  (declare (ignore sub-char numarg))
  (let ((terminator (read-char stream)))
    (loop for ch = (read-char stream)
          until (eql ch terminator)
          collect ch into chars
          finally (return (coerce chars 'string)))))
 
(set-dispatch-macro-character
    #\# #\q #'|#q-reader|)

Quick test:

% clisp -repl qq.lisp
[1]> "foo"
"foo"
[2]> #q|foo|
"foo"
[3]> #q|foo bar baz|
"foo bar baz"
[4]> #q!foo bar baz!
"foo bar baz"
[5]> #q!foo bar "baz!
"foo bar \"baz"
[6]> #q!Hello! world! ; oops
"Hello"
[7]>
*** - SYSTEM::READ-EVAL-PRINT: variable WORLD! has no value

Shadowing a CL function definition

Shadowing functions is useful for example when testing.
Suppose we want to build a tiny test suite around the following function:

 
(defparameter *appointment* ...)
 
(defun overdue-p ()
  (>= (get-universal-time) *appointment*))

Testing OVERDUE-P obviously requires us to test two branches: one where the appointment is overdue and one where it is not.

Let’s say that you can’t change *APPOINTMENT* in your testing context for whatever reasons (the reason here being that this example is ultra-contrived for simplicity).
Assuming a fixed value for *APPOINTMENT* we need to change the return value of CL:GET-UNIVERSAL-TIME. This can be achieved by shadowing this function for the duration of our test.

Unfortunately, shadowing a function in Common Lisp isn’t obvious.

You can’t use FLET or LABELS because they have lexical scope.
You can’t use DEFUN either because it affects the global function namespace and doesn’t let you save or restore the old definition.

The only way I know of is using the function (SETF FDEFINITION):

(let ((orig (fdefinition 'get-universal-time)))
  (setf (fdefinition 'get-universal-time) (lambda () *my-testing-time*))
  (prog1
    (overdue-p) ; you'd run some test checks against the result here
    (setf (fdefinition 'bar) orig)))

Wrapping this in a macro is left as an exercise to the reader.

This doesn’t work for special operators, and neither for FLET or LABELS. See the CLHS entry for accessor FDEFINITION.

Ironclad hashes in SBCL

Getting a SHA1 digest from Ironclad turned out to be a quite bumpy ride; its “convenience functions” are not convenient enough to take a string, they only operate on octets.

There’s a helper function that converts an ASCII string to octets, but I needed to be able to supply Unicode strings as well. I ended up finding STRING-TO-OCTETS:

(defun sha1 (str)
  (ironclad:byte-array-to-hex-string
    (ironclad::digest-sequence :sha1 (SB-EXT:STRING-TO-OCTETS str))))

If someone knows an easier or more portable way, I’m all for it. I’m also interested in other free implementations’ functions to convert their strings to octets.

Function encapsulation in SBCL

The advice functionality allows the programmer to replace or encapsulate an existing function binding (akin to :AROUND methods in the CLOS). See Gary King’s “What is advice” for some useful links and explanations on this.

CLISP and SBCL, my favourite Common Lisp implementations, do not seem to supply this functionality. I haven’t checked whether CLISP has advice under its hood, but SBCL does, and it’s termed “Function encapsulation” there. Once you know how to do it, it’s surprisingly simple to use.

This is the definition of SB-INT:ENCAPSULATE in SBCL’s src/code/fdefinition.lisp:

;;; Replace the definition of NAME with a function that binds NAME's
;;; arguments to a variable named ARG-LIST, binds name's definition
;;; to a variable named BASIC-DEFINITION, and evaluates BODY in that
;;; context. TYPE is whatever you would like to associate with this
;;; encapsulation for identification in case you need multiple
;;; encapsulations of the same name.
(defun encapsulate (name type body)
  (let ((fdefn (fdefinition-object name nil)))
    (unless (and fdefn (fdefn-fun fdefn))
      (error 'undefined-function :name name))
    ;; We must bind and close over INFO. Consider the case where we
    ;; encapsulate (the second) an encapsulated (the first)
    ;; definition, and later someone unencapsulates the encapsulated
    ;; (first) definition. We don't want our encapsulation (second) to
    ;; bind basic-definition to the encapsulated (first) definition
    ;; when it no longer exists. When unencapsulating, we make sure to
    ;; clobber the appropriate INFO structure to allow
    ;; basic-definition to be bound to the next definition instead of
    ;; an encapsulation that no longer exists.
    (let ((info (make-encapsulation-info type (fdefn-fun fdefn))))
      (setf (fdefn-fun fdefn)
            (named-lambda encapsulation (&rest arg-list)
              (declare (special arg-list))
              (let ((basic-definition (encapsulation-info-definition info)))
                (declare (special basic-definition))
                (eval body)))))))

From this we can figure out that basic advice can be gotten from SBCL like this:

CL-USER(19): (defun gorm (x) (1+ x))
GORM
 
CL-USER(20): (SB-INT:ENCAPSULATE 'gorm 'identity '(apply sb-int:basic-definition sb-int:arg-list))
 
#<closure (SB-C::&OPTIONAL-DISPATCH SB-IMPL::ENCAPSULATION) {ACE428D}>
CL-USER(21): (gorm 10)
11
 
CL-USER(22): (SB-INT:ENCAPSULATE 'gorm 'add-five '(+ 5 (apply sb-int:basic-definition sb-int:arg-list)))
#</closure><closure (SB-C::&OPTIONAL-DISPATCH SB-IMPL::ENCAPSULATION) {ACEE31D}>
 
CL-USER(23): (gorm 10)
16
 
CL-USER(24): (SB-INT:ENCAPSULATE 'gorm 'add-seven '(+ 7 (apply sb-int:basic-definition sb-int:arg-list)))
 
#</closure><closure (SB-C::&OPTIONAL-DISPATCH SB-IMPL::ENCAPSULATION) {ACF84ED}>
CL-USER(25): (gorm)
23
</closure>

We have built a pretty onion, each layer of which calls the next inner layer via BASIC-DEFINITION (the analog to CALL-NEXT-METHOD). Let’s peel specific layers from it:

CL-USER(26): (SB-INT:UNENCAPSULATE 'gorm 'add-five)
T
 
CL-USER(27): (gorm 10)
18
 
CL-USER(28): (SB-INT:UNENCAPSULATE 'gorm 'add-seven)
T
 
CL-USER(29): (gorm 10)
11

A kind of magic

One often has to checking file uploads for correctness, for example with respect to size, file type or file name.

Here’s a sketch for checking the type of image files:

(defun matches-magic (file magic &optional (offset 0))
    (with-open-file (s file :element-type '(unsigned-byte 8))
      (file-position s offset)
      (loop for c across magic
            unless (eql c (code-char (read-byte s)))
            do (return-from matches-magic))
      t))
 
(defun jpeg-p (file) ; won't catch Exif files with JPEG inside
  (matches-magic file "JFIF" 6))
 
(defun png-p (file)
  (matches-magic file "PNG" 1))
 
(defun gif-p (file)
  (matches-magic file "GIF89a"))
 
(defun canonical-image-extension (file)
  (cond
    ((png-p file) "png")
    ((gif-p file) "gif")
    ((jpeg-p file) "jpeg")))
 
(defmacro any-predicate (preds &rest args)
    `(or ,@(loop for p in preds
                 collect `(,p ,@args))))
 
(defun valid-image-p (file)
  (any-predicate (jpeg-p png-p gif-p) file))

ANY-PREDICATE could also be written as a function (with a slightly different form of arguments), here’s another quick draft:

(defun any-predicate (preds &rest args) ; largely untested
  (some #'identity (mapcar (lambda (x) (apply x args))  preds)))
 
(defun valid-image-p (file)
  (any-predicate (list #'jpeg-p #'png-p #'gif-p #'exif-p) file))

Of course, you could also chain SYMBOL-FUNCTION to get rid of the sharp-signs in the call. Whatever suits you.
I like the macro better, though, since it’s clearer and probably more efficient. Update: see below for a comment by Zach Beane on this.

Homework would be writing a simple DSL to jot down file type data:

(define-file-type "jpeg" JFIF 6)

Alternatives from the outer world would be calling file(1) or parsing magic(4).

Escaping from higher-order functions

Among the different ways to tackle iterative processes I consider to be the higher-order function route the one I use most often. Especially in conjunction with function composition and list predicates it makes great filtering-style code.

A problem that came up several times is interrupting the list processing at an arbitrary point. For example, how do I stop MAPCAR at the third item if I see it fit? Something like that:

(let ((i 0))
  (mapcar (lambda (x)
            (when (eql (incf i) 3)
              (STOP-HERE)))
    '(a b c d)))

Sometimes, one can take alternative routes using FIND or other functions. And there’s always LOOP, DOLIST, recursion and other solutions; after all we’re working in a language that really implements the “there’s more than one way to do it” paradigm.

Using TAGBODY and GO:

(tagbody (mapcar (lambda (x) (go X)) '(a b c)) X)

Using BLOCK/RETURN-FROM:

(block X (mapcar (lambda (x) (return-from X))(a b c)))

I originally posted another version using CATCH/THROW, but as pointed out in the comments this wasn’t all well for several reasons.

Delimited continuations with CL-CONT unfortunately won’t work.

A good alternative solution would be writing your own version of MAPCAR; this has the advantage of being able to return the partially processed list. But there’s the disadvantage of having to rewrite the whole family of mapping functions, though, so for quick prototyping or occasional usage I prefer the above solution.

If you have other neat solutions or see problems with this approach, please leave a comment.

« Previous PageNext Page »