unset-macro-character

CLには特定の文字をマクロ文字に昇格(?)させてreaderの動作を変化させる、
set-macro-characterという関数が用意されていますが、
逆にマクロ文字を普通の文字に降格させる関数(unset-macro-characterと命名)がありません。
readtableをいじり回したいお年頃の私にはこれがなかなかつらいです。
で、無いものを嘆いても仕方ないので作ってみました。

(defmacro unset-macro-character (char)
`(set-macro-character ,char
#'(lambda (s c)
(declare (ignore c))
(let ((next1 (peek-char nil s nil (code-char 0) t))
(next2 (peek-char t s nil (code-char 0) t)))
(multiple-value-bind (mc nt)
(get-macro-character next1)
(if (or (char= next1 (code-char 0))
(not (char= next1 next2))
(and mc (not nt)))
(values (intern (string ,char)))
(values
(intern
(format nil "~A~S" (string ,char) (read s nil nil t))))))))
t))

基本方針として、

1. 指定した文字(char)に新たな関数を割り当てる
(その際に、set-macro-characterの第3引数にtを与え、区切り文字でなくす。)
2. その関数は次の文字が
 A. 空白文字の場合、文字charのみからなるシンボルを返す
 B. マクロ文字で区切り文字の場合、Aと同様
 C. 文字の終端の場合、Aと同様
 D. それ以外の場合、文字charと次にreadしたもの(おそらく数かシンボル)をつなげたシンボルを返す

というものです。
面倒だったので、大文字、小文字の区別に付いては特に考えていません。
valuesは戻り値を1つにするために使っています。
(internは値を2つ返しますが、リーダマクロ関数は戻り値の数は0か1と決まっているためです)
(code-char 0)はちょっとまずいかも…
で、動かしてみました。

CL-USER> (let ((*readtable* (copy-readtable)))
(unset-macro-character #\,)
(read-from-string "(a,b, c,(d) ,e)"))
(|A,B,| |C,| (D) |,E|)

なんか知らんけど、上手く動いたぞ。
わーい。

気分はこんな感じ
ただ、あまり考えてないので、ちょっと複雑なものがやってくると、
正しく動作しないかもしれません。
(直後にディスパッチング文字なんかがやってくるとまずいかも…)

3 Responses to “unset-macro-character”

  1. quek より:

    set-macro-character に第三引数があったんですね。勉強になります。
    で、ふと思いついたのですが、こんなのでもうまくいくようです。

    (let ((*readtable* (copy-readtable nil)))
    (set-macro-character #\, nil t)
    (read-from-string "(a,b, c,(d) ,e)"))
    
  2. zick より:

    残念ながらCLISPでは「NILは関数じゃない」と怒られました。
    その方法で出来たら一番楽なんですけどね。

  3. quek より:

    なるほど、nil をセットできるのは処理系依存でしたか。

Leave a Reply