Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2009-02-19

defmacro!に対抗してdefmacro#

| 17:23 | defmacro!に対抗してdefmacro# - わだばLisperになる を含むブックマーク はてなブックマーク - defmacro!に対抗してdefmacro# - わだばLisperになる

自分的には、Let Over Lambdaで最も使えるマクロは、defmacro!に思えますが、この路線を一歩進めて、o!fooや、g!fooという名前でgensymへ置換するシンボルを表わすのではなくて、インターンされない、#:fooのようなシンボルで表現してみました。

インターンされてないシンボルの場合、字面が同じでも同じシンボルではないのですが、この特徴が生きているところ(g!fooとo!fooを使い分けなくて良い)もあれば、これが問題になり対策をしているところもあります(reduce-unintern-sym)。

ごちゃごちゃしているものの、なんとなく自分の意図したものはできました。

しかし、自分で作っておきながらなんですが、なんか怪しいのであまり使おうとは思いません(笑)

(import 'mycl-util:flatten)

(defun reduce-unintern-sym (sym expr wo)
  (subst sym sym
         expr
         :test (lambda (x y)
                 (and (symbolp y)
                      (not (symbol-package y))
                      (not (member y wo))
                      (string= x y)))))

(defmacro *defmacro/# (wo name args &rest body)
  (let ((syms (remove-duplicates
               (remove-if #'symbol-package
                          (flatten body))
               :test #'string=)))
    `(defmacro ,name ,args
       (let ,(mapcar
              (lambda (s)
                `(,s (gensym ,(symbol-name s))))
              syms)
         ,@(reduce (lambda (res x)
                     (reduce-unintern-sym x res wo))
                   syms
                   :initial-value body)))))

(defmacro defmacro# (name args &rest body)
  (let* ((os (remove-if #'symbol-package args))
         (gs (mapcar #'copy-symbol os)))
    `(*defmacro/# ,os ,name ,args
       `(let ,(mapcar #'list (list ,@gs) (list ,@os))
          ,(progn ,@body)))))

動作

(defmacro# square (#:x)
  `(* ,#:x ,#:x))

;; 展開
(let ((x 3))
  (square (incf x)))
;=>
(LET ((X 3))
  (LET ((#:X2531 (INCF X)))
    (* #:X2531 #:X2531)))