Hatena::Groupcadr

kozima の日記

2009-01-10

#` を書いてみた

18:48

g:cadr:id:g000001:20090105:1231153708 で紹介されている #` が面白そうなので作ってみました。細かい仕様がわからないので、わりと適当に。

  • comma が連続しないでネストした場合のことは考えていない
  • 普通の backquote との共存は不可かも
(defpackage :sharp-backquote
  (:use :cl))

(in-package :sharp-backquote)

(defun expand (sexp bindings)
  `(progn
     ,@(let ((vars (mapcar #'car bindings)))
         (apply #'mapcar
                (lambda (&rest vals)
                  (sublis (mapcar #'cons vars vals) sexp))
                (mapcar #'cdr bindings)))))

(defun parse-sharp-backquote (sexp)
  (let (bindings)
    (labels ((parse (sexp depth)
             (cond ((atom sexp) sexp)
                   ((and (eq (car sexp) 'comma)
                         (= depth (cadr sexp)))
                    (let ((v (gensym)))
                      (push (cons v (caddr sexp)) bindings)
                      v))
                   ((eq (car sexp) 'sharp-backquote)
                    (cons 'sharp-backquote
                          (parse (cdr sexp) (1+ depth))))
                   (t (mapcar (lambda (x) (parse x depth)) sexp)))))
      (let ((x (parse sexp 1)))
        (values x bindings)))))

(defmacro sharp-backquote (sexp)
  (multiple-value-call #'expand
    (parse-sharp-backquote sexp)))

(defun sharp-backquote-reader (stream char n)
  (declare (ignore char n))
  (multiple-value-bind (function non-terminating-p)
      (get-macro-character #\, *readtable*)
    (unwind-protect
        (progn
          (set-macro-character #\, #'comma-reader nil *readtable*)
          `(sharp-backquote ,(read stream t nil t)))
      (set-macro-character #\, function non-terminating-p *readtable*))))

(defun comma-reader (stream char)
  (loop for c = (peek-char nil stream t nil t)
    while (char= char c)
    count t into n do (read-char stream)
    finally (return `(comma ,(1+ n) ,(read stream t nil t)))))

(set-dispatch-macro-character #\# #\` #'sharp-backquote-reader)

#`#`(print (* ,(5 7) ,,(11. 13.)))
; -> 55
;    77
;    65
;    91

ちなみにパッケージ定義以外の部分は作ったときと同じ順番で書いてあります。