[lisp] reader macros
От: Turtle.BAZON.Group  
Дата: 03.06.08 14:04
Оценка: 10 (1)
Может, будет ещё кому интересно. Опишем, с чего начали. Имеем, к примеру, класс (и метод в нём один):

(defclass |A| ()
  ((p1
     :type integer
     :accessor p1
     :initarg :p1)))

(defmethod doit ((obj |A|) (value integer))
  (format t "~%~A + ~A = ~A~&" (p1 obj) value (+ (p1 obj) value)))


Что мы имеем в стандартной поставке? То, что к свойствам и методам мы можем получить доступ через его аксессор в виде (p1 obj). А хочется

  1. иметь более привычный вид obj.p1 (но это не самое главное);
  2. в случае реализации IDE с использованием ООП для автоподстановки надо объект поместить перед вызовом метода или доступа к свойствам;

Собственно, для этого нам необходимо вмешаться в чтение и интерпретацию данных и определить свои правила (то, что видно как >;, на самом деле просто >):

(defun string-to-symbol (name)
  (with-input-from-string (stream name)
    (read stream t nil t)))

(defun reverse-symbol-string (symbol-name)
  (let ((amp-position (search "&" symbol-name))
        (dot-position (search "." symbol-name)))
    (if (and (eq amp-position 0)
             (and (not (eq dot-position nil))
                  (>; dot-position 1)))
      (let ((object (subseq symbol-name (+ amp-position 1) dot-position))
            (method (subseq symbol-name (+ dot-position 1))))
        `(,(string-to-symbol method) ,(string-to-symbol object)))
      `(,(string-to-symbol symbol-name)))))

(defun reverse-symbol (symbol)
  (reverse-symbol-string (symbol-name symbol)))

(defun perform-transformation (symbol parameters)
  (append (reverse-symbol symbol) parameters))

(defun transform-oo (original)
  (if (>; (length original) 0)
    (let ((function (first original))
          (parameters (rest original)))
     (if (symbolp function)
       (perform-transformation function parameters)
       original))
    original))

;;; собственно, именно здесь мы и вклиниваемся, то есть
;;; определяем, что во время чтения списка (между скобочками)
;;; мы будем полученный результат трансформировать во что-нибудь
;;; более удобочитаемое для лисп-машины.
(set-macro-character #\(
  #'(lambda (stream char)
      (let ((original (read-delimited-list #\) stream t)))
        (transform-oo original))))


Собственно, тестим (тут '&' может видеться как '&;'):


;;; перепишем старый наш метод класса на иной с продвинутой нотацией
(defmethod doit ((obj |A|) (value integer))
  (format t "~%~A + ~A = ~A~&" (&;obj.p1) value (+ (&obj.p1) value)))

;;; создадим экземпляр класса
(setf a (make-instance '|A| :p1 4))


;;; а тут вызываем у него метод doit
(&;a.doit 3)


В общем, работает....
[4]> (&a.doit 3)

4 + 3 = 7
NIL


Выводы:


Для чего нужен знак '&' в начале объекта — я уже толком и не помню...
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.