summaryrefslogtreecommitdiffstats
path: root/wttree.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
commit5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch)
tree540afc30c51da085f5bd8ec3f4c89f6496e7900d /wttree.scm
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz
slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'wttree.scm')
-rw-r--r--wttree.scm31
1 files changed, 9 insertions, 22 deletions
diff --git a/wttree.scm b/wttree.scm
index 238d372..7d3e010 100644
--- a/wttree.scm
+++ b/wttree.scm
@@ -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))))
;;;______________________________________________________________________
;;;