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.

So, in a series of posts, I talked about Lisp macros and their power.

• Part 1
• Part 2
• Part 3
• Part 4
• Part 5
• Part 6
• Part 7
• Part 8
• Part 9

I started out saying that there were features of Lisp that I missed when programming in other languages.  Ultimately, the languages are for the programmer, not the computer.  If your language has support for the functions you need, and the compiler is a good one, the computer is perfectly fine running your code in whatever language you choose.  Once those essentials have been covered, the choice of language comes down to familiarity and ease of use.

In this series of articles, I described how to set up Lisp macros to create a new looping structure in the language, for a particular use case I had in my work.  I was writing looping code over and over again, in a format like this:
 

(labels
    ((circular-inc (dlist iter)
       (let ((rv (dl-list:iter-next dlist iter)))
         (or rv (dl-list:iter-front dlist)))))

  (do* ((iter0 
         (dl-list:iter-front dlist) 
         (circular-inc dlist iter0))

        (iter1 
         (circular-inc dlist iter0) 
         (circular-inc dlist iter0)))

      (nil)
    (let ((contents0 
           (dl-list:iter-contents dlist iter0))
          (contents1 
           (dl-list:iter-contents dlist iter1)))

      (perform-some-function-on-content-pair contents0 
                                             contents1)
      (when (eq iter0 (dl-list:iter-back dlist))
        (return)))))

With the help of the macros, this can be rewritten:
 

(dl-list:2-value-loop (dlist contents0 contents1 :circular t)
  (perform-some-function-on-contents contents0 
                                     contents1))

This not only saves typing, and reduces the opportunity for typos introducing bugs, but it makes the block of code immediately readable to the user.  The code is much more self-documenting, as the maintainer doesn’t have to scan through a dozen lines of boilerplate code to see what this particular loop does. The programmer doesn’t have to look out for variable-name collisions in the iterator variables, (s)he can rely on the macro to avoid that danger.  To a person reviewing or editing the code, it is sufficient to know that this loop iterators over all pairs of values in a circular list, without needing to know exactly how that is actually implemented.  It hides the boring, repetitive parts out of sight, much the way a compiler or assembler hides registers and memory addresses from the C programmer.

In C++ you can use classes and methods to reduce some of the on-screen clutter, but building a new flow-control structure and using it this concisely is difficult, if even possible.  When I converted my code to C++, I wound up with specialized iterators, pair_iterators, triplet_iterators, and when you start putting in const-types and reverse iterators you wind up with hundreds of lines of code that is boring to write.  Even then, the C++ version is less concise when used in the code.

So, that’s one of the things I miss when I’m not programming in Lisp, the ability to build new flow-control structures that aid greatly in keeping the code concise and readable.

I mentioned earlier that the macro-generating macro was essentially done.  There is one more new control loop that I find frequent need of.  Sometimes, it is sufficient to loop over the values, I don’t actually need a user-visible variable with the iterator itself.  So, we can build a new looping construct that loops through the contents of the dl-list, instead of through iterators into the dl-list.  This time, we’ll jump right to the general case.

(defmacro create-n-value-loop (n name iter-loop-to-use)
  (assert (and (integerp n) (> n 0)))
  (let (value-symbols iter-symbols)
    (dotimes (i n)
      (push (intern (format nil "ITER~D" i)) iter-symbols)
      (push (intern (format nil "VALUE~D" i)) value-symbols))
    (setf iter-symbols (reverse iter-symbols))
    (setf value-symbols (reverse value-symbols))
    `(defmacro ,name ((dl-list ,@value-symbols 
                               &key start end circular reverse)
                      &body body)
       (let ((dl-cap (gensym))
             ,@(mapcar #'(lambda (x) 
                           `(,x (gensym))) 
                       iter-symbols))
         `(let ((,dl-cap ,dl-list))
            (,',iter-loop-to-use 
             (,dl-cap ,,@iter-symbols
                      :start ,,'start
                      :end ,,'end
                      :circular ,,'circular
                      :reverse ,,'reverse)
             (let (,,@(mapcar 
                       #'(lambda (x y) 
                           ``(,,x 
                              (iter-contents ,,'dl-cap ,,y)))
                       value-symbols iter-symbols))
               ,@body)))))))

This creates macros like value-loop, the by-hand version of which is reproduced here:
 

(defmacro value-loop ((dl-list value0 
                               &key start end circular reverse)
                      &body body)
  (let ((dl-cap (gensym))
        (iter (gensym)))
    `(let ((,dl-cap ,dl-list))
       (iter-loop (,dl-cap ,iter 
                           :start ,start :end ,end
                           :circular ,circular :reverse ,reverse)
        (let ((,value0 (dl-list:iter-contents ,dl-cap ,iter)))
          ,@body)))))

Now, we’re ready to put together the more complex version of the original macro with the generalized n-iterator macro-generating macro.  That’s fairly simple, certainly compared to the magic that goes into building the looping construct.  We’ve already got the desired template, we just fold them in.  Here’s the result:
   

(defmacro create-n-iter-loop (n name)
  (assert (and (integerp n) (> n 0)))
  (let (symbols first-sym last-sym)
    (dotimes (i n)
      (push (intern (format nil "ITER~D" i)) symbols))
    (setf last-sym (first symbols))
    (setf symbols (reverse symbols))
    (setf first-sym (first symbols))
    `(defmacro ,name ((dl-list ,@symbols 
                               &key start end circular reverse)
                      &body body)
       (let ((dl-cap (gensym))
             (start-cap (gensym))
             (end-cap (gensym))
             (circ-cap (gensym))
             (rev-cap (gensym))
             (inc-fcn (gensym))
             (early-exit (gensym)))
         `(let ((,dl-cap ,dl-list)
                (,start-cap ,start)
                (,end-cap ,end)
                (,circ-cap ,circular)
                (,inc-fcn 'iter-next)
                (,rev-cap ,reverse)
                ,early-exit)
            (cond
              ((and ,circ-cap ,rev-cap)
               (setf ,inc-fcn 
                     #'(lambda (dl it)
                         (let ((rv (iter-prev dl it)))
                           (or rv (iter-back dl))))))

              ((and ,circ-cap (not ,rev-cap))
               (setf ,inc-fcn 
                     #'(lambda (dl it)
                         (let ((rv (iter-next dl it)))
                           (or rv (iter-front dl))))))

              ((and (not ,circ-cap) ,rev-cap)
               (setf ,inc-fcn 'iter-prev)))

            (unless ,start-cap
              (if ,rev-cap
                  (setf ,start-cap (iter-back ,dl-cap))
                  (setf ,start-cap (iter-front ,dl-cap))))
            (when ,end-cap
              (setf ,early-exit #'(lambda (x) 
                                    (eq x ,end-cap))))

            (do* ((,,first-sym 
                   ,start-cap 
                   (funcall ,inc-fcn ,dl-cap ,,first-sym))
                  ,,@(mapcar #'(lambda (x y) 
                                 ``(,,x 
                                    (and ,,y 
                                         (funcall ,,'inc-fcn 
                                                  ,,'dl-cap 
                                                  ,,y))
                                    (and ,,y 
                                         (funcall ,,'inc-fcn 
                                                  ,,'dl-cap 
                                                  ,,y))))
                             (cdr symbols) symbols))
                 ((not ,,last-sym))
              ,@body
              (when (and ,early-exit
                         (funcall ,early-exit ,,first-sym))
                (return))))))))

While there might be some minor adjustments to be made, this macro does what I need for iteration over a dl-list object.