8-мавзу. Объектга йўналтирилган дастурлаш

Классы и экземпляры объектов
(defclass ob () (f1 f2 ...))
Это означает, что каждое вхождение объекта будет иметь поля-слоты f1 f2 ...
(Слот – это поле записи или списка свойств.)
Чтобы сделать представителя класса, мы вызываем общую функцию:
(setf с (make-instance 'ob))
Чтобы задать значение поля, используем специальную функцию:
(setf (slot-value c) 1223)
До этого значения полей были не определены.
Свойства слотов
Простейшее определение слота - это его имя.
Но в общем случае слот может содержать список свойств.
Внешне свойства слота специфицируются как ключевые параметры функции.
Это позволяет задавать начальные значения.
Можно объявить слот совместно используемым.
:allocation :class
Изменение такого слота будет доступно всем экземплярам объектов класса.
:documentation - свойство слота
Можно задать тип элементов, заполняющих слот.
Суперкласс
Нет необходимости все новые слоты создавать в каждом классе
;oop-compile
(defclass expr ()
((type :accessor td) (sd :accessor ft))
(:documentation "C-expression"))
(defclass un (expr)
; \_____суперкласс для унарных форм
((type :accessor td) ;; можно убрать ???
(sd :accessor ft)) ;; можно убрать ???
(:documentation "quote car *other *adr"))
(defclass bin (expr)
((type :accessor td)
(sd :accessor ft)
(sdd :accessor sd) )
(:documentation "cons + lambda let"))
(defclass trio (expr)
((type :accessor td)
(sd :accessor ft)
; (bin) ;; не объявлять sdd ???
(sdd :accessor sd)
(sddd :accessor td) )
(:documentation "if label"))
(defmethod texrp ((x expr) (nt atom))
(setf (slot-value x 'type) nt)
(setf (td x) nt) ;;--;; variant
(:documentation "объявляем тип выражения"))
(defmethod spread ((hd (eql 'QUOTE))
(tl expr))
(let ( (x (make-instance 'un)) )
(setf (ft x) (car tl))
(setf (td x) hd)
) (:documentation "распаковка выражения"))
(defmethod compl ((hd (eql 'QUOTE))
(tl expr))
(list 'LDC tl)
) (:documentation "сборка кода"))
(defmethod compl ((hd (eql 'CAR))
(tl expr))
(append (compl(ft tl) N) '(CAR))
) (:documentation "сборка кода"))
(defmethod spread ((hd (eql 'CONS))
(tl expr))
(let ( (x (make-instance 'bin)) )
(setf (ft x) ( car tl))
(setf (sd x) ( cadr tl))
(setf (td x) hd)
) (:documentation "распаковка выражения"))
(defmethod compl ((hd (eql 'CONS))
(tl bin) N )
(append (compl(sd tl) N) (compl(ft tl) N) '(CONS))
) (:documentation "сборка кода"))
(defmethod compl ((hd (eql '+))
(tl bin) N )
(append (compl(ft tl) N) (compl(sd tl) N) '(ADD))
) (:documentation "сборка кода"))
(defmethod spread ((hd (eql 'IF))
(tl expr))
(let ( (x (make-instance 'trio)) )
(setf (ft x) ( car tl))
(setf (sd x) ( cadr tl))
(setf (td x) ( caddr tl))
(setf (td x) hd)
) (:documentation "распаковка выражения"))
(defmethod compl ((hd (eql 'IF))
(tl expr) N )
(let ( (then (list (compl(sd tl) N) '(JOIN)))
(else (list (compl(td tl) N) '(JOIN))) )
(append (compl(ft tl) N) (list 'SEL then else) )
)(:documentation "сборка кода"))
(defmethod parh ((x expt))
(let (ftx (ft x))
(cond
((atom ftx) (spread 'ADR ftx))
((member (car ftx) '(QUOTE CAR CONS + IF LAMBDA LABEL LET))
(spread (car ftx) (cdr ftx))
(T (spread 'OTHER ftx) ))
)(:documentation "шаг разбора"))
;====test==========
(setf test1 (make-instance 'expr))
(texpr test1 'expr)
(setf (slot-value test1 'sd) (read))
()
(setf e1 (make-instance 'expr))
(setf e2 (make-instance 'expr))
(setf e3 (make-instance 'expr))
(print (tf e2))
(setf (slot-value e3 'type) 'expr)
(print (tf e3))
(setf (slot-value e3 'sd) '(quote const))
(defmethod ep ((x expr))
((lambda (xt)
(setf (slot-value x 'type) xt))
(car (slot-value x 'sd) )))
(print (ep e3))
(print (tf e3))
(print (td e3))
(print (sd e3))
(defmethod ep-q ((x (eql 'quote)) (y expr))
(setf y (make-instance 'un)))
(setf (slot-value y 'type) 'quote)
(setf (slot-value y 'sd) y)
))
(print (tf (e3 'sd)))
(print (tf e1))
(print(setf (slot-value e1 'type) (tf e1)))
(setf (slot-value e2 'sd) 'atom1)
(print (tf (sd e2)))
(print(setf (slot-value e3 'sd) '(quote const)))
(print (tf e3))
CLOS, естественно, использует модель обобщенных функций, но мы написали независимую модель, используя более старые представления, тем самым показав, что концептуально ООР – это не более чем перефразировка идей Лиспа. ООП - это одна из вещей, которую Лисп изначально умеет делать. Для функционального стиля программирования в переходе к ООП нет ничего неожиданного. Это просто небольшая конкретизация механизмов перебора ветвей функциональных объектов.