#:g1: macro-levelの紹介

Posted 2014-05-21 07:23:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の141日目です。

macro-levelとはなにか

 macro-levelは、Jean-Philippe Paradis氏作の定義フォーム系のユーティリティです。

パッケージ情報

パッケージ名macro-level
Quicklisp
プロジェクトサイトmacro-level | Libraries | HexstreamSoft
CLiKihttp://cliki.net/macro-level
Quickdocshttp://quickdocs.org/macro-level

インストール方法

(ql:quickload :macro-level)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 文章での説明より動作例を例をみるのが早いと思うのでコード例を紹介すると、

(PROGN
 (DEFUN S8VECTOR () 'S8VECTOR)
 (DEFUN S8VECTOR? () 'S8VECTOR?)
 (DEFUN S8VECTOR-LENGTH () 'S8VECTOR-LENGTH)
 (DEFUN S8VECTOR-REF () 'S8VECTOR-REF)
 (DEFUN S8VECTOR-SET! () 'S8VECTOR-SET!)
 (DEFUN S8VECTOR->LIST () 'S8VECTOR->LIST)
 (DEFUN MAKE-S8VECTOR () 'MAKE-S8VECTOR)
 (DEFUN LIST->S8VECTOR () 'LIST->S8VECTOR)
 (DEFUN S16VECTOR () 'S16VECTOR)
 (DEFUN S16VECTOR? () 'S16VECTOR?)
 (DEFUN S16VECTOR-LENGTH () 'S16VECTOR-LENGTH)
 (DEFUN S16VECTOR-REF () 'S16VECTOR-REF)
 (DEFUN S16VECTOR-SET! () 'S16VECTOR-SET!)
 (DEFUN S16VECTOR->LIST () 'S16VECTOR->LIST)
 (DEFUN MAKE-S16VECTOR () 'MAKE-S16VECTOR)
 (DEFUN LIST->S16VECTOR () 'LIST->S16VECTOR)
 (DEFUN S32VECTOR () 'S32VECTOR)
 (DEFUN S32VECTOR? () 'S32VECTOR?)
 (DEFUN S32VECTOR-LENGTH () 'S32VECTOR-LENGTH)
 (DEFUN S32VECTOR-REF () 'S32VECTOR-REF)
 (DEFUN S32VECTOR-SET! () 'S32VECTOR-SET!)
 (DEFUN S32VECTOR->LIST () 'S32VECTOR->LIST)
 (DEFUN MAKE-S32VECTOR () 'MAKE-S32VECTOR)
 (DEFUN LIST->S32VECTOR () 'LIST->S32VECTOR)
 (DEFUN S64VECTOR () 'S64VECTOR)
 (DEFUN S64VECTOR? () 'S64VECTOR?)
 (DEFUN S64VECTOR-LENGTH () 'S64VECTOR-LENGTH)
 (DEFUN S64VECTOR-REF () 'S64VECTOR-REF)
 (DEFUN S64VECTOR-SET! () 'S64VECTOR-SET!)
 (DEFUN S64VECTOR->LIST () 'S64VECTOR->LIST)
 (DEFUN MAKE-S64VECTOR () 'MAKE-S64VECTOR)
 (DEFUN LIST->S64VECTOR () 'LIST->S64VECTOR)
 (DEFUN U8VECTOR () 'U8VECTOR)
 (DEFUN U8VECTOR? () 'U8VECTOR?)
 (DEFUN U8VECTOR-LENGTH () 'U8VECTOR-LENGTH)
 (DEFUN U8VECTOR-REF () 'U8VECTOR-REF)
 (DEFUN U8VECTOR-SET! () 'U8VECTOR-SET!)
 (DEFUN U8VECTOR->LIST () 'U8VECTOR->LIST)
 (DEFUN MAKE-U8VECTOR () 'MAKE-U8VECTOR)
 (DEFUN LIST->U8VECTOR () 'LIST->U8VECTOR)
 (DEFUN U16VECTOR () 'U16VECTOR)
 (DEFUN U16VECTOR? () 'U16VECTOR?)
 (DEFUN U16VECTOR-LENGTH () 'U16VECTOR-LENGTH)
 (DEFUN U16VECTOR-REF () 'U16VECTOR-REF)
 (DEFUN U16VECTOR-SET! () 'U16VECTOR-SET!)
 (DEFUN U16VECTOR->LIST () 'U16VECTOR->LIST)
 (DEFUN MAKE-U16VECTOR () 'MAKE-U16VECTOR)
 (DEFUN LIST->U16VECTOR () 'LIST->U16VECTOR)
 (DEFUN U32VECTOR () 'U32VECTOR)
 (DEFUN U32VECTOR? () 'U32VECTOR?)
 (DEFUN U32VECTOR-LENGTH () 'U32VECTOR-LENGTH)
 (DEFUN U32VECTOR-REF () 'U32VECTOR-REF)
 (DEFUN U32VECTOR-SET! () 'U32VECTOR-SET!)
 (DEFUN U32VECTOR->LIST () 'U32VECTOR->LIST)
 (DEFUN MAKE-U32VECTOR () 'MAKE-U32VECTOR)
 (DEFUN LIST->U32VECTOR () 'LIST->U32VECTOR)
 (DEFUN U64VECTOR () 'U64VECTOR)
 (DEFUN U64VECTOR? () 'U64VECTOR?)
 (DEFUN U64VECTOR-LENGTH () 'U64VECTOR-LENGTH)
 (DEFUN U64VECTOR-REF () 'U64VECTOR-REF)
 (DEFUN U64VECTOR-SET! () 'U64VECTOR-SET!)
 (DEFUN U64VECTOR->LIST () 'U64VECTOR->LIST)
 (DEFUN MAKE-U64VECTOR () 'MAKE-U64VECTOR)
 (DEFUN LIST->U64VECTOR () 'LIST->U64VECTOR)
 (DEFUN F8VECTOR () 'F8VECTOR)
 (DEFUN F8VECTOR? () 'F8VECTOR?)
 (DEFUN F8VECTOR-LENGTH () 'F8VECTOR-LENGTH)
 (DEFUN F8VECTOR-REF () 'F8VECTOR-REF)
 (DEFUN F8VECTOR-SET! () 'F8VECTOR-SET!)
 (DEFUN F8VECTOR->LIST () 'F8VECTOR->LIST)
 (DEFUN MAKE-F8VECTOR () 'MAKE-F8VECTOR)
 (DEFUN LIST->F8VECTOR () 'LIST->F8VECTOR)
 (DEFUN F16VECTOR () 'F16VECTOR)
 (DEFUN F16VECTOR? () 'F16VECTOR?)
 (DEFUN F16VECTOR-LENGTH () 'F16VECTOR-LENGTH)
 (DEFUN F16VECTOR-REF () 'F16VECTOR-REF)
 (DEFUN F16VECTOR-SET! () 'F16VECTOR-SET!)
 (DEFUN F16VECTOR->LIST () 'F16VECTOR->LIST)
 (DEFUN MAKE-F16VECTOR () 'MAKE-F16VECTOR)
 (DEFUN LIST->F16VECTOR () 'LIST->F16VECTOR)
 (DEFUN F32VECTOR () 'F32VECTOR)
 (DEFUN F32VECTOR? () 'F32VECTOR?)
 (DEFUN F32VECTOR-LENGTH () 'F32VECTOR-LENGTH)
 (DEFUN F32VECTOR-REF () 'F32VECTOR-REF)
 (DEFUN F32VECTOR-SET! () 'F32VECTOR-SET!)
 (DEFUN F32VECTOR->LIST () 'F32VECTOR->LIST)
 (DEFUN MAKE-F32VECTOR () 'MAKE-F32VECTOR)
 (DEFUN LIST->F32VECTOR () 'LIST->F32VECTOR)
 (DEFUN F64VECTOR () 'F64VECTOR)
 (DEFUN F64VECTOR? () 'F64VECTOR?)
 (DEFUN F64VECTOR-LENGTH () 'F64VECTOR-LENGTH)
 (DEFUN F64VECTOR-REF () 'F64VECTOR-REF)
 (DEFUN F64VECTOR-SET! () 'F64VECTOR-SET!)
 (DEFUN F64VECTOR->LIST () 'F64VECTOR->LIST)
 (DEFUN MAKE-F64VECTOR () 'MAKE-F64VECTOR)
 (DEFUN LIST->F64VECTOR () 'LIST->F64VECTOR))

のような機械的な定義をマクロで生成するのにmacroletを利用することがありますが、

(macrolet ((tem ()
             `(progn
                ,@(arc:accum a
                    (dolist (s '(s u f))
                      (dolist (n '(8 16 32 64))
                        (let ((type (format nil "~A~AVECTOR" s n)))
                          (dolist (p '(|| ? -length -ref -set! ->list))
                            (let ((name
                                   (intern (format nil "~A~A" type p))))
                              (a `(defun ,name ,nil ',name))))
                          (dolist (p '(make- list->))
                            (let ((name
                                   (intern (format nil "~A~A" p type))))
                              (a `(defun ,name ,nil ',name)))))))))))
  (tem))

こんな感じに書くと、なんかインデントが深くなるので嫌、ということで、

(macro-level:macro-level 
  `(progn
     ,@(arc:accum a
         (dolist (s '(s u f))
           (dolist (n '(8 16 32 64))
             (let ((type (format nil "~A~AVECTOR" s n)))
               (dolist (p '(|| ? -length -ref -set! ->list))
                 (let ((name (intern (format nil "~A~A" type p))))
                   (a `(defun ,name () ',name))))
               (dolist (p '(make- list->))
                 (let ((name (intern (format nil "~A~A" p type))))
                   (a `(defun ,name () ',name))))))))))

こう書けるようにしたものです。

まとめ

 今回は、macro-levelを紹介してみました。
超一発ものでした。これだけのためにインストールするのも面倒な気がしますが、こういうのも面白いですね。

comments powered by Disqus