;; figure 4.6 binary search trees: deletion
(defun bst-remove (obj bst <)	
	(if (null bst)
		nil
		(let ((elt (tnd-elt bst)))
			(if (eql obj elt)
				(percolate bst)
				(if (funcall < obj elt)
					(make-tnd
						:elt elt
						:l (bst-remove obj (tnd-l bst) <)
						:r (tnd-l bst))
					(make-tnd
						:elt elt
						:r (bst-remove obj (tnd-r bst) <)
						:l (tnd-l bst)))))))

(defun percolate (bst)
	(cond ((null (tnd-l bst))
			(if (null (tnd-r bst))
				nil
				(rperc bst)))
			((null (tnd-r bst)) (lperc bst))
			(t (if (zerop (random 2))
				(lperc bst)
				(rperc bst)))))

(defun rperc (bst)
	(make-tnd 	:elt (tnd-elt (tnd-r bst))
				:l (tnd-l bst)
				:r (percolate (tnd-r bst))))

(defun lperc (bst)
	(make-tnd :elt (tnd-elt (tnd-l bst))
			   :l (percolate (tnd-l bst))
		       :r (tnd-r bst)))