So far, we’ve looked at simple generic functions, and how they compare to C++ methods.  There are, however, some generic functions that add interesting and useful features not obviously available in C++.  These include the :before, :after, and :around generic functions.

Looking at the code we supplied in the first part of this series, we see some duplicated code.  We create a new class for managed employees, and rebuild the hierarchy with those.  Then, we decide that as we further specialize the classes, the printing of them just adds further fields.  The new code now looks like this:

;; Polymorphism example

(defpackage :POLYMORPHISM
  (:use :COMMON-LISP)
)

(in-package :POLYMORPHISM)

(declaim (optimize (debug 3) (safety 3)))
; (declaim (optimize (debug 0) (safety 0) (speed 3)))


(defclass employee ()
  ((name                :accessor get-name
                        :initarg :name)
   (id                  :accessor get-id
                        :initarg :id)))

(defclass supervised-employee (employee)
  ((supervisor          :accessor get-supervisor
                        :initform nil
                        :initarg :supervisor)))

(defclass manager (supervised-employee)
  ((underlings          :accessor get-underlings
                        :initform nil
                        :initarg :underlings)))

(defclass underling (supervised-employee)
  ())

(defgeneric myprint (stream object)
  (:documentation "Prints to 'stream' some information about 'object'."))

(defparameter *printing-border* nil)

(defmethod myprint :around (stream (object employee))
  (when *printing-border*
    (format stream "~A~%" *printing-border*))
  (prog1
      (call-next-method)
    (when *printing-border*
      (format stream "~A~%" *printing-border*))))

(defmethod myprint (stream (object employee))
  (format stream "Employee name: ~A~%" (get-name object))
  (format stream "Employee ID: ~D~%" (get-id object)))

(defmethod myprint (stream (object supervised-employee))
  (call-next-method)
  (let ((supervisor (get-supervisor object)))
    (cond 
      (supervisor
       (format stream "Supervisor ID: ~D~%" (get-id supervisor)))
      (t
       (format stream "No supervisor~%")))))

(defmethod myprint (stream (object manager))
  (call-next-method)
  (format stream 
          "Supervising IDs:~{ ~D~}.~%" 
          (mapcar 'get-id (get-underlings object))))

(defmethod myprint (stream (object underling))
  (call-next-method))

(defun test-system ()
  (let* ((orc-1 (make-instance 'underling :name "Orc-1" :id 1))
         (orc-2 (make-instance 'underling :name "Orc-2" :id 2))
         (orc-3 (make-instance 'underling :name "Orc-3" :id 3))
         (orc-4 (make-instance 'underling :name "Orc-4" :id 4))
         (uruk-1 (make-instance 'manager :name "Uruk-1" :id 5 
                                :underlings (list orc-1 orc-2)))
         (uruk-2 (make-instance 'manager :name "Uruk-2" :id 6 
                                :underlings (list orc-3 orc-4)))
         (saruman (make-instance 'manager :name "Saruman" :id 7
                                 :underlings (list uruk-1 uruk-2))))
    (setf (get-supervisor orc-1) uruk-1
          (get-supervisor orc-2) uruk-1)
    (setf (get-supervisor orc-3) uruk-2
          (get-supervisor orc-4) uruk-2)
    (setf (get-supervisor uruk-1) saruman
          (get-supervisor uruk-2) saruman)

    (myprint t orc-1)
    (format t "~%~%")
    (myprint t orc-2)
    (format t "~%~%")
    (myprint t orc-3)
    (format t "~%~%")
    (myprint t orc-4)
    (format t "~%~%")
    (myprint t uruk-1)
    (format t "~%~%")
    (myprint t uruk-2)
    (format t "~%~%")
    (myprint t saruman)
    (format t "~%~%")))

Now, the myprint method for supervised-employee objects calls a function call-next-method.  This causes it to invoke, with the same arguments, the next defined method from a parent class, if any.  So, when the myprint method for manager objects is called, it first calls the myprint method for supervised-employee objects, which in turn calls the myprint method for employee objects.  In C++, one would do this with an explicit class name in the invocation.  There’s another defined method here, though, the :around method for employee objects.  This allows the programmer to insert an easy shim around the named method itself, where certain things could be done.  In this example, it optionally prints text above and below the record.  In other cases, it could be used to perform some sort of global sanity checking on passed arguments or returned values, or it could be used to insert a profiling or timing loop, without the need to scour through and edit the corresponding methods for all classes in the inheritance group.  This is a useful feature.  In fact, in some of my C++ code I’ve been known to write methods with an empty springboard function, purely so that I could add in general inspection code later in the style of an :around method.

It’s worth pointing out, too, that the myprint method for underling objects is entirely superfluous.  If that method were not defined, the invocation of myprint on it would look first for a supervised-employee method, and if there was none, would then look for an employee method.

The :before and :after methods are similarly useful, for taking action before or after a method is invoked.  A particularly useful one is to create an :after method for the initialize-instance method.  The initialize-instance method is the method that is invoked to construct objects.  It can fill in slots based on :initform or :initarg arguments, but doesn’t do more than that.  Think of it like the initialization list in a C++ constructor.  An :after method is like the body of the constructor.  It can take action based on the initialized slots.  This might include opening a file, building a data structure, or doing something more that, conceptually, you want as part of make-instance, but which is more complex than a simple assignment.