Looking for good examples of Lisp macros

[dlweinreb]

Many of the good ideas that came from Lisp, such as garbage
collection, are now available in other languages. One of the key
ideas of Lisp that's still hard to find in other languages is the Lisp
macro system, and all it can do.

When I am talking to non-Lisp people about Lisp, I often make this
point, but they are often skeptical about how useful Lisp macros
really are.

I'd like to put together a presentation that demonstrates some of
the great things you can do with Lisp macros.

Unfortunately, many of the coolest uses of Lisp macros are rather big
and complicated. I need examples that are small and easy to explain,
for my purposes here.

If you have any cool, novel examples of Lisp macros, I'd very much
appreciate it if you could send them to me.

Thanks very much.

-- Dan Weinreb (dlw at alum.mit.edu)

[danb]

There are a couple simple reader macros here. One is a sort of multi-purpose infix/postfix/message-passing syntax, and the other one fakes partial function application. There are more macros in the standard library and the pattern-matching library that are linked from that page, but non-Lispers seem to be most impressed by surface features.

[Paul Donnelly]

Here's a little one I wrote a while back. I can't guarantee its quality, since I haven't looked at or used it since writing it, but it illustrates that macros are (a) useful for making things work how you like and (b) can incorporate arbitrary code to work their magic. Producing easy-to-type wrappers for iteration functions is my most frequent use of macros, but a clever object plus a for(;;) loop plus a C macro can accomplish pretty much the same thing. The goal here (to automatically fill in the :INITFORM, :INITARG, and :ACCESSOR arguments to DEFMACRO) actually requires a bit of processing.

It's not feature-complete — the ability to override the options it fills in would be nice — because like I said, I didn't end up using it.

Code: Select all

(defmacro boaclass (name direct-superclasses direct-slots &rest body)
  `(defclass ,name ,direct-superclasses
     ,(mapcar (lambda (s)
                (let ((name (first s))
                      (initform (second s))
                      (options (nthcdr 2 s)))
                  (append
                   `(,name
                     :initform ,initform
                     :initarg ,(intern (symbol-name name) 'keyword)
                     :accessor ,name)
                   options)))
              direct-slots)
     ,@body))

[dmitry_vk]

There is an ITERATE macro that adds powerful looping capability into the language. If audience is familiar with .NET, it may be interesting to show how LINQ-like language may be implemented with macros.
Small usages are CFFI that has macros to define some C type and means to access them.
In a hypothetical GUI toolkit there might be a macro to create widgets hierarchy.
Good examples of reader-macros are CL-SQL and CL-INTERPOL (e.g., compare ADO.NET/JDBC query building with CL-SQL's query expressions).
Example of compiler-macro is CL-PPCRE. It compiles constant regular expressions into functions (that are compiled into native code) during compilation (so that at run-time, there is no overhead for parsing and compiling the regex).
(Of course, those macros are not small, but their usage is simple)

[qbg]

Pattern matching is fun:

Code: Select all

(defun simp (e)
  (pattern-if ((? op) (? v1) (? v2)) e
     (setf e `(,op ,(simp v1) ,(simp v2))))
  (pattern-case e
     ((+ 0 (? v1))
      (simp v1))
     ((+ (? v1) 0)
      (simp v1))
     ((+ (? number v1) (? number v2))
      (+ v1 v2))
     ((- (? v1) 0)
      (simp v1))
     ((- (? number v1) (? number v2))
      (- v1 v2))
     ((* 0 (?))
      0)
     ((* (?) 0)
      0)
     ((* 1 (? v1))
      (simp v1))
     ((* (? v1) 1)
      (simp v1))
     ((* (? number v1) (? number v2))
      (* v1 v2))
     (t e)))


Code: Select all

(simp '(+ (* (- x 2) 1) (* (- x 3) (- 9 (* 3 3)))))
=> (- X 2)


In the code above, PATTERN-IF is a macro, and PATTERN-CASE is a macro that builds on it.

The use of PATTERN-CASE above makes the code easier to read than its macroexpanded form:

Code: Select all

(LET ((#:G637 E))
  (BLOCK #:G636
    (LET ((#:G638 (MATCH-PATTERN '(+ 0 (? V1)) #:G637)))
      (IF (NULL #:G638) NIL
          (LET ((V1 (CDR (ASSOC 'V1 #:G638))))
            (PROGN (RETURN-FROM #:G636 (SIMP V1))))))
    (LET ((#:G639 (MATCH-PATTERN '(+ (? V1) 0) #:G637)))
      (IF (NULL #:G639) NIL
          (LET ((V1 (CDR (ASSOC 'V1 #:G639))))
            (PROGN (RETURN-FROM #:G636 (SIMP V1))))))
    (LET ((#:G640 (MATCH-PATTERN '(+ (? NUMBER V1) (? NUMBER V2)) #:G637)))
      (IF (NULL #:G640) NIL
          (LET ((V2 (CDR (ASSOC 'V2 #:G640))) (V1 (CDR (ASSOC 'V1 #:G640))))
            (PROGN (RETURN-FROM #:G636 (+ V1 V2))))))
    (LET ((#:G641 (MATCH-PATTERN '(- (? V1) 0) #:G637)))
      (IF (NULL #:G641) NIL
          (LET ((V1 (CDR (ASSOC 'V1 #:G641))))
            (PROGN (RETURN-FROM #:G636 (SIMP V1))))))
    (LET ((#:G642 (MATCH-PATTERN '(- (? NUMBER V1) (? NUMBER V2)) #:G637)))
      (IF (NULL #:G642) NIL
          (LET ((V2 (CDR (ASSOC 'V2 #:G642))) (V1 (CDR (ASSOC 'V1 #:G642))))
            (PROGN (RETURN-FROM #:G636 (- V1 V2))))))
    (LET ((#:G643 (MATCH-PATTERN '(* 0 (?)) #:G637)))
      (IF (NULL #:G643) NIL
          (LET ()
            (PROGN (RETURN-FROM #:G636 0)))))
    (LET ((#:G644 (MATCH-PATTERN '(* (?) 0) #:G637)))
      (IF (NULL #:G644) NIL
          (LET ()
            (PROGN (RETURN-FROM #:G636 0)))))
    (LET ((#:G645 (MATCH-PATTERN '(* 1 (? V1)) #:G637)))
      (IF (NULL #:G645) NIL
          (LET ((V1 (CDR (ASSOC 'V1 #:G645))))
            (PROGN (RETURN-FROM #:G636 (SIMP V1))))))
    (LET ((#:G646 (MATCH-PATTERN '(* (? V1) 1) #:G637)))
      (IF (NULL #:G646) NIL
          (LET ((V1 (CDR (ASSOC 'V1 #:G646))))
            (PROGN (RETURN-FROM #:G636 (SIMP V1))))))
    (LET ((#:G647 (MATCH-PATTERN '(* (? NUMBER V1) (? NUMBER V2)) #:G637)))
      (IF (NULL #:G647) NIL
          (LET ((V2 (CDR (ASSOC 'V2 #:G647))) (V1 (CDR (ASSOC 'V1 #:G647))))
            (PROGN (RETURN-FROM #:G636 (* V1 V2))))))
    (PROGN (RETURN-FROM #:G636 E))))


[schoppenhauer]

A problem with many macros in lisp is that most other language already have similar things in their standard. The more general approach with lisp isnt understood by many people. "Why should we use macros for defining cond, we already have a switch-instruction", etc.

Some really small macros I wrote - of which i am sure most common language do not have - were macros to translate coordinates when Drawing. I.e. i defined two variables *translation-x* and *translation-y* and all my draw-instructions were relatively to this. Sometimes I needed to change these values temporarily. So I wrote the macros. I also had one type with slots x and y, as it sometimes was easier to handle coordinates this way, but sometimes i just wanted to write them down explicitly.

Code: Select all

(defmacro with-translation-* ((x y) &body body)
  `(let ((*current-translation-x* (+ ,x *current-translation-x*))
         (*current-translation-y* (+ ,y *current-translation-y*)))
     ,@body))

(defmacro with-translation ((translation) &body body)
  `(with-translation-* ((x ,translation) (y ,translation)) ,@body))

(defmacro with-negative-translation-* ((x y) &body body)
  `(with-translation-* ((- ,x) (- ,y)) ,@body))

(defmacro with-negative-translation ((translation) &body body)
  `(with-negative-translation-* ((x ,translation) (y ,translation)) ,@body))

This is nothing special, nothing exciting, nothing new. You dont really need it, you could always set the translation explicitly, or pass an object with the current relative zero-point to every drawing-function. It is just useful. One can argue about it, but to me, it makes the code look better.

Another thing is some kind of a let-instruction for accessors. I sometimes had the problem that I temporarily wanted to set some slot of an object to some other value, mostly, calling the accessor directly was needed, since other things depended on that slot. So i defined the following macro, which does exactly this:

Code: Select all

(defmacro let-accessor (((accessor object) value) &body body)
  "Temporarily set an Accessor to another value."
  (let ((symbol (gensym)))
    `(let ((,symbol (,accessor ,object)))
       (unwind-protect
            (progn (setf (,accessor ,object) ,value) ,@body)
         (setf (,accessor ,object) ,symbol)))))

(defmacro let-accessors ((&rest bindings) &body body)
  "Temporarily set Accessors to other values."
  (let ((cbind (car bindings)))
    (if cbind
        `(let-accessor
             ((,(first (first cbind)) ,(second (first cbind))) ,(second cbind))
           (let-accessors (,@(cdr bindings)) ,@body))
        `(progn ,@body))))

Again you can argue whether that is good - as it abstracts a lot of function calls into a little code block, which makes the code look more efficient than it is. But again - it is useful, it makes the code more readable.

The readability is a general argument I think. "Programs are written for humans, not for computers"

[implausibleusername]

Again I'm not sure if this counts as good, but it's both novel and short.

The macros generate code typed according to given exemplars.
In conjuncture with type inference like SBCL, these constraints will propegate through the function.
Disclaimer: I originally posted this on C.L.L. in response to someone claiming it was impossible to write such code, and I've never actually used it outside of a couple of test cases.

Code: Select all

(let ((body (make-hash-table))
          (arg-types (make-hash-table)))
  (defmacro deftyped (name args &rest fn-body)
    (setf (gethash name body) fn-body
          (gethash name arg-types) (mapcar #'list args))
    nil)
  (defmacro eg (name &rest args)
    (setf (gethash name arg-types)
          (mapcar  (lambda(literal list)
                     (push (type-of literal) list)) args (gethash name arg-types)))
    nil)
  (defmacro seal (name)
    `(defun ,name ,(mapcar (lambda (x) (car (last x))) (gethash  name arg-types))
       (declare ,@(mapcar (lambda (x)
                             `(type (or ,@(butlast x))
                                     ,(car (last x))))(gethash name arg-types)))
       ,@(gethash name body))))


Sample usage:

[code]
(deftyped plus (a b) (+ a b))
(eg plus 1 1)
(eg plus 1.0 1)
(eg plus #C(0 1) 1)
(macroexpand-1 '(seal plus))
;(DEFUN PLUS (A B)
; (DECLARE (TYPE (OR (COMPLEX BIT) SINGLE-FLOAT BIT) A)
; (TYPE (OR BIT BIT BIT) B))
; (+ A B))
(seal plus)
(plus 1 1)
[\code]