diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
commit | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch) | |
tree | 540afc30c51da085f5bd8ec3f4c89f6496e7900d /wttree.scm | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip |
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'wttree.scm')
-rw-r--r-- | wttree.scm | 31 |
1 files changed, 9 insertions, 22 deletions
@@ -63,21 +63,6 @@ ;; ;;(declare (usual-integrations)) -(define error:error - (case (scheme-implementation-type) - ((MITScheme) error) - (else slib:error))) -(define error:wrong-type-argument - (case (scheme-implementation-type) - ((MITScheme) error:wrong-type-argument) - (else (lambda (arg1 arg2 arg3) - (slib:error 'wrong-type-argument arg1 arg2 arg3))))) -(define error:bad-range-argument - (case (scheme-implementation-type) - ((MITScheme) error:bad-range-argument) - (else (lambda (arg1 arg2) - (slib:error 'bad-range-argument arg1 arg2))))) - ;;; ;;; Interface to this package. ;;; @@ -369,11 +354,11 @@ (if (or (< index 0) (>= index bound) (not (fix:fixnum? index))) - (error:bad-range-argument index 'node/index) + (slib:error 'bad-range-argument index 'node/index) (loop node index)))) (define (error:empty owner) - (error:error "Operation requires non-empty tree:" owner)) + (slib:error "Operation requires non-empty tree:" owner)) (define (local:make-wt-tree-type key<?) @@ -567,7 +552,7 @@ ((pair? alist) (loop (cdr alist) (node/add node (caar alist) (cdar alist)))) (else - (error:wrong-type-argument alist "alist" 'alist->tree)))) + (slib:error 'wrong-type-argument alist "alist" 'alist->tree)))) (%make-wt-tree my-type (loop alist empty))) (define (tree/get tree key default) @@ -607,18 +592,20 @@ (define (guarantee-tree tree procedure) (if (not (wt-tree? tree)) - (error:wrong-type-argument tree "weight-balanced tree" procedure))) + (slib:error 'wrong-type-argument + tree "weight-balanced tree" procedure))) (define (guarantee-tree-type type procedure) (if (not (tree-type? type)) - (error:wrong-type-argument type "weight-balanced tree type" procedure))) + (slib:error 'wrong-type-argument + type "weight-balanced tree type" procedure))) (define (guarantee-compatible-trees tree1 tree2 procedure) (guarantee-tree tree1 procedure) (guarantee-tree tree2 procedure) (if (not (eq? (tree/type tree1) (tree/type tree2))) - (error:error "The trees" tree1 'and tree2 'have 'incompatible 'types - (tree/type tree1) 'and (tree/type tree2)))) + (slib:error "The trees" tree1 'and tree2 'have 'incompatible 'types + (tree/type tree1) 'and (tree/type tree2)))) ;;;______________________________________________________________________ ;;; |