超リードマクロに対抗してchar-codeの限界までリードマクロ

CLerはもっと他人のネタに反応すべきらしいので対抗してみた。

元ネタは @nitro_idiot さん の:　SBCLのリーダを上書きして"超リードマクロ"を実装

組み込みのリーダを書き換えるのは敷居が高いので、ごく普通の方法にしました。

正規表現ライブラリのcl-ppcreを利用していますが、それ以外はごく標準的なCommon Lispです。

私はSBCLで動かしましたが、CL処理系なら大抵は動くのではないでしょうか。

(asdf:oos 'asdf:load-op :cl-ppcre)

(defun range-symbol-name-p (str)
  (and (= (length (cl-ppcre:all-matches "\\.\\." str)) 2)
       (= (length (cl-ppcre:split "\\.\\." str)) 2)))

(defun range-name->symbols (str)
  (mapcar #'read-from-string (cl-ppcre:split "\\.\\." str)))

(let ((old (copy-readtable)))
  (defun range-reader (stream ch1)
    (unread-char ch1 stream)
    (if (let ((*readtable* old)) (get-macro-character ch1))
	(let ((*readtable* old)) (read stream))
	(let ((*readtable* old))
	  (let ((sexp (read stream)))
	    (if (and (symbolp sexp)
		     (range-symbol-name-p (format nil "~A" sexp)))
		(let ((syms (range-name->symbols (format nil "~A" sexp)))
		      (tmp (gensym)))
		  `(loop
		      :for ,tmp :from ,(first syms) :to ,(second syms)
		      :collect ,tmp))
		sexp))))))

(let ((old (copy-readtable)))
  (defun enable-range-reader ()
    (loop
       :for i :from 0 :below char-code-limit
       :do (let ((ch (code-char i)))
	     (unless (or (get-macro-character ch)
			 (find ch '(#\Space #\Return #\Newline
				    #\Tab #\Linefeed #\Page
				    #\Backspace)))
	       (set-macro-character ch #'range-reader)))))
  (defun disable-range-reader ()
    (setf *readtable* old)))


;;; example
(enable-range-reader)

'0..10
;;=> (LOOP :FOR #:G1473 :FROM 0 :TO 10
;;       :COLLECT #:G1473)
(remove-if #'oddp 0..10)
;;=> (0 2 4 6 8 10)

おかしい。仕様に乗っ取ったやり方のはずなのにアレゲな気配がぷんぷんする・・・。