Proficient programmers who are adept in a variety of paradigms and languages recognize Design Patterns as missing language features. A new revelation dawned on me today – a Design Pattern could be devised to work around a wily language feature as well! I came to this realization after reading about the Null Object pattern. An entire section of the book Object-Oriented Reengineering Patterns is dedicated to this topic, underlining the fact that the more patterns you have in your code, the less expressive and ill-designed the language you are using. Sometime back I wrote an article on why NULL should be removed from languages. If I had known about the Null Object pattern then I would’ve saved some time by not writing this article, as the existence of this pattern itself is a more convincing argument against the case of NULL.

Liskov Substitution Principle (LSP) is a principle in Object-Oriented Programming which states that

derived types must be completely substitutable for their base types.

Functions that receive a reference to a base class object should also be able to take a reference to a derived class object without being aware of it. This is required because a reference to a base type object may actually point to a derived type object at run-time and may cause code written specifically for the base type to misbehave or produce wrong results. Adding a derived type to the system should not require changes to existing code. This principle is often violated by naive class hierarchies based on the is-a relationship. The canonical example is a square class derived from a rectangle. A square is a rectangle which imposes the additional constraint that both its width and height must be equal. So it might seem natural to derive square from rectangle and impose the constraint by overriding the modifiers. Let us first implement the rectangle class. Then we will derive square from it and see how it violates the Substitution Principle. After that we will device a better design by introducing contracts that control how methods might be overridden by a derived class. I choose CLOS as the implementation language because it provides a simple mechanism for adding method contracts.

Here is the definition of the rectangle class:

(defclass rectangle ()
  ((width :accessor width :initform 0)
   (height :accessor height :initform 0)))

(defgeneric set-width (rect w))
(defgeneric set-height (rect h))

(defmethod set-width ((rect rectangle) w)
  (setf (width rect) w))

(defmethod set-height ((rect rectangle) h)
  (setf (height rect) h))

There is a method to impose a system-wide policy that the area of a rectangle is always 200:

(defmethod check-area ((rect rectangle))
  (assert (= (* (width rect) (height rect)) 200))
  t)

> (defvar r (make-instance 'rectangle))
> (set-width r 100)
> (set-height r 2)
> (check-area r) ;; => T
> (set-height r 200)
> (check-area r) ;; => assertion fails.

Later it was required that a square type be added to the system. Its definition is based on the assumption that a square is-a rectangle. As we proceed with the implementation, it is observed that a square requires only a single field to represent both its width and height. The problem is solved by overriding the modifier methods and setting both fields simultaneously to the same value. (A good programmer will take this duplication of data as the first indication that something is broken in the design. He will not try to work around it!)

(defclass square (rectangle) ())

(defmethod set-width ((sqr square) w)
  (setf (height sqr) w)
  (setf (width sqr) w))

(defmethod set-height ((sqr square) h)
  (setf (width sqr) h)
  (setf (height sqr) h))

The above class definition has violated the Substitution Principle. This is proved by the following test. check-area will fail, unless it is modified to take special care of square objects:

;; somewhere up, `r` was made to point to a `square` object.
(set-width r 100)
(set-height r 2)
(check-area r) ;; => assertion fails!

How can we prevent the creation of derived types that violate LSP? Programming by Contract, where preconditions and post-conditions are established for class methods, will help in solving this problem. The precondition must be true for the method to execute. Upon completion, the method guarantees that the post-condition will be true. We will redefine rectangle with pre/post conditions that makes sure that changing one field will not affect the other. The :before and :after method qualifiers in CLOS allows us to add these conditions:

(defclass rectangle ()
  ((width :accessor width :initform 0)
   (height :accessor height :initform 0)
   (old-width :accessor old-width)
   (old-height :accessor old-height)))

;; set-width precondition.
;; Makes sure that w is > 0 and saves the value of height.
(defmethod set-width :before ((rect rectangle) w)
  (assert (> w 0))
  (setf (old-height rect) (height rect)))

(defmethod set-width ((rect rectangle) w)
  (setf (width rect) w))

;; set-width post-condition.
;; Makes sure that the method that changed the value of width,
;; did not change the value of height also.
(defmethod set-width :after ((rect rectangle) w)
  (assert (= (height rect) (old-height rect))))

;; pre/post conditions similar to set-width are also
;; applied to set-height.

(defmethod set-height :before ((rect rectangle) h)
  (assert (> h 0))
  (setf (old-width rect) (width rect)))

(defmethod set-height ((rect rectangle) h)
  (setf (height rect) h))

(defmethod set-height :after ((rect rectangle) w)
  (assert (= (width rect) (old-width rect))))

Once these conditions are established, the overridden modifiers of square refuse to work, as the post-condition assertion fails:

> (set-width r 100) ;; assertion failed.

The implementor of square has to unlink it from rectangle and rethink his design. By a rule of Programming by Contract, a derivative may only replace the precondition of a method by a weaker one, and its post-condition by a stronger one. (As qualified method calls are propagated up the class hierarchy in CLOS, it is difficult to break this rule here/).

An even better design that will allow both rectangle and square to stay within the same hierarchy is to define a common base class for all shapes and derive rectangle and square from it:

(defclass shape () ())

(defgeneric set-width (shape w))
(defgeneric set-height (shape h))

(defclass rectangle (shape)
  ((width :accessor width :initform 0)
   (height :accessor height :initform 0)
   (old-width :accessor old-width)
   (old-height :accessor old-height)))

;; set-width precondition.
;; Makes sure that w is > 0 and saves the value of height.
(defmethod set-width :before ((rect rectangle) w)
  (assert (> w 0))
  (setf (old-height rect) (height rect)))

(defmethod set-width ((rect rectangle) w)
  (setf (width rect) w))

;; set-width post-condition.
;; Makes sure that the method that changed the value of width,
;; did not change the value of height also.
(defmethod set-width :after ((rect rectangle) w)
  (assert (= (height rect) (old-height rect))))

;; pre/post conditions similar to set-width are also
;; applied to set-height.

(defmethod set-height :before ((rect rectangle) h)
  (assert (> h 0))
  (setf (old-width rect) (width rect)))

(defmethod set-height ((rect rectangle) h)
  (setf (height rect) h))

(defmethod set-height :after ((rect rectangle) w)
  (assert (= (width rect) (old-width rect))))

(defmethod check-area ((rect rectangle))
  (assert (= (* (width rect) (height rect)) 200))
  t)

;; type square
(defclass square (shape)
   ((side :accessor side :initform 0)))

(defmethod set-width ((sqr square) w)
  (setf (side sqr) w))

(defmethod set-height ((sqr square) h)
  (setf (side sqr) h))