\input 6001mac
%\input psfig
\addtolength{\textheight}{1cm}
%\addtolength{\topmargin}{-1cm}

\newcommand{\comment}[1]{}

\renewenvironment{lisp}{%
  \par
  \begin{minipage}[t]{\linewidth}
  \begin{list}{$\bullet$}{%
    \setlength{\topsep}{0in}
    \setlength{\partopsep}{0in}
    \setlength{\itemsep}{0in}
    \setlength{\parsep}{0in}
    \setlength{\leftmargin}{1.5em}
    \setlength{\rightmargin}{0in}
    \setlength{\itemindent}{0in}
  }\item[]
  \obeyspaces
  \obeylines \small\tt}{%
  \end{list}
  \end{minipage}
  \par
  }



\begin{document}

\psetheader{Fall Semester, 1996}
{Lecture Notes, October 24 -- Object Oriented Programming}

\subsubsection{Object-Oriented System - Version 1}
\comment{
\begin{lisp}
(define (make-speaker name)
  (lambda (message) 
    (cond ((eq? message 'NAME) (lambda () name))
          ((eq? message 'CHANGE-NAME) 
           (lambda (new-name) (set! name new-name)))
          ((eq? message 'SAY)
           (lambda (list-of-stuff)
             (if (not (null? list-of-stuff))
                 (display-message list-of-stuff))
                'NUF-SAID)))
          (else (no-method)))))
\end{lisp}

Or, with an alternative case syntax:
}

\begin{lisp}
(define (make-speaker name)
  (lambda (message) 
    (case message
      ((NAME) (lambda () name))
      ((CHANGE-NAME)
       (lambda (new-name) (set! name new-name)))
      ((SAY)
       (lambda (list-of-stuff)
         (if (not (null? list-of-stuff))
             (display-message list-of-stuff))
         'NUF-SAID))
      (else (no-method)))))
\end{lisp}

Abstract out retrieval of method from the object (given the message)...

\begin{lisp}
(define (get-method message object)
  (object message))
\null
(define (ask object message . args)
  (let ((method (get-method message object)))
    (if (method? method)
        (apply method args)
        (error "No method for message" message))))
\null
(define (no-method) '(NO-METHOD))
\null
(define (method? x)
  (cond ((procedure? x) \#)
        ((eq? x (no-method)) \#f)
        (else (error "Object returned non-message" x))))

\newpage
\subsubsection{Object-Oriented System - Version 2}
What if we want a speaker to call its own method??

Problem: no access to the "object" from inside itself!
Solution: add explicit "self" argument to all methods

\begin{lisp}
(define (make-speaker name)
  (lambda (message) 
    (case message
      ((NAME) (lambda (self) name))
      ((CHANGE-NAME)
       (lambda (self new-name)
         (set! name new-name)
         (ask self 'SAY (list 'call 'me name))))
      ((SAY)
       (lambda (self list-of-stuff)
         (if (not (null? list-of-stuff))
             (display-message list-of-stuff))
             'NUF-SAID))
      (else (no-method)))))
\null
(define (ask object message . args)
  (let ((method (get-method message object)))
    (if (method? method)
        (apply method object args)
        (error "No method for message" message))))
\null
(ask p 'CHANGE-NAME 'fred)
Call me fred
\end{lisp}

\subsubsection{A Specialized Speaker (Subclass)}

Want lecturers to be a kind of speaker - that inherit the behav-
ior of speakers but add to that behavior:

\begin{lisp}
(define (make-lecturer name)
  (let ((speaker (make-speaker name)))
    (lambda (message)
      (case message
        ((LECTURE)
         (lambda (self stuff)
           (delegate speaker self 
                    'SAY '(Good Morning!))
           (delegate speaker self 'SAY stuff)))
        (else (get-method message speaker))))))
\null
(define d (make-lecturer 'Duane))
(ask d 'LECTURE '(Today we learn more)) 
Good Morning!
Today we learn more
\end{lisp}

\subsubsection{Approach:  Inheritance by Delegation}
\begin{itemize}\packlist
 \item Inherit behavior by adding an "internal" speaker
   \begin{itemize}\packlist
      \item Get internal object to act on behalf of object by delegation
   \end{itemize}
 \item  If message is not recognized, pass the buck
 \item 	Can change or specialize behavior:
    \begin{itemize}\packlist
      \item Add new methods
      \item Change operation of methods
    \end{itemize}
\end{itemize}

\subsubsection{Another Subclass}
Want a "Canadian Lecturer" that changes the basic way of talk-
ing:  append "Eh?" to everything he says...

\begin{lisp}
(define (make-canadian-lecturer name)
  (let ((lecturer (make-lecturer name)))
    (lambda (message)
      (case message
        ((SAY)
         (lambda (self stuff)
           (delegate lecturer self
                     'SAY (append stuff '(Eh?)))))
        (else (get-method message lecturer))))))
\null
(define (delegate to from message . args)
  (let ((method (get-method message to)))
    (if (method? method)
        (apply method from args)
        (error "No method" message))))
\null
(define (ask object message . args)
  (apply delegate object object message args))
\null
(define e (make-canadian-lecturer 'Eric))
\end{lisp}

\begin{lisp}
(define (get-method message preferred . others)
  (define (loop objs)
    (let ((method (get-method-from-object
                     message (car objs)))
          (rest (cdr objs)))
      (if (or (method? method) (null? rest))
          method
          (loop rest)))))
\null
(define (get-method-from-object message object)
  (object message))
\end{lisp}

\newpage
\subsubsection{Alternative Multiple Inheritance}

We have lots of flexibility - suppose we want to pass the message 
on to multiple internal objects (not just some "preferred" one)?

\begin{lisp}
(define eric
  (let ((comic (make-comic))
        (lecturer (make-canadian-lecturer 'Eric)))
    (lambda (message)
      (lambda (self . args)
        (apply delegate-to-all
               (list lecturer comic)
               self
               args)))))
\null                       
(ask eric 'SAY '(The sky is blue))
The sky is blue Eh?
The sky is blue ha ha
\null
\null
(define (delegate-to-all to-list from message . args)
  (foreach
    (lambda (to-whom)
      (apply delegate to-whom from message args))
  to-list)
\end{lisp}
\end{document}