Hey...
Im not sure if the following Routines are usefull to build a binary tree, but they build a tree
Just try it out...
They work recursivly, but anonym recursiv...
(without vl-....)
(setq setter
( (lambda (setter /)
(eval (list 'lambda '(data key newValue / ) (list setter setter 'data 'key 'newValue)))
)
(lambda (setter data key newValue / )
(cond
((and (listp data) (not (and (atom (cdr data)) (not (null (cdr data))))) (apply 'and (mapcar 'listp data)))
( (lambda (subdata otherdata / )
(cond
((and (null (cdr key)) newValue)
(cons (list (car key) newValue) otherdata)
)
((and (null (cdr key)) (null newValue)) otherdata)
('T
( (lambda (rec / )
(if rec
(cons (list (car key) rec) otherdata)
otherdata
)
)
(setter setter subdata (cdr key) newValue)
)
)
)
)
(cadr (assoc (car key) data))
( (lambda (nose tail / )
(repeat (length tail) (setq nose (cdr nose)))
(append (cdr tail) (reverse nose))
)
(reverse data)
(member (assoc (car key) data) data)
)
)
)
('T (if newValue
(list
(list
(car key)
( (lambda (k / )
(while k
(setq newValue (list (cons (car k) (list newValue))))
(setq k (cdr k))
)
newValue
)
(reverse (cdr key))
)
)
)
)
)
)
)
)
)
;-------------------------------------------------
(setq getter
( (lambda (getter / )
(eval (list 'lambda '(data key / ) (list getter getter 'data 'key)))
)
(lambda (getter data key / )
(cond
((and (listp data) (not (and (atom (cdr data)) (not (null (cdr data))))) (apply 'and (mapcar 'listp data)))
( (lambda (subdata / )
(if (null (cdr key)) subdata
(getter getter subdata (cdr key))
)
)
(cadr (assoc (car key) data))
)
)
('T data)
)
)
)
)
Usage:
(setq DataBase (setter nil '(1 2 3 4) "DataItem"))
;-> ((1 ((2 ((3 ((4 "DataItem"))))))))
(setq DataBase (setter DataBase '(1 2 3 5) "DataItem2"))
;-> ((1 ((2 ((3 ((5 "DataItem2") (4 "DataItem"))))))))
(setq DataBase (setter DataBase '(1 2 2) "DataItem3"))
;-> ((1 ((2 ((2 "DataItem3") (3 ((5 "DataItem2") (4 "DataItem"))))))))
;;toRemove a DataItem
(setq DataBase (setter DataBase '(1 2 3 4) nil))
;-> ((1 ((2 ((3 ((5 "DataItem2"))) (2 "DataItem3"))))))
;; and the 'getter' Function
(getter DataBase '(1 2 2))
;-> "DataItem3"
greets reltro