#:g1: リーダーマクロでシンボルの略記をする

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)   ;if done car'ing, stop and return t
        (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

まとめ

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

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

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

■

HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus