diff options
Diffstat (limited to 'wttree.scm')
| -rw-r--r-- | wttree.scm | 32 |
1 files changed, 16 insertions, 16 deletions
@@ -1,7 +1,7 @@ ;; "wttree.scm" Weight balanced trees -*-Scheme-*- ;; Copyright (c) 1993-1994 Stephen Adams ;; -;; $Id: wttree.scm,v 1.2 1998/02/09 23:13:10 jaffer Exp $ +;; $Id: wttree.scm,v 1.3 1999/10/11 03:36:29 jaffer Exp $ ;; ;; References: ;; @@ -44,7 +44,7 @@ ;; ;; Weight Balanced Binary Trees ;; -;; +;; ;; ;; This file has been modified from the MIT-Scheme library version to ;; make it more standard. The main changes are @@ -169,18 +169,18 @@ (define tag:tree-type (string->symbol "#[(runtime wttree)tree-type]")) - (define (%make-tree-type key<? alist->tree - add insert! - delete delete! - member? lookup - split-lt split-gt - union intersection - difference subset? + (define (%make-tree-type key<? alist->tree + add insert! + delete delete! + member? lookup + split-lt split-gt + union intersection + difference subset? rank ) (vector tag:tree-type - key<? alist->tree add insert! - delete delete! member? lookup - split-lt split-gt union intersection + key<? alist->tree add insert! + delete delete! member? lookup + split-lt split-gt union intersection difference subset? rank )) (define (tree-type? tt) @@ -401,11 +401,11 @@ (define (node/rank k node rank) (cond ((empty? node) #f) ((key<? k (node/k node)) (node/rank k (node/l node) rank)) - ((key>? k (node/k node)) + ((key>? k (node/k node)) (node/rank k (node/r node) (fix:+ 1 (fix:+ rank (node/size (node/l node)))))) (else (fix:+ rank (node/size (node/l node)))))) - + (define (node/add node k v) (if (empty? node) (node/singleton k v) @@ -463,7 +463,7 @@ ((key<? (node/k node) x) (node/split-gt (node/r node) x)) ((key<? x (node/k node)) - (node/concat3 (node/k node) (node/v node) + (node/concat3 (node/k node) (node/v node) (node/split-gt (node/l node) x) (node/r node))) (else (node/r node)))) @@ -566,7 +566,7 @@ (cond ((null? alist) node) ((pair? alist) (loop (cdr alist) (node/add node (caar alist) (cdar alist)))) - (else + (else (error:wrong-type-argument alist "alist" 'alist->tree)))) (%make-wt-tree my-type (loop alist empty))) |