Re: about genricity

From: Erick Gallesio <eg_at_kaolin.unice.fr>
Date: Tue, 17 Sep 1996 09:30:03 +0200

You can have a pretty solution when using the STklos MOP. To illustrate this
I suppose you have:
    (define-class parent-class ()
      ((a :init-keyword :a)))

    (define-class child-class-1 (parent-class)
      ((b :init-keyword :b)))

    (define-class child-class-2 (parent-class)
      ((c :init-keyword :c)
       (d :init-keyword :d)))

    (define o1 (make parent-class :a 1))
    (define o2 (make child-class-1 :b 2))
    (define o3 (make child-class-2 :a 0 :c 3 :d 4))

With STklos, the generic functions write-object (or display-object) is called
when you call the Scheme function write (or display). You don't have to
overload
the standard write to use your method. If you don't define display-objet, the
write-object function is called when you call display on an STklos object.
So you can write
        (define-method write-objet ((c child-class-1) port)
            ....
        (define-method write-object ((c child-class-1) port)
            ....
But you can do better:
Since all your classes share a common ancestor, you can define a write object
for the parent-class. Using the MOP, you can find all the informations
on the real caller to customize your printing:

   (define-method write-object ((o parent-class) port)
      (format port "(make ~A" (class-name (class-of o)))
      (map (lambda (descr)
             (let ((slot-name (car descr))
                   (keywd (get-keyword :init-keyword (cdr descr) #f)))
               (when keywd
                 (if (slot-bound? o slot-name)
                     (format port " ~s ~s" keywd (slot-ref o slot-name))))))
           (class-slots (class-of o)))
      (display ")\n" port))

The various aspects of the MOP used here are:
        - class-name which gives the symbol associated to the class
        - class-slots which gives a list of slot descriptions. Each slot
          description being the list you gave when defining the slot.
          For instance, (class-slots child-class-1)
          returns ((a :init-keyword :a) (b :init-keyword :b))
        - slot-bound? which is a predicate which indicates if a given slot is
          bound.
So,
        STk> (begin (write o1) (write o2) (write o3))
        (make parent-class :a 1)
        (make child-class-1 :b 2)
        (make child-class-2 :a 0 :c 3 :d 4)
        #[undefined]
        STk>
Note that this function "forget" slots which don't have init-keyword. You can
change it by writing an object with something like:

        (let ((tmp (make child-class-2)))
          (slot-set! tmp 'a 0)
          (slot-set! tmp 'c 2)
          tmp)

Hope it helps





                -- Erick
Received on Tue Sep 17 1996 - 09:38:56 CEST