bit-tree.lisp

(defclass bv-tree ()                                                                                                                                                                                                 
  ((data :initarg :data :initform nil)                                                                                                                                                                               
   (children :initarg children :initform nil)))                                                                                                                                                                      
                                                                                                                                                                                                                     
(defun access-bv-tree (base-tree bv &key (start 0) (end (length bv)))                                                                                                                                                
  (let ((node (loop for index from start below end                                                                                                                                                                   
                    for bit = (sbit bv index)                                                                                                                                                                        
                    for parent = base-tree then child                                                                                                                                                                
                    for child = (if (slot-value parent 'children)                                                                                                                                                    
                                    (aref (slot-value parent 'children) bit))                                                                                                                                        
                    while child                                                                                                                                                                                      
                    finally (return child))))                                                                                                                                                                        
    (and node                                                                                                                                                                                                        
         (slot-value node 'data))))                                                                                                                                                                                  
                                                                                                                                                                                                                     
(defun (setf access-bv-tree) (new-data base-tree bv &key (start 0) (end (length bv)))                                                                                                                                
  (let ((node (loop for index from start below end                                                                                                                                                                   
                    for bit = (sbit bv index)                                                                                                                                                                        
                    for parent = base-tree then child                                                                                                                                                                
                    for child = (if (slot-value parent 'children)                                                                                                                                                    
                                    (aref (slot-value parent 'children) bit)                                                                                                                                         
                                    (aref (setf (slot-value parent 'children)                                                                                                                                        
                                          (vector (make-instance 'bv-tree)                                                                                                                                           
                                                  (make-instance 'bv-tree)))                                                                                                                                         
                                          bit))                                                                                                                                                                      
                    finally (return child))))                                                                                                                                                                        
    (setf (slot-value node 'data) new-data)))