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-12-04

KMRCLを眺める (30) ppmx

| 22:20 | KMRCLを眺める (30) ppmx - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (30) ppmx - わだばLisperになる

今回は、KMRCLのmacros.lispの中からPPMXです。

一体なんだか良く分からないような名前ですが、動きからするとpretty print macro expand とかそういう辺りじゃないでしょうか。

恐らく、REPLで打つのに都合の良いように名前を短かくしたのだと思います。

定義は、

(defmacro ppmx (form)
  "Pretty prints the macro expansion of FORM."
  `(let* ((exp1 (macroexpand-1 ',form))
          (exp (macroexpand exp1))
          (*print-circle* nil))
     (cond ((equal exp exp1)
            (format t "~&Macro expansion:")
            (pprint exp))
           (t (format t "~&First step of expansion:")
              (pprint exp1)
              (format t "~%~%Final expansion:")
              (pprint exp)))
     (format t "~%~%")
     (values)))

こんな感じで、MACROEXPAND-1の結果とMACROEXPANDの結果の両方を表示しれくれるユーティリティです。

(DOTIMES (I 10)
  (PRINT I))

をPPMXにかけると

First step of expansion:
(DO ((I 0 (1+ I))) ((>= I 10) NIL) (DECLARE (TYPE UNSIGNED-BYTE I)) (PRINT I))

Final expansion:
(BLOCK NIL
  (LET ((I 0))
    (DECLARE (TYPE UNSIGNED-BYTE I))
    (TAGBODY
      (GO #:G2642)
     #:G2641
      (TAGBODY (PRINT I))
      (PSETQ I (1+ I))
     #:G2642
      (UNLESS (>= I 10) (GO #:G2641))
      (RETURN-FROM NIL (PROGN NIL)))))

NIL

という風に展開して表示されます。

今回のPPMXもSlimeから呼べると便利かもしれないということで、拡張を書いてみました。

今回は、拡張を定義するマクロを作り、それで定義してみています。

;; Emacs lisp
(defmacro define-slime-eval-and-grab-output (fn-name)
  (let ((expr (format "(prin1 (%s %%s))" fn-name))
        (main-fn (intern (format "slime-%s" fn-name)))
        (show-fn (intern (format "slime-show-%s" fn-name)))
        (eval-and-fn (intern (format "slime-eval-and-%s" fn-name)))
        (buffer-name (format "*SLIME %s*" (upcase (symbol-name fn-name)))))
    `(eval-after-load "slime"
       '(progn
          (defun ,main-fn ()
            (interactive)
            (,eval-and-fn
             ,(list 'list ''swank:eval-and-grab-output
                    `(format ,expr 
                             (slime-defun-at-point)))))
          (defun ,eval-and-fn (form)
            (slime-eval-async form 
                              (slime-rcurry #',show-fn
                                            (slime-current-package))))
          
          (defun ,show-fn (string package)
            (slime-with-popup-buffer (,buffer-name package t t)
              (lisp-mode)
              (princ (first string))
                (goto-char (point-min))))
            ',main-fn))))

;; kmrcl:ppmx
(define-slime-eval-and-grab-output kmrcl:ppmx)

define-slime-eval-and-grab-outputで、対話的なslime-kmrcl:ppmxというコマンドが定義されます。

Emacs lispだとバッククォートのネストが良く分からないことになるので、ネストを回避しましたが、随分読みにくくなります…。