ignore build; add more lisp files
This commit is contained in:
26
lisp/ulos.lsp
Normal file
26
lisp/ulos.lsp
Normal file
@@ -0,0 +1,26 @@
|
||||
;
|
||||
; 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))))
|
||||
Reference in New Issue
Block a user