27 lines
801 B
Common Lisp
27 lines
801 B
Common Lisp
;
|
|
; ULOS simple object system
|
|
; see http://forum.ulisp.com/t/a-simple-object-system-for-ulisp/622
|
|
;
|
|
|
|
; Define an object
|
|
(defun object (&optional parent slots)
|
|
(let ((obj (when parent (list (cons 'parent 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 object or its parents
|
|
(defun value (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 (value p slot))))))
|
|
|
|
; Update a slot in an object
|
|
(defun update (obj slot value)
|
|
(when (symbolp obj) (setq obj (eval obj)))
|
|
(let ((pair (assoc slot obj)))
|
|
(when pair (setf (cdr pair) value))))
|