Common Lisp で Brainf*ck コンパイラ

どう書く？org の「BFコンパイラー」をやってみました。
Common Lisp での回答はすでに出ていますが、今回はマクロキャラクタを使ってやってみます。
お題は「BFで書かれたソースを、同じ言語に変換するコンパイラー」ですが、マクロキャラクタでリードテーブル（*readtable*）を拡張し言語（Common Lisp）自体が Brainf*ck のソースそのままをロード（load）、コンパイル（compile-file）できるようにします（といっても、セットしたマクロキャラクタにしたがいリーダーが自動的に CL に変換してくれているのですが）。。
SBCL のコンパイラはネイティブコードにコンパイルしてくれるので、Brainf*ck のソースもネイティブコードにコンパイルしている、と言えるのかもしれません;)

(defparameter *memory* nil  "メモリ")

(defparameter *ptr* 0 "ポインタ")

(defun init-bf-env ()
  "実行環境の初期化を行います。"
  (setf *memory*
        (make-array 1 :initial-element 0 :adjustable t :fill-pointer 1)
        *ptr* 0))

(define-symbol-macro *-*ptr* (aref *memory* *ptr*))

(defun make-bf-readtable ()
  (let ((*readtable* (copy-readtable nil)))
    (loop for (char . fun) in
         `((#\/ . ,#'(lambda (stream char)
                       (declare (ignore char))
                       (do () ((char= (read-char stream nil #\Newline t)
                                      #\Newline)))
                       (values)))
           (#\> . ,#'(lambda (stream char)
                       (declare (ignore stream char))
                       `(when (<= (length *memory*) (incf *ptr*))
                          (vector-push-extend 0 *memory*))))
           (#\< . ,#'(lambda (stream char)
                       (declare (ignore stream char))
                       `(decf *ptr*)))
           (#\+ . ,#'(lambda (stream char)
                       (declare (ignore stream char))
                       `(incf *-*ptr*)))
           (#\- . ,#'(lambda (stream char)
                       (declare (ignore stream char))
                       `(decf *-*ptr*)))
           (#\. . ,#'(lambda (stream char)
                       (declare (ignore stream char))
                       `(write-char (code-char *-*ptr*))))
           (#\, . ,#'(lambda (stream char)
                       (declare (ignore stream char))
                       `(setf *-*ptr* (char-code (read-char)))))
           (#\[ . ,#'(lambda (stream char)
                       (declare (ignore char))
                       `(loop until (zerop *-*ptr*)
                           do (progn ,@(read-delimited-list #\] stream t))))))
       do (set-macro-character char fun))
    (set-macro-character #\] (get-macro-character #\)) nil)
    *readtable*))

;; テスト。*readtable* を設定して load する。
(let ((*readtable* (make-bf-readtable)))
  (init-bf-env)           ;実行時には *memory* と *ptr* の初期化が必要
  (load #p"hello-world.bf"))

;; もちろんコンパイルもできます。
(let ((*readtable* (make-bf-readtable)))
  (compile-file #p"hello-world.bf"))

;; コンパイルしたものを実行。速いです!!
(progn (init-bf-env)      ;実行時には *memory* と *ptr* の初期化が必要
       (load "hello-world.fasl"))

実行前に (init-bf-env) が必要なのがちょっとわずらわしいですね。
dispatching macro character を使えばそのへんを含めた上で、Common Lisp のソースに Brainf*ck のソースを埋め込む、といったこともできるでしょう。