Posted 2016-09-04 11:43:43 GMT

David Moon氏が1974年に書いたエディタのソースコードにリーダーマクロの面白い使い方があったのをふと思い出しました。

コードはMACLISPですが、

( setsyntax '/~ 'macro ' ( lambda nil ( implode ( cons '+ ( nconc ( exploden ( read ) ) ' ( + ) ) ) ) ) ) (defun ~car nil (or (atom it) (progn (setq ~stack (cons (cons it 'car) ~stack)) (setq it (car it)) nil)))

のようなものです。

Common Lispにすると、

( set-macro-character #\~ ( lambda ( strm char ) ( declare ( ignore char ) ) ( intern ( concatenate 'string "+" ( string ( read strm T nil T ) ) "+" ) ) ) )

という所でしょうか。

これで

( defun ~fib ( n ) ( if ( < n 2 ) n ( + ( ~fib ( 1- n ) ) ( ~fib ( - n 2 ) ) ) ) )

と書いたものは、

( defun +fib+ ( n ) ( if ( < n 2 ) n ( + ( +fib+ ( 1- n ) ) ( +fib+ ( - n 2 ) ) ) ) )

のように展開されます。

プログラムが内部で利用するシンボル名が他のシンボル名とバッティングしないようにしたものだと思いますが、あまりこういう例はないと思いますし面白いです。

応用

長いパッケージ名を省略して記述する

何か応用できないか考えてみましたが、長いパッケージ名を省略して記述するのに使ったらどうなるか試してみました。

( make-package :abcdefghijklmnopqrstuvwxyz :use ' ( ) ) (defvar *a-package* (find-package :abcdefghijklmnopqrstuvwxyz)) (defparameter *a-prefix* :demo-) (defparameter *a-postfix* :-demo) (set-macro-character #\~ (lambda (strm char) (declare (ignore char)) (intern (concatenate 'string (string *a-prefix*) (string (read strm T nil T)) (string *a-postfix*)) *a-package*))) (defun ~fib (n) (if (< n 2) n (+ (~fib (1- n)) (~fib (- n 2))))) ===> (defun abcdefghijklmnopqrstuvwxyz::demo-fib-demo (n) (if (< n 2) n (+ (abcdefghijklmnopqrstuvwxyz::demo-fib-demo (1- n)) (abcdefghijklmnopqrstuvwxyz::demo-fib-demo (- n 2)))))

パッケージに加え接頭辞、接尾辞も付けられます。

まあ工夫すれば何かに使えるかもしれないです。

ファイルローカルなUninterned Symbolを記述するのに使う

〈ファイルローカルなUninterned Symbol〉ってなんだという感じですが、Uninterned Symbolは、読み取りの度に異なったシンボルになるので、同じ名前なら同じシンボルが返ってくる記法を実現しようというアイデアです。

( defvar *obtab* ( make-hash-table :test #'equal ) ) (defun intern-file-local (sym-or-string) (or (gethash (string sym-or-string) *obtab*) (setf (gethash (string sym-or-string) *obtab*) (make-symbol (typecase sym-or-string (STRING sym-or-string) (SYMBOL (string sym-or-string))))))) (set-macro-character #\_ (lambda (strm char) (declare (ignore char)) (intern-file-local (read strm T nil T))) T)

これで、

(defun _tak (x y z) (if (<= x y) z (_tak (_tak (1- x) y z) (_tak (1- y) z x) (_tak (1- z) x y))))

のようなものは、

( defun #:tak ( x y z ) ( if ( <= x y ) z ( #:tak ( #:tak ( 1- x ) y z ) ( #:tak ( 1- y ) z x ) ( #:tak ( 1- z ) x y ) ) ) )

となりますが、 #:tak は全て同じシンボルであることがミソです。

また、ファイルローカルといっていますが、コードをみて分かるように、別にファイルローカルではありません。

*readtable の変わり目としてファイルが一つの単位とすることが多いので、そんな感じの名前にしてみました。

クラスのスロット名で使うと、単に #:foo と記述したのと違って change-class でのスロットの保持ができるなと思いました(まあ、あまり活用できなそうですが)

( defclass foo ( ) ( ( _x :initform 0 ) ( _y :initform 1 ) ( _z :initform 2 ) ) ) (defclass bar () ((z :initform 0) (_x :initform 20) (y :initform 0))) (describe (change-class (make-instance 'bar) 'foo)) ⊳ #<foo 40200CDEDB> is a foo ⊳ x 20 ⊳ y 1 ⊳ z 2

まとめ

リーダーマクロでシンボルの略記ですが、使い方によっては便利な気がします。

あるパッケージのグループに属するシンボルを共通の接頭辞で記述する

階層パッケージの真似事

等々も実現できるでしょう。

何か活用できそうなものを発見したら、またエントリーを書いてみたいと思います。

■

