Suggestion for extensions to ULOS (uLisp Object System)

#1

I’m working my way through porting some of my older stuff to uLisp. Since I like object oriented programming, I’m a happy user of the ingenious simple object system ULOS. Still it had one drawback to me which I tried to solve: It didn’t feature constructors, i.e. one would have to populate properties for each and every object “instance” individually when creating it. Thus I tried to implement a kind of constructor mechanism myself and it seems to work, so I thought I’d share what I did, maybe it’s considered helpful by others.
My apologies for possible logic mistakes, I’m still very new to Lisp. 2nd apology for renaming “object” to “class” in the following code as well as renaming “value” to “getv” and “update” to “setv”. I did that because it helps me to read the code more like I’m used to in Python or C (think “getter” and “setter” methods). The same applies to my parenthese formatting. Now here’s the slightly extended code:

; Define a class
(defun class (&optional parent slots constructor)
  (let ((obj (when parent (list (cons 'parent parent)))))
  	(when (and constructor parent)
  		(when (symbolp parent) (setq parent (eval parent)))
  		(loop
	         (when (null parent) (return parent))
	         (push (first parent) obj)
	         (setq parent (cdr parent)))
  	)
    (loop
     (when (null slots) (return obj))
     (push (cons (first slots) (second slots)) obj)
     (setq slots (cddr slots)))
  )
)

; Get the value of a slot in an instance/class or its parents
(defun getv (obj slot)
  (when (symbolp obj) (setq obj (eval obj)))
  (let ((pair (assoc slot obj)))
    (if pair (cdr pair)
           (let ((p (cdr (assoc 'parent obj))))
             (and p (getv p slot))))
  )
)

; Update a slot in an instance/class
(defun setv (obj slot value)
  (when (symbolp obj) (setq obj (eval obj)))
  (let ((pair (assoc slot obj)))
    (when pair (setf (cdr pair) value))
  )
)

; Add value and method slots (here obj needs to be passed quoted, i.e. by reference)
(defun add-prop (obj slots)
	(let (newlist) 
    (loop
     (when (null slots) (return))
     (push (cons (first slots) (second slots)) newlist)
     (setq slots (cddr slots)))
    (set obj (append (eval obj) newlist)) 
  )
)

Some further explanations:

  • The “constructor” mechanism works by simply copying properties from an object a new one is derived from. This has to be done deliberately by setting a third parameter in the “class” function to “t” (true). If it’s omitted/nil, the properties are not copied (i.e. no “constructor” used).
  • The mechanism keeps “class” and “instance” properties separated.
  • It’s still possible to add individual properties to “instances” using the existing slot mechanism in the “class” (“object”) function, i.e. pass by/extend inheritance.
  • The new fourth function “add-prop” provides a simplified way to add properties to any object anytime, comparable to the mechanism in JavaScript.
#2

The code above indeed has a logical caveat that needs to be fixed: My old “class” function copies all methods as well when called with the “constructor” mechanism. This is, of course, wrong - the whole point of inheritance is to only call methods provided by the class from within an instance (as opposed to copy them into the instance data block). Thus, the “class” function needs to distinguish between methods and attributes (that keep the data of an instance).
I implemented that now using the underscore “_” as the marker for methods, i.e. method names defined in a class need to start with the underscore (e.g. " _to-string ") to prevent them from being copied into an instance:

; Define a class
(defun class (&optional parent slots constructor)
  (let ((obj (when parent (list (cons 'parent parent)))))
  	(when (and constructor parent)
  		(when (symbolp parent) (setq parent (eval parent)))
  		(loop
	     (when (null parent) (return parent))
	     (unless (or (equal (search "_" (string (first parent))) 1) (search "parent" (string (first parent))) ) 
          (push (cons (car (first parent)) (cdr (first parent))) obj))
	     (setq parent (cdr parent)))
  	)
    (loop
     (when (null slots) (return obj))
     (push (cons (first slots) (second slots)) obj)
     (setq slots (cddr slots)))
  )
)

In addition I wrote a small generalized function that calls any method in any object (instance), eliminating the need for defining single external caller functions for all methods a class provides (as currently suggested on the ULOS page):

(defun call-method (obj method &optional arguments) 
 (apply (eval (getv obj method)) (append (list obj) arguments))
)

Use the function like this:

(call-method myobj '_my-method '(myarg1 myarg2))

(The number of arguments is arbitrary and depends on the method called - the argument list may contain any number of arguments or be omitted altogether.)

#3

Another tiny simplification: In “call-method” replace “&optional” by “&rest”. Then the arguments need not be enclosed in a list by a caller since “&rest” does this automatically:

(defun call-method (obj method &rest arguments) 
 (apply (eval (getv obj method)) (append (list obj) arguments))
)

Thus, use the new function like this:
(call-method myobj '_my-method myarg1 myarg2 myarg_n)

Saves some parentheses in nested calls.

#4

My apologies - the code within the “class” function posted here was still wrong - the “constructor” mechanism copied the bound symbols instead of their contents. The line in question needs to be:

(unless (equal (search “_” (string (first parent))) 1) (push (cons (car (first parent)) (cdr (first parent))) obj))

(Edited above to correct the code.) New cons cells (dotted pairs) need to be built and appended. This should have been obvious to me, but again: I’m new to Lisp and it’s still not easy for me to see flaws like this one. I’m sorry for the slight mess in this thread!

#5

Believe it or not, there’s been another mistake in the “class” function (already edited above, post 2 of 5).
The line

(unless (equal (search “_” (string (first parent))) 1)

needs to be extended to

(unless (or (equal (search “_” (string (first parent))) 1) (search “parent” (string (first parent))) )

Without this addition the “parent” slot is doubled in the subclass of a subclass (and further down the class hierarchy) - which is the reason I’ve discovered this so late; it’s rather rare to work with more than one subclass level. Apologies again!