xanadu - xml b-tree - 1

scsh/tmail/tforks.scm

@@ -33,7 +33,7 @@
 (define (run-daemon-child-mail rec)
   (let ((*hostname (hostname rec))
         (*port (port rec))
-        (*socket (socket rec))
+        (*socket (sock rec))
         (*motd (motd rec))
         (*ack (ack rec))
         (*apop (apop rec))
@@ -101,4 +101,4 @@
       (close-input-port in)
       (close-socket *socket)
       (close-output-port out)
-      (exit))))
+      (exit))))

scsh/xanadu/b-tree.scm

@@ -26,3 +26,31 @@
 ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+(define (make-b-tree)
+  (let ((*tree (make-vector 0)))
+
+    (define (goto-left-node str i tree)
+      (cond ((= (vector-length tree) i) (display "null node") (vector-set! tree i str))
+            (else #f))) 
+
+    (define (add-rec str tree)
+      (do ((i 0 (+ i 1)))
+	  ((eq? i (vector-length tree))
+           (grow-up) 
+        (let ((vi (vector-ref tree i)))
+          (cond ((string<=? str vi)
+                 0)
+                ((string>=? str vi)
+                 (grow-down))
+               ((string=? str vi)
+                (set! i (vector-length tree)))
+               (else (display "never reached."))))
+      ))
+        
+    (define (add str)
+      (add-rec *tree))
+
+    (define (dispatch msg)
+      (cond ((eq? msg 'add) add)
+            (else (display "b-tree : message not understood."))))
+	dispatch))