#xyzzy バッファの lisp ソースから式の書いてあった位置を覚えつつ読み込む

gistfile1.lisp

;;; 式の位置を記録しながら読み込む

(require "cmu_loop")

(defun read-forms-with-code-position (buffer &optional print-debug-info)
  (with-input-from-buffer (buffer (point-min))
    (let ((*readtable* (copy-readtable *readtable*))
          (positions (make-hash-table))
          (*read-depth* 0))
      (declare (special *read-depth*))
      (labels ((point-in ()
                 (buffer-stream-point *standard-input*))
               (debug (fmt &rest args)
                 (when print-debug-info
                   (apply #'format t fmt args)))
               (read-open (in char &optional start)
                 (unless start (setf start (1- (point-in))))
                 (let ((sub-forms nil))
                   (debug "~V,0T* form start at ~A...~%" *read-depth* start)
                   (let ((*read-depth* (+ *read-depth* 2)))
                     (declare (special *read-depth*))
                     (while (not (eql (peek-char nil in) #\)))
                       (let ((form (read in t nil t)))
                         (debug "~V,0T- ~S~%" *read-depth* form)
                         (push form sub-forms))))
                   (read-char in t nil t)
                   (let ((form (nreverse sub-forms))
                         (end  (point-in)))
                     (let ((*print-length* 3))
                       (debug "~V,0T=> ~S~%~V,0T;; form terminated at ~A~%"
                              *read-depth* form *read-depth* end))
                     (setf (gethash form positions) (cons start end))
                     form))))
        (set-macro-character #\( #'read-open)
        (values (butlast
                 (loop for form = (read *standard-input* nil #1='#:eof)
                   until (eql form #1#)
                   collect form))
                positions)))))

#| 試してみる
;; buffer は↑が書いてあるバッファ
(multiple-value-setq (forms table)
    (read-forms-with-code-position buffer))
=> ((require "cmu_loop")
    (defun read-forms-with-code-position (buffer &optional print-debug-info)
      (with-input-from-buffer (buffer (point-min))
        ...)))

(gethash (first forms) table)
=> (21 . 41)
=> t

(third (second forms))
=> (buffer &optional print-debug-info)

(gethash * table)
=> (80 . 115)
=> t
|#

バッファを渡して全部読み込むというのは使いにくいような・・・