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 '
(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...>
1. Add an :isnew
(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 '
(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 '
> (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:
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.
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
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
(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.
(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
2. In the XLISP object system, an :answer message can only be
accessed in an instance of a class
3. If a method had been changed in a superclass, the change will
automatically be inherited by all instances of the class
[
Warning: If '
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 '
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
(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
({ |
|
|||||
({ |
|
(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))))))))
Define a class with an
> (defclass my-class nil ((a 1) (b 2) (c 3)) ((d 4) (e 5) (f 6))) >
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
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
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
(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.