インスタンスが属するクラスをあとから変更する操作を CLISP で

OOPL 
(defclass <cartesian> ()
    ((x :initform 0 :initarg :x)
     (y :initform 0 :initarg :y)))
 
(defclass <polar> ()
    ((r :initform 0 :initarg :r)
     (theta :initform 0 :initarg :theta)))

(defmethod update-instance-for-different-class :before ((old <cartesian>) (new <polar>) &key)
    (let ((x (slot-value old 'x))
          (y (slot-value old 'y)))
        (setf (slot-value new 'r) (sqrt (+ (* x x) (* y y)))
              (slot-value new 'theta) (atan y x))))
 
(defmethod update-instance-for-different-class :before ((old <polar>) (new <cartesian>) &key)
    (let ((r (slot-value old 'r))
          (theta (slot-value old 'theta)))
        (setf (slot-value new 'x) (* r (cos theta))
              (slot-value new 'y) (* r (sin theta)))))

(setq pos1 (make-instance '<polar> :r (sqrt 2) :theta (/ pi 4)))
(setq pos2 pos1)
(class-of pos1)        ;;=> #<STANDARD-CLASS <POLAR>>

(change-class pos1 '<cartesian>)
(class-of pos1)        ;;=> #<STANDARD-CLASS <CARTESIAN>>
(slot-value pos1 'x)   ;;=> 1.0
(slot-value pos1 'y)   ;;=> 1.0
(class-of pos2)        ;;=> #<STANDARD-CLASS <CARTESIAN>>

(change-class pos1 '<polar>)
(class-of pos1)        ;;=> #<STANDARD-CLASS <POLAR>>
(slot-value pos1 'r)   ;;=> 1.4142135
(/ (slot-value pos1 'theta) pi)   ;;=> 0.24999999