diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:28 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:28 -0800 |
commit | bd9733926076885e3417b74de76e4c9c7bc56254 (patch) | |
tree | 2c99dced547d48407ad44cb0e45e31bb4d02ce43 /wttree.scm | |
parent | fa3f23105ddcf07c5900de47f19af43d1db1b597 (diff) | |
download | slib-bd9733926076885e3417b74de76e4c9c7bc56254.tar.gz slib-bd9733926076885e3417b74de76e4c9c7bc56254.zip |
Import Upstream version 2c7upstream/2c7
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))) |