From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:38 -0800 Subject: Import Upstream version 3a5 --- wttree.scm | 68 +++++++++++++++++++++++++++++++------------------------------- 1 file changed, 34 insertions(+), 34 deletions(-) (limited to 'wttree.scm') diff --git a/wttree.scm b/wttree.scm index 7d3e010..43620d6 100644 --- a/wttree.scm +++ b/wttree.scm @@ -247,52 +247,52 @@ (define (n-join k v l r) (make-node k v l r (fix:+ 1 (fix:+ (node/size l) (node/size r))))) - (define (single-l a.k a.v x r) + (define (single-l a_k a_v x r) (with-n-node r - (lambda (b.k b.v y z) (n-join b.k b.v (n-join a.k a.v x y) z)))) + (lambda (b_k b_v y z) (n-join b_k b_v (n-join a_k a_v x y) z)))) - (define (double-l a.k a.v x r) + (define (double-l a_k a_v x r) (with-n-node r - (lambda (c.k c.v r.l z) - (with-n-node r.l - (lambda (b.k b.v y1 y2) - (n-join b.k b.v - (n-join a.k a.v x y1) - (n-join c.k c.v y2 z))))))) - - (define (single-r b.k b.v l z) + (lambda (c_k c_v r_l z) + (with-n-node r_l + (lambda (b_k b_v y1 y2) + (n-join b_k b_v + (n-join a_k a_v x y1) + (n-join c_k c_v y2 z))))))) + + (define (single-r b_k b_v l z) (with-n-node l - (lambda (a.k a.v x y) (n-join a.k a.v x (n-join b.k b.v y z))))) + (lambda (a_k a_v x y) (n-join a_k a_v x (n-join b_k b_v y z))))) - (define (double-r c.k c.v l z) + (define (double-r c_k c_v l z) (with-n-node l - (lambda (a.k a.v x l.r) - (with-n-node l.r - (lambda (b.k b.v y1 y2) - (n-join b.k b.v - (n-join a.k a.v x y1) - (n-join c.k c.v y2 z))))))) + (lambda (a_k a_v x l_r) + (with-n-node l_r + (lambda (b_k b_v y1 y2) + (n-join b_k b_v + (n-join a_k a_v x y1) + (n-join c_k c_v y2 z))))))) ;; (define-integrable wt-tree-ratio 5) (define wt-tree-ratio 5) (define (t-join k v l r) (define (simple-join) (n-join k v l r)) - (let ((l.n (node/size l)) - (r.n (node/size r))) - (cond ((fix:< (fix:+ l.n r.n) 2) (simple-join)) - ((fix:> r.n (fix:* wt-tree-ratio l.n)) + (let ((l_n (node/size l)) + (r_n (node/size r))) + (cond ((fix:< (fix:+ l_n r_n) 2) (simple-join)) + ((fix:> r_n (fix:* wt-tree-ratio l_n)) ;; right is too big - (let ((r.l.n (node/size (node/l r))) - (r.r.n (node/size (node/r r)))) - (if (fix:< r.l.n r.r.n) + (let ((r_l_n (node/size (node/l r))) + (r_r_n (node/size (node/r r)))) + (if (fix:< r_l_n r_r_n) (single-l k v l r) (double-l k v l r)))) - ((fix:> l.n (fix:* wt-tree-ratio r.n)) + ((fix:> l_n (fix:* wt-tree-ratio r_n)) ;; left is too big - (let ((l.l.n (node/size (node/l l))) - (l.r.n (node/size (node/r l)))) - (if (fix:< l.r.n l.l.n) + (let ((l_l_n (node/size (node/l l))) + (l_r_n (node/size (node/r l)))) + (if (fix:< l_r_n l_l_n) (single-r k v l r) (double-r k v l r)))) (else @@ -345,10 +345,10 @@ (define (node/index node index) (define (loop node index) - (let ((size.l (node/size (node/l node)))) - (cond ((fix:< index size.l) (loop (node/l node) index)) - ((fix:> index size.l) (loop (node/r node) - (fix:- index (fix:+ 1 size.l)))) + (let ((size_l (node/size (node/l node)))) + (cond ((fix:< index size_l) (loop (node/l node) index)) + ((fix:> index size_l) (loop (node/r node) + (fix:- index (fix:+ 1 size_l)))) (else node)))) (let ((bound (node/size node))) (if (or (< index 0) -- cgit v1.2.3