Serious Trolling

The other day Vincent Toups pointed out that that one can do pattern directed macros in CL. I don’t know where I got the idea that it was only possible in Racket. But I'm glad he made my realise my mistake

To illustrate the advantages I'll rewrite let. Henry Baker wrote the following implementation in Metacircular Semantics for Common Lisp Special Forms.

(defmacro hb-let (vs &body forms) `(funcall #'(lambda ,(mapcar #'car vs) ,@forms) ,@(mapcar #'cadr vs)))

However the implementation doesn't work for clauses without an init form, those that bind the symbol to nil. For example, (let (x) x) signals a type-error in the implementation provided by Baker.

I'll start with let* because it is simpler to implement, using trivia as the pattern matcher.

(defmacro pd-let* (bindings &body body) (match bindings (nil `(funcall (lambda () ,@body))) ((list* (list name value) rest) `(pd-let* ,rest (funcall (lambda (,name) ,@body) ,value))) ;; The guard is to prevent matching the form (x 1 3) and bind name to ;; (x 1 3) and rest to nil. ((guard (list* name rest) (symbolp name)) `(pd-let* ,rest (funcall (lambda (,name) ,@body) nil))) (_ (error "Cannot recognize binding clause in pdl-let: ~A" bindings))))

and some test cases

(pd-let* ((x 1)) (is x 1)) #+error(pd-let* ((x 1 3)) (princ x)) ;; Cannot recognize binding clause in pdl-let: ((X 1 3)) ;; [Condition of type SIMPLE-ERROR] (pd-let* (x) (is x nil)) (pd-let* (x (y 2)) (is x nil) (is y 2))

In the case of let, the idea is the same but because the names have to bound in parallel we have to use one lambda, so we'll accumulate the values and generate the lambda in the base case

(defmacro pd-let (bindings &body body) `(%pd-let ,bindings () () ,@body)) (defmacro %pd-let (bindings names values &body body) (match bindings (nil `(funcall (lambda (,@names) ,@body) ,@values)) ((list* (list name value) rest) `(%pd-let ,rest ,(cons name names) ,(cons value values) ,@body)) ((guard (list* name rest) (symbolp name)) `(%pd-let ,rest ,(cons name names) ,(cons nil values) ,@body)) (_ (error "Cannot recognize binding clause in pdl-let: ~A" bindings)))) (pd-let ((x 1)) (pd-let ((x 3) (y x)) (is x 3) (is y 1)))