Nyquist / XLISP 2.0 - Contents | Tutorials | Examples | Reference

# Advanced XLISP Objects

1. Standard XLISP Objects
2. Initializing Class Variables
3. Accessing Class and Instance Variables

## Standard XLISP Objects

Define a class with an instance variable and a class variable:

    (setq my-class (send class :new '(instance-var) '(class-var)))

Look at the layout of the new class:

    > (send my-class :show)
    Object is #<Object...>, Class is #<Object...>
      MESSAGES = NIL
      IVARS = (INSTANCE-VAR)
      CVARS = (CLASS-VAR)
      CVALS = #(NIL) ; default init-value of class variables
      SUPERCLASS = #<Object...>
      IVARCNT = 1
      IVARTOTAL = 1
    #<Object...>

Make an instance of 'my-class':

    (setq my-object (send my-class :new))

Look at the layout of the new object:

    > (send my-object :show)
    Object is #<Object...>, Class is #<Object...>
      INSTANCE-VAR = NIL ; default init-value of instance variables
    #<Object...>

Back to top

## Initializing Class Variables

1. Add an :isnew init-method to 'my-class':

    (send my-class :answer :isnew nil '((setq class-var 1)))

Now reset the class:

    (send my-class :isnew)  => error: too few arguments

It turns out that :isnew needs at least a list of instance variables plus an optional list of class variables:

    (send my-class :isnew '(ivar))           ; overwrites INSTANCE-VAR, deletes CLASS-VAR
    (send my-class :isnew '(ivar) '(cvar)))  ; overwrites INSTANCE-VAR and CLASS-VAR

2. Add an :init method to 'my-class':

    (send my-class :answer :init nil '((setq class-var 1)))

Now call the :init method:

    (send my-class :init)  => error: no method for this message - :INIT

This is not true, there is an :init method:

    > (send my-class :show)
    Object is #<Object...>, Class is #<Object...>
      MESSAGES = ((:INIT . #<Closure-:INIT:...>))
      IVARS = (INSTANCE-VAR)
      CVARS = (CLASS-VAR)
      CVALS = #(NIL)
      SUPERCLASS = #<Object...>
      IVARCNT = 1
      IVARTOTAL = 1
    #<Object...>

The problem here is that in XLISP, methods cannot be called from the class they were defined in, methods only can be called from instances, and exactly the same happens with manipulating class variables. There seems to be no standard XLISP way to initialize class variables with values at the time when the class is defined.

3. The only way I know in XLISP to initialize a class variable is to create an instance of the class and set the class variable e.g. from the :isnew method of the instance:

    (setq my-object (send my-class :new))

The :isnew method of 'my-object', inherited from 'my-class', has set the class variable in 'my-class' to a new value:

    > (send my-class :show)
    Object is #<Object...>, Class is #<Object...>
      MESSAGES = ((:ISNEW . #<Closure-:ISNEW:...>))
      IVARS = (INSTANCE-VAR)
      CVARS = (CLASS-VAR)
      CVALS = #(1) ; new value of CLASS-VAR
      SUPERCLASS = #<Object...>
      IVARCNT = 1
      IVARTOTAL = 1
    #<Object...>

This works, but now I have two problems:

1. If a class variable is set from an instance's :isnew method, inherited from the superclass, then, whenever an instance is created, the class variable will be reset to its initial value. Note that in Lisp, instances can be created at arbitrary run-time, not only at the beginning of a program. Setting class variables from an :isnew method can produce unexpected side-effects if a class variable is used for object inter-communication.

2. Because instances can be created at arbitrary runtime, a framework would need to be written when a class variable is allowed to be set or reset and when not. Ok, if class variables are used for object inter-communication, a framework needs to be witten anyway, but I do not want to be forced to think about this only because I want to initialize a single class variable.

4. Here is a trick I use to initialize class variables.

Create a class with class variables:

    (setq my-class (send class :new nil '(cvar-1 cvar-2)))

Add an :isnew method to set the class variables:

    (send my-class :answer :isnew nil '((setq cvar-1 "a" cvar-2 "b")))

Create a temporary dummy object to initialize the class variables:

    (let ((x (send my-class :new))))

Replace the :isnew method with a dummy version [or a real version, initializing the instance variables]:

    (send my-class :answer :isnew nil nil)

Now I have a class with initialized class variables:

    > (send my-class :show)
    Object is #<Object...>, Class is #<Object...>
      MESSAGES = ((:ISNEW . #<Closure-:ISNEW...>))  ; dummy method
      IVARS = NIL
      CVARS = (CVAR-1 CVAR-2)  ; class variables
      CVALS = #("a" "b")       ; init values
      SUPERCLASS = #<Object...>
      IVARCNT = 0
      IVARTOTAL = 0
    #<Object...>

See defclass below how to make this work automatically.

Back to top

## Accessing Class and Instance Variables

    (setq my-class (send class :new '(i-var) '(c-var)))
    (setq my-object (send my-class :new))

A message to read internal class and instance variables:

    (send my-class :answer :internal-slot-get '(slot-name)
      '((eval slot-name)))

A message to write internal class and instance variables:

    (send my-class :answer :internal-slot-set '(slot-name value)
      '((eval (list 'setq slot-name value))))

Implementation Notes

1. It's not really good Lisp style to explicitely call 'eval' in Lisp code at run-time, because 'eval' produces a lot of overhead, but here the only way to get access to the internal environment of an object is passing the message arguments to 'eval' inside the object itself.

2. In the XLISP object system, an :answer message can only be accessed in an instance of a class [a sub-class or on object], but not in the class, where the :answer message has been defined, so the :internal-slot accessor will only work in 'my-object' but ont in 'my-class'.

3. If a method had been changed in a superclass, the change will automatically be inherited by all instances of the class [sub-classes and objects], with no need to redefine them.

Warning: If 'internal-slot-set' is given a slot-name that doesn't exist inside the object, a global variable will be created.

Reading and writing an instance variable:

    > (send my-object :internal-slot-get 'i-var)     ; read
    NIL

    > (send my-object :internal-slot-set 'i-var 55)  ; write
    55

    > (send my-object :internal-slot-get 'i-var)     ; read
    55

    > (send my-object :show)
    Object is #<Object: #9b95998>, Class is #<Object: #9b95c50>
      I-VAR = 55 ; new value
    #<Object: #9b95998>

Reading and writing a class variable:

    > (send my-object :internal-slot-get 'c-var)      ; read
    NIL

    > (send my-object :internal-slot-set 'c-var 123)  ; write
    123

    > (send my-object :internal-slot-get 'c-var)      ; read
    123

    > (send my-class :show)
    Object is #<Object: #9b95c50>, Class is #<Object: #9af7dd4>
      MESSAGES = ((:INTERNAL-SLOT-GET . #<Closure-:INTERNAL-SLOT-GET: #9b90080>)
                  (:INTERNAL-SLOT-SET . #<Closure-:INTERNAL-SLOT-SET: #9b900d4>))
      IVARS = (I-VAR)
      CVARS = (C-VAR)
      CVALS = #(123) ; new value
      SUPERCLASS = #<Object: #9af7dc8>
      IVARCNT = 1
      IVARTOTAL = 1
    #<Object: #9b95c50>

See the 'slot-get' and 'slot-set' functions below how this can be generalized to access any class or instance variable in any class or object via only two functions.

Back to top

## defclass

The original RBD 'defclass' macro:

    (defmacro defclass (name super locals class-vars)
      (if (not (boundp name))
        (if super
            `(setq ,name (send class :new ',locals ',class-vars ,super))
            `(setq ,name (send class :new ',locals ',class-vars)))))

In order to read or write XLISP class or object variables two slot-acessor messages need to be added to every new top-level class:

    (defmacro defclass (name super locals class-vars)
      (when (boundp name)
        (format t ";; WARNING: redefining ~a~%" name))
      (if super
          `(setq ,name (send class :new ',locals ',class-vars ,super))
          `(progn
             (setq ,name (send class :new ',locals ',class-vars))
             (send ,name :answer :internal-slot-set '(slot-name value)
               '((eval (list 'setq slot-name value))))
             (send ,name :answer :internal-slot-get '(slot-name)
               '((eval slot-name))))))

The third version provides 'let'-syntax with instance and class variables. A list of symbols will create variables initialized to NIL. This is the XLISP default behaviour. If an element is a (symbol value) list, then the variable will be initialized with 'value', as soon as an instance of the class is created.

(defclass class {superclass | NIL}
`` ({ | ivar | | ( | ivar | init-form | )} ... )`` | ; instance variables
`` ({ | cvar | | ( | cvar | init-form | )} ... ))`` | ; class variables

    (defmacro expand-init-values (vars var-list init-list)
      (let ((var (gensym)))
        `(dolist (,var ,vars (setq ,var-list  (reverse ,var-list)
                                   ,init-list (reverse ,init-list)))
           (cond ((symbolp ,var)
                  ;; if the element is a single symbol,
                  ;; then add it to the variable list
                  (push ,var ,var-list))
                 ((and (listp ,var) (symbolp (first ,var)))
                  ;; if the element is a (symbol value) list, then add
                  ;; an (setq symbol value) element to the init-list
                  (push (list 'setq (first ,var) (second ,var)) ,init-list)
                  ;; and add the symbol to the variable-list
                  (push (first ,var) ,var-list))
                 (t (error "bad argument type" ,var))))))

    (defmacro with-unique-names (symbols &rest body)
      `(let ,(mapcar #'(lambda (x) `(,x (gensym))) symbols) ,@body))

    (defmacro defclass (name super class-vars instance-vars)
      (with-unique-names (class-list class-init instance-list instance-init x)
        `(let (,instance-list ,instance-init ,class-list ,class-init)
           (expand-init-values ',class-vars ,class-list ,class-init)
           (expand-init-values ',instance-vars ,instance-list ,instance-init)
           (if (boundp ',name)
               (format t ";; Redefining ~a~%" ',name)
               (format t ";; CLASS ~a~%" ',name))
           (format t ";; CVARS ~a~%" ',class-vars)
           (format t ";; IVARS ~a~%" ',instance-vars)
           ,(if super
                `(setq ,name (send class :new ,instance-list ,class-list ,super))
                `(setq ,name (send class :new ,instance-list ,class-list)))
           ;; initialize class and instance variables
           (when ,class-list
             (send ,name :answer :isnew nil ,class-init)
             (let ((,x (send ,name :new)))))
           (when (or ,instance-list ,class-list)
             (send ,name :answer :isnew nil ,instance-init))
           ;; add slot-accessors to top-level classes
           ,(unless super
              `(progn
                 (send ,name :answer :internal-slot-set '(slot-name value)
                   '((eval (list 'setq slot-name value))))
                 (send ,name :answer :internal-slot-get '(slot-name)
                   '((eval slot-name))))))))

Sub-classes and objects inherit their acessors from the super-class.

Define a class with an instance-variable, a class-variable and slot acessors:

    > (defclass my-class nil
        ((a 1) (b 2) (c 3))
        ((d 4) (e 5) (f 6)))

    >

Back to top

## Generalized Slot Accessors

Now the slot accessors for internal class and instance variables can be defined as ordinary XLISP functions:

    (defun slot-set (object slot-name value)
      (send object :internal-slot-set slot-name value))

    (defun slot-get (object slot-name)
      (send object :internal-slot-get slot-name))

Examples:

    > (slot-set my-object 'i-var 333)
    333

    > (slot-get my-object 'i-var)
    333

Even typing the quote could be saved if 'slot-set' and 'slot-get' are defined as macros:

    (defmacro slot-set (object slot-name value)
      `(send ,object :internal-slot-set ',slot-name ,value))

    (defmacro slot-get (object slot-name)
      (send ,object :internal-slot-set ',slot-name ,value))

Examples:

    > (slot-set my-object i-var 444)
    444

    > (slot-get my-object i-var)
    444

Back to top

## Removing a Method from a Class or Instance

In Smalltalk, if a method's body is unbound and no other object refernces the method, then the method is automatically garbage collected. Unfortunately in XLISP this doesn't work because the instance variables, including the list of methods, are not accessed by the garbage collector at all. This means that even if the message body is set to NIL, the message is not garbage collected, instead the 'no function' message returns NIL and blocks the built-in search for super-class messages.

Because messages cannot be removed from XLISP objects, the only way to make a message 'disappear' is to replage it's body by a call to the super-class, passing the arguments of the original message:

    (defun remove-method (object message-selector &rest args)
      (send object message-selector
      (send-super message-selector args))

Shit: this doesn't work if the metod is defined in a super-class.

Back to top

Nyquist / XLISP 2.0 - Contents | Tutorials | Examples | Reference