第拾肆章學習 Lisp 3rd Edition, Winston & Horn

CLASSES AND GENERIC FUNCTIONS
---------------------------------------------------------------
YOU CAN MAKE ORDINARY PROCEDURES DATA DRIVEN， ALBEIT AWKWARDLY

(defstruct triangle
  (base 0)
  (altitude 0))

(defstruct rectangle
  (width 0)
  (height 0))

(defstruct circle
  (radius 0))

(defun area (figure)
  (cond ((trianle-p figure)
         (* 1/2
            (triangle-base figure)
            (triangle-altitude figure)))
        ((rectangle-p figure)
         (* (rectangle-width figure)
            (rectangle-height figure)))
        ((circle-p figure)
         (* pi (expt (circle-radius figure) 2)))))

(defun area (figure)
  (cond ((trianle-p figure)
         (* 1/2
            (triangle-base figure)
            (triangle-altitude figure)))
        ((rectangle-p figure)
         (let ((a (rectangle-width figure))
               (b (rectangle-height figure)))
           (if (= a b)
               (expt a 2)
               (* a b))))
        ((circle-p figure)
         (* pi (expt (circle-radius figure) 2)))))
 
(defun triangle-area (figure)
  (* 1/2
     (triangle-base figure)
     (triangle-altitude figure)))

(defun rectangle-area (figure)
  (* (rectangle-width figure)
     (rectangle-height figure)))

(defun circle-area (figure)
  (* pi (expt (circle-radius figure) 2)))

(defun area (figure)
  (cond ((triangle-p figure)
         (triangle-area figure))
        ((rectangle-p figure)
         (rectangle-area figure))
        ((circle-p figure)
         (circle-area figure))))
--------------------------------------------------------------

METHODS ARE PROCEDURES SELECTED FROM GENERIC FUNCTIONS BY ARGUMENT TYPES

(defmethod area ((figure triangle))    ;Method for triangles.
  (* 1/2
     (triangle-base figure)
     (triangle-altitude figure)))

(defmethod area ((figure rectangle))   ;Method for rectangles.
  (* (rectangle-width figure)
     (rectangle-height figure)))

(defmethod area ((figure circle))      ;Method for circles.
  (* pi (expt (circle-radius figure) 2)))

* (setf triangle (make-triangle :base 2 :altitude 3))
* (setf rectangle (make-rectangle :width 5 :height 7))
* (setf circle (make-circle :radius 11))

* (area triangle)        ;Matches triangle method.
3
* (area rectangle)       ;Matches rectangle method.
35
* (area circle)          ;Matches circle method.
380.13
------------------------------------------------------------------

CLASS RESEMBLE STRUCTURE TYPES BUT RESONATE BETTER WITH GENERIC FUNCTIONS

(defclass <class name> <list of direct superclass>    ;Basic template.
  ((<slot name 1> :ancestor <accessor procedure 1>
                  :initform <initial-value form 1>
                  :initarg <argument marking symbol 1>)
   ...
   (<slot name n> :accessor <accessor procedure n>
                  :initform <initial-value form n>
                  :initarg <argument marking symbol n>)))

(make-instance '<class name>)

(defclass article()
  ((title :accessor article-title :initarg :title)
   (author :accessor article-author :initarg :author)))

(defclass computer-article (article) ())
(defclass business-article (article) ())
(defclass political-article (article) ())
--------------------------------------------------------------------

AND NONOPTIONAL ARGUMENT'S CLASS CAN HELP SELECT A METHOD

(defclass friend ()
  ((name :accessor friend-name :initarg :name)))
(defclass hacker-friend (friend) ())
(defclass entrepreneur-friend (friend) ())
(defclass philosopher-friend (friend) ())

(setf articles
      (list (make-instance 'business-article
                           :title "Memory Prices Down")
            (make-instance 'computer-article
                           :title "Memory Speeds Up")
            (make-instance 'political-article
                           :title "Memory Impugned")))

(setf friends
      (list (make-instance 'hacker-friend :name 'Dan)
      (list (make-instance 'hacker-friend :name 'Gerry)
      (list (make-instance 'entrepreneur-friend :name 'Philip)
      (list (make-instance 'philosopher-friend :name 'David)))

(defun print-notification (article friend)
  (format t "~%Tell ~a about \"~a.\""
          (friend-name friend)
          (article-title article))
  t)

* (dolist (friend friends)
    (dolist (article articles)
      (print-notification article friend)))
TELL DAN about "Memory Prices Down."
TELL DAN about "Memory Speeds Up."
TELL DAN about "Memory Impugned."
TELL Gerry about "Memory Prices Down."
TELL Gerry about "Memory Speeds Up."
TELL Gerry about "Memory Impugned."
TELL PHILLIP about "Memory Prices Down."
TELL PHILLIP about "Memory Speeds Up."
TELL PHILLIP about "Memory Impugned."
TELL DAVID about "Memory Prices Down."
TELL DAVID about "Memory Speeds Up."
TELL DAVID about "Memory Impugned."
NIL

(dolist (friend friends)
  (dolist (article articles)
    (process friend article)))

(defmethod process ((friend hacker-friend)
                    (article computer-article))
  (print-notification article friend))

(defmethod process ((friend entrepreneur-friend)
                    (Article business-article))
  (print-notification article friend))
-------------------------------------------------------------
CLASSES ENABLE METHOD INHERITANCE

(defmethod process ((friend philosopher-friend)
                    (article article))
  (print-notification article friend))

(defmethod process ((friend friend)
                    (article article)))

(defmethod process ((friend t)
                    (article t)))

(defmethod process (friend article))

* (dolist (friend friends)
    (dolist (article articles)
      (process friend article)))
TELL DAN about "Memory Speeds up."
TELL Gerry about "Memory Speeds Up."
TELL PHILLIP about "Memory Prices Down."
TELL DAVID about "Memory Prices Down."
TELL DAVID about "Memory Speeds Up."
TELL DAVID about "Memory Impugned."
NIL

题题题题题题题题题题题题题题题题题题题题题题题题题题题题题题题题题

14-1: Suppose you learn that philosophers do not like computer articles.
Write one new method that prevents you from sending them notices about
computer articles without preventing any other notices from getting through.
-----------------------------------------------------------------------
14-2: Now suppose all of your friends are interested in music.  Create
a new class of article for music and write a PROCESS method that tells
everyone about them without disturbing anything else.
----------------------------------------------------------------------

THE MOST SPECIFIC METHOD TAKES PRECEDENCE OVER THE OTHERS

(defclass stocks-article (business-article) ())
(defclass new-stocks-article (stocks-article) ())

(defmethod process ((friend entrepreneur-friend)
                    (article stocks-article)))

(defmethod process ((friend entrepreneur-friend)
                    (article new-stocks-article))
  (print-notification article friend))

* (process
    (make-instance 'entrepreneur-friend :name 'jack)
    (make-instance 'stocks-article :title "Stock Prices Up"))
NIL

* (process
    (make-instance 'entrepreneur-friend :name 'jill)
    (make-instance 'new-stocks-article 
                   :title "New Stock Prices Up"))
Tell Jill about "New-Stock Prices Up."
T
----------------------------------------------------------------

PARAMETER ORDER HELPS DETERMINE METHOD PRECEDENCE

(defclass retired-hacker-friend (hacker-friend) ())

(defmethod process ((friend retired-hacker-friend)
                    (article business-article))
  (print-notification article friend))

(defmethod process ((friend hacker-friend)
                    (article stocks-article)))

(process
  (make-instance 'retired-hacker-friend :name 'test-frined)
  (make-instance 'stocks-article :title "Test Article"))

* (process
    (make-instance 'retired-hacker-friend :name 'test-friend)
    (make-instance 'stocks-article :title "Test Article"))
Tell TEST-FRIEND about "Test Article."
T
----------------------------------------------------------

SIMPLE RULES APPROXIMATE THE COMPLICATED CLASS PRECEDENCE ALGORITHM

(defclass computer-political-article
  (computer-article political-article)
  ())

(defmethod process ((friend hacker-friend)
                    (article computer-article))
  (print-notification article friend))

(defmethod process ((friend hacker-friend)
                    (article political-article)))

(process
  (make-instance 'hacker-friend :name 'test-friend)
  (make-instance 'computer-political-article
                 :title "Computer Politics Article Test"))

* (process
    (make-instance 'hacker-friend :name 'test-friend)
    (make-instance 'computer-political-article
                   :title "Computer Politics Article Test"))
Tell TEST-FRIEND about "Computer Politics Article Test."
T

題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題

14-3: Suppose you define a class for articles about the politics
of computers, the POLITICAL-COMPUTER-ARTICLE class:

(defclass political-computer-article
  (political-article computer-article)
  ())

What does the class precedence list look like for the second argument
when evaluating the following form? Is anything printed?

(process
  (make-instance 'hacker-friend : name 'test-friend)
  (make-instance 'computer-political-article
                 :title "Computer Political Article Test"))
------------------------------------------------------------------

METHOD CAN BE SPECIALIZED TO INDIVIDUAL INSTANCES

(setf philip (third friends))
(defmethod process ((friend (eql philip))
                    (article article)))

題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題

14-4: Suppose that there is a particular article that you want to
include in your list of articles, but you do not want to tell anyone
about it:

(setf special-case-article
      (make-instance 'business-article :title "Squashing Friends"))

Next you create the following method:

(defmethod process ((friend friend)
                    (article (eql special-case-article))))

To your surprise, however, notifications about the articles are still
sent.  Why?

解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解

14-1:
(defmethod process ((friend philosopher-friend)
                    (article computer-article)))
---------------------------------------------------------
14-2:
(defmethod music-article (article) ())

(defmethod process ((friend friend) (article music-article))
   (print-notification article friend))
-------------------------------------------------------------
14-3: The class precedence list is as follows:
political-computer-article            ;Split
political-article                     ;Leftmost superclass.
computer-article                      ;Rightmost superclass.
article                               ;Join
standard-object                       ;Implicit superclass.
t                                     ;Implicit superclass.

No reminder is printed:

* (process
    (make-instance 'hacker-friend : name 'test-friend)
    (make-instance 'political-computer-article
                   :title "Political Computer Article Test"))
NIL
---------------------------------------------------------------------
14-4: The reason notifications are still sent is that the first
argument determines method precedence when there is more than one
applicable method.  When the PROCESS generic function is applied to an
entrepreneur friend and to the special-case article, one of the applicable
methods is the one specialized to entrepreneur friends and business
articles.  This method takes precedence over the new one because its first
parameter is more specialized.