next up previous
Next: 練習問題 Up: 15 CLOSのクラスシステムの実現 Previous: 15.6 Sendの実現

15.7 例


  (defclass* rectangle ()
    (height width))
  
  (defclass* circle ()
    (radius))
  
  (defmethod* area ((x rectangle))
    (* (slot-value* x 'height)
       (slot-value* x 'width)))
  
  (defmethod* area ((x circle))
    (* pi (expt (slot-value* x 'radius) 2)))
という定義を行って,
>   (setq c (make-instance* 'circle))
#<CLOSURE :LAMBDA (SELF X &REST ARGS)
  (LET ((LOCAL-VAR-FUNCTION (GETHASH X VAR-STORE)))
   (IF LOCAL-VAR-FUNCTION (APPLY LOCAL-VAR-FUNCTION ARGS)
    (LET ((METHOD (FIND-METHOD* X 'CIRCLE)))
     (IF METHOD (APPLY METHOD (CONS SELF ARGS))
      (ERROR "~a undefined method for class ~a"
             X 'CIRCLE)))))>

>   (setq r (make-instance* 'rectangle))
#<CLOSURE :LAMBDA (SELF X &REST ARGS)
  (LET ((LOCAL-VAR-FUNCTION (GETHASH X VAR-STORE)))
   (IF LOCAL-VAR-FUNCTION (APPLY LOCAL-VAR-FUNCTION ARGS)
    (LET ((METHOD (FIND-METHOD* X 'RECTANGLE)))
     (IF METHOD (APPLY METHOD (CONS SELF ARGS))
      (ERROR "~a undefined method for class ~a"
             X 'RECTANGLE)))))>

>   (setf (height r) 2 (width r) 3)
3
>   (setf (radius c) 3)
3
> (radius c)
3
> (slot-value* c 'radius)
3
> (area c)
28.274333882308139147L0
> (area r)
6


generated through LaTeX2HTML. M.Inaba 平成18年5月6日