For my job, I program in both Lisp and C++.  I use C++ much more than Lisp.  Looking at my previous series of posts, it seems I’m writing an introduction to Lisp for C++ programmers.  So, let’s go with that for a bit, and talk about the object system in Lisp.  I’m talking specifically about the CLOS, the Common Lisp Object System, which is a part of the ANSI Lisp standard.

To begin with, CLOS does not define member functions.  Instead, things that a C++ programmer would call non-member functions are used for polymorphism.  These are referred to as “generic functions”.  A CLOS generic function does not have special access to the members of a class, and does not have anything like the this pointer of C++.

Generic functions are declared in the namespace with defgeneric, and then defined for specific classes with defmethod.  This imposes an interesting restriction not present in C++ code.  All generic functions in the namespace must use the same API.  In C++ one could define several unrelated classes, each with its own PrintObject() public method.  Some might print to stdout, some might print to a user-supplied stream, some might return a string, some might take a record-separator as an argument, there need not be any consistency in the parameters passed to these distinct methods.  In Lisp, all generic functions must comply to their definition.  While it is possible to abuse this constraint, for instance by declaring that the generic function takes a single argument, a list, which itself contains the particular arguments that each specialized function will use, that would be bad practice, making the code less readable.

So, how is polymorphism achieved?  Let’s look at a code fragment.

;; 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 manager (employee)
  ((supervisor          :accessor get-supervisor
                        :initform nil
                        :initarg :supervisor)
   (underlings          :accessor get-underlings
                        :initform nil
                        :initarg :underlings)))

(defclass underling (employee)
  ((supervisor          :accessor get-supervisor
                        :initarg :supervisor)))

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

(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 manager))
  (format stream "Employee name: ~A~%" (get-name object))
  (format stream "Employee ID: ~D~%" (get-id object)))
  (format t "~%")
  (let ((supervisor (get-supervisor object)))
    (cond 
      (supervisor
       (format stream "Supervisor ID: ~D~%" (get-id supervisor)))
      (t
       (format stream "No supervisor~%"))))
  (format stream 
          "Supervising IDs:~{ ~D~}." 
          (mapcar 'get-id (get-underlings object))))

(defmethod myprint (stream (object underling))
  (format stream "Employee name: ~A~%" (get-name object))
  (format stream "Employee ID: ~D~%" (get-id object)))
  (format t "~%")
  (let ((supervisor (get-supervisor object)))
    (cond 
      (supervisor
       (format stream "Supervisor ID: ~D~%" (get-id supervisor)))
      (t
       (format stream "No supervisor")))))

(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 "~%~%")))

This is a brute-force approach to the problem, one that we will refine in later postings.  We have declared that the myprint method takes two arguments.  The first is an output stream, the second is the object to be printed.  Which particular generic function is called depends on the object passed.  By default, the most specialized generic function is selected.  So, even though we have defined a method that prints out the base class, employee, when we ask to print an underling or manager object, the corresponding more specialized method is used.

This, though, is only the beginning.  We will extend this somewhat in a later post, before moving on to other CLOS behaviour.