Re: OO should break when broken

["Marc Battyani" <address@hidden>]

From: "Guy Steele - Sun Microsystems Labs" <Guy.Steele@sun.com>
To: <cputney@wiresong.ca>; <clements@brinckerhoff.org>
Cc: <ll1-discuss@ai.mit.edu>
Sent: Thursday, September 04, 2003 10:28 PM
Subject: Re: OO should break when broken


...
>    Ellipse.java:
>    class Ellipse extends Object {
>         float long_axis;
>         float short_axis;
>    
>         public Ellipse(float long_axis_init, float short_axis_init)
>         {
>    long_axis = long_axis_init;
>    short_axis = short_axis_init;
>         }
>    }
>    
>    Circle.java:
>    class Circle extends Ellipse {
>    
>         public Circle(float radius)
>         {
>             super(radius, radius);
>         }
>    }
> 
> Very nice, but let
> 
>    float radius = 3;
>    Ellipse e = new Ellipse(radius, radius);
> 
> and then, alas,
> 
>    e instanceof Circle
> 
> is false.

This one is somewhat better:

(defclass ellipse ()
  ((short-radius :accessor short-radius :initform 1.0)
   (long-radius :accessor long-radius :initform 2.0)))

(defclass circle (ellipse)
  ())

(defun circle-p (ellipse)
  (= (short-radius ellipse)(long-radius ellipse)))

(defmethod (setf short-radius) :after (value (object ellipse))
  (when (circle-p object)
    (change-class object 'circle)))

(defmethod (setf long-radius) :after (value (object ellipse))
  (when (circle-p object)
    (change-class object 'circle)))

(defmethod (setf short-radius) :after (value (object circle))
  (unless (circle-p object)
    (change-class object 'ellipse)))

(defmethod (setf long-radius) :after (value (object circle))
  (unless (circle-p object)
    (change-class object 'ellipse)))

It even works:

CL-USER 8 > (setf a (make-instance 'ellipse))
#<ellipse 205EA4A4>

CL-USER 9 > (describe a)
#<ellipse 205EA4A4> is an ellipse
short-radius      1.0
long-radius       2.0

CL-USER 10 > (setf (long-radius a) 1.0)
1.0

CL-USER 11 > (describe a)
#<circle 205EA4A4> is a circle
short-radius      1.0
long-radius       1.0

CL-USER 12 > (setf (short-radius a) 2.0)
2.0

CL-USER 13 > (describe a)
#<ellipse 205EA4A4> is an ellipse
short-radius      2.0
long-radius       1.0


Marc