[Common Lisp] lambda と書くのがめんどうなときに

たまにはブログになんか書かないと。で、ありがちかもしれないが lambda と書くのがめんどうなときに ディスパッチマクロキャラクタ でちょっと楽してみよかな。#_ で始まるフォームを lambda フォームに変換する。_ で始まるシンボルがその lambda の引数。&rest は _rest を使う。

使い方はこんなかんじ。

;;(mapcar (lambda (x) * x x) '(1 2 3 4))
(mapcar #_(* _x _x) '(1 2 3 4))
;; => (1 4 9 16)

;;(mapcar (lambda (a b) (format nil "~d-~d=~d" b a (- b a)))
(mapcar #_(format nil "~d-~d=~d" _b _a (- _b _a))
        '(1 2 3 4)
        '(10 20 30 40))
;; => ("10-1=9" "20-2=18" "30-3=27" "40-4=36")

;;(mapcar (lambda (&rest rest) (apply #'* rest)) '(1 2 3) '(4 5 6) '(7 8 9))
(mapcar #_(apply #'* _rest) '(1 2 3) '(4 5 6) '(7 8 9))
;; => (28 80 162)

'#_(* _x _x)
;; => (_ (* _X _X))

(macroexpand-1 '#_(* _x _x))
;; => (LAMBDA (_X) (* _X _X))

実装はこんなかんじ。

(defun flatten (x)
  (labels ((rec (x acc)
             (cond ((null x) acc)
                   ((atom x) (cons x acc))
                   (t (rec (car x)
                           (rec (cdr x) acc))))))
    (rec x nil)))

(defgeneric head-p (whole part)
  (:method ((whole string) (part string))
    (let ((part-length (length part)))
      (and (>= (length whole) part-length)
           (string= whole part
                    :end1 part-length))))
  (:method ((whole symbol) (part string))
    (head-p (symbol-name whole) part)))

(defmacro _ (&rest body)
  (let ((syms
         (sort
          (remove-duplicates
           (remove-if-not (lambda (x)
                            (and (symbolp x)
                                 (head-p (symbol-name x) "_")))
                          (flatten body)))
          #'string<=
          :key #'symbol-name)))
    (let ((rest (find '_rest syms :key #'symbol-name :test #'string=)))
      (when rest
        (setq syms (append (remove rest syms) `(&rest ,rest)))))
    (find '_rest '(_a _rest _b))
    `(lambda ,syms
       ,@body)))

(set-dispatch-macro-character
 #\# #\_
 (lambda (stream subchar arg)
   (declare (ignore subchar arg))
   (let ((form (read stream t nil t)))
     (if (consp (car form))
       `(_ (progn ,@form))
       `(_ ,form)))))