tabs in srfi 146

lib/srfi/146/hamt-map-test.scm

@@ -38,61 +38,61 @@
     (define (sort-alist alist)
       (list-sort (lambda (a1 a2) (string<? (car a1) (car a2))) alist))
     (let ((contents (make-string-hash-table))
-	  (deleted-keys (make-string-set))
+      (deleted-keys (make-string-set))
-	  (deletion-odds 5)
+      (deletion-odds 5)
-	  (max-key-length 5)
+      (max-key-length 5)
-	  (operations 100))
+      (operations 100))
       (define (random-key)
-	(let ((size (+ (random-integer max-key-length) 1)))
+    (let ((size (+ (random-integer max-key-length) 1)))
-	  (with-output-to-string
+      (with-output-to-string
-	    (lambda ()
+        (lambda ()
-	      (do ((i 0 (+ i 1)))
+          (do ((i 0 (+ i 1)))
-		  ((= i size))
+          ((= i size))
-		(write-char (integer->char (+ 97 (random-integer 26)))))))))
+        (write-char (integer->char (+ 97 (random-integer 26)))))))))
       (define (fill-phm i phm)
-	(let ((size (hash-table-size contents)))
+    (let ((size (hash-table-size contents)))
-	  (cond ((zero? i) phm)
+      (cond ((zero? i) phm)
-		((and (not (zero? size))
+        ((and (not (zero? size))
-		      (zero? (random-integer deletion-odds)))
+              (zero? (random-integer deletion-odds)))
-		 (let ((key (list-ref (hash-table-keys contents)
+         (let ((key (list-ref (hash-table-keys contents)
-				      (random-integer size))))
+                      (random-integer size))))
-		   (set-adjoin! deleted-keys key)
+           (set-adjoin! deleted-keys key)
-		   (hash-table-delete! contents key)
+           (hash-table-delete! contents key)
-		   (fill-phm (- i 1)
+           (fill-phm (- i 1)
-			     (remove phm key))))
+                 (remove phm key))))
-		(else (let* ((key (random-key))
+        (else (let* ((key (random-key))
-			     (datum (random-integer 1000)))
+                 (datum (random-integer 1000)))
-			(set-delete! deleted-keys key)
+            (set-delete! deleted-keys key)
-			(hash-table-set! contents key datum)
+            (hash-table-set! contents key datum)
-			(fill-phm (- i 1)
+            (fill-phm (- i 1)
-				  (put phm key datum)))))))
+                  (put phm key datum)))))))
       (let ((phm (fill-phm operations
-			   (transform (make-phm string-hash string=?)))))
+               (transform (make-phm string-hash string=?)))))
-	(test-assert (= (phm/count phm) (hash-table-size contents)))
+    (test-assert (= (phm/count phm) (hash-table-size contents)))
-	(hash-table-for-each (lambda (key datum)
+    (hash-table-for-each (lambda (key datum)
-			       (test-assert (= datum (phm/get phm key -1)))
+                   (test-assert (= datum (phm/get phm key -1)))
-			       (test-assert (phm/contains? phm key)))
+                   (test-assert (phm/contains? phm key)))
-			     contents)
+                 contents)
-	(set-for-each (lambda (key)
+    (set-for-each (lambda (key)
-			(test-assert (= -1 (phm/get phm key -1)))
+            (test-assert (= -1 (phm/get phm key -1)))
-			(test-assert (not (phm/contains? phm key))))
+            (test-assert (not (phm/contains? phm key))))
-		      deleted-keys)
+              deleted-keys)
-	(let ((ht-alist (hash-table->alist contents))
+    (let ((ht-alist (hash-table->alist contents))
-	      (phm-alist (phm->alist phm)))
+          (phm-alist (phm->alist phm)))
-	  (test-assert (equal? (sort-alist ht-alist)
+      (test-assert (equal? (sort-alist ht-alist)
-			       (sort-alist phm-alist)))))))
+                   (sort-alist phm-alist)))))))
 
   (define (phm-remove-non-existent-test remove transform)
     (define (terrible-hash string) 0)
     (let ((phm (remove (transform (make-phm string-hash string=?))
-		       "not-present")))
+               "not-present")))
       (test-assert (zero? (phm/count phm)))
       (test-assert (not (phm/contains? phm "not-present")))
       (test-assert (not (phm/get phm "not-present" #f))))
     (let ((phm (remove (transform (phm/put (make-phm terrible-hash string=?)
-					   "foo"
+                       "foo"
-					   1))
+                       1))
-		       "not-present")))
+               "not-present")))
       (test-assert (= 1 (phm/count phm)))
       (test-assert (phm/contains? phm "foo"))
       (test-assert (not (phm/contains? phm "not-present")))))
@@ -102,72 +102,72 @@
       (list-sort (lambda (a1 a2) (string<? (car a1) (car a2))) alist))
     (define (terrible-hash string)
       (cond ((string=? string "foo") 0)
-	    ((string=? string "bar") 1)
+        ((string=? string "bar") 1)
-	    (else 2)))
+        (else 2)))
     (let* ((alist '(("foo" . 1) ("bar" . 2) ("baz" . 3) ("bat" . 4)
-		    ("quux" . 5)))
+            ("quux" . 5)))
-	   (phm-1 (fold (lambda (a phm) (put phm (car a) (cdr a)))
+       (phm-1 (fold (lambda (a phm) (put phm (car a) (cdr a)))
-			(transform (make-phm terrible-hash string=?))
+            (transform (make-phm terrible-hash string=?))
-			alist))
+            alist))
-	   (phm (put phm-1 "baz" 3)))
+       (phm (put phm-1 "baz" 3)))
       (assert-phm= phm alist)
       (let ((phm-alist (phm->alist phm)))
-	(test-assert (equal? (sort-alist alist)
+    (test-assert (equal? (sort-alist alist)
-			     (sort-alist phm-alist))))
+                 (sort-alist phm-alist))))
       (let ((alist-minus-baz (alist-delete "baz" alist string=?))
-	    (phm-minus-baz (remove (transform phm) "baz")))
+        (phm-minus-baz (remove (transform phm) "baz")))
-	(assert-phm= phm-minus-baz alist-minus-baz)
+    (assert-phm= phm-minus-baz alist-minus-baz)
-	(let ((phm-minus-nonexistent (remove phm-minus-baz "not-present")))
+    (let ((phm-minus-nonexistent (remove phm-minus-baz "not-present")))
-	  (test-equal = (phm/count phm-minus-nonexistent) (- (length alist) 1))
+      (test-equal = (phm/count phm-minus-nonexistent) (- (length alist) 1))
-	  (let ((alist-minus-bat (alist-delete "bat" alist-minus-baz string=?))
+      (let ((alist-minus-bat (alist-delete "bat" alist-minus-baz string=?))
-		(phm-minus-bat (remove phm-minus-nonexistent "bat")))
+        (phm-minus-bat (remove phm-minus-nonexistent "bat")))
-	    (assert-phm= phm-minus-bat alist-minus-bat))))))
+        (assert-phm= phm-minus-bat alist-minus-bat))))))
 
   (define (persistent-hash-map replace transform)
     (define (sort-alist alist)
       (list-sort (lambda (a1 a2) (string<? (car a1) (car a2))) alist))
     (let* ((alist-1 '(("a" . 1) ("b" . 2) ("c" . 3)))
-	   (alist-2 '(("a" . 1) ("b" . 4) ("c" . 3)))
+       (alist-2 '(("a" . 1) ("b" . 4) ("c" . 3)))
-	   (alist-3 '(("a" . 1) ("b" . 4)))
+       (alist-3 '(("a" . 1) ("b" . 4)))
-	   (phm (replace (transform (make-phm string-hash string=? alist-1))
+       (phm (replace (transform (make-phm string-hash string=? alist-1))
-			 "b"
+             "b"
-			 (lambda (x) 4))))
+             (lambda (x) 4))))
       (test-assert (equal? alist-2 (sort-alist (phm->alist phm))))
       (test-assert (equal? alist-3
-			   (sort-alist
+               (sort-alist
-			    (phm->alist
+                (phm->alist
-			     (replace phm "c" (lambda (x) hamt-null))))))))
+                 (replace phm "c" (lambda (x) hamt-null))))))))
 
   (define (hamt-max-depth hamt)
     "Return maximum depth of `hamt'.  For testing."
     (let descend ((n (hamt/root hamt)))
       (cond ((collision? n) 1)
-	    ((narrow? n)
+        ((narrow? n)
-	     (let* ((array (narrow/array n))
+         (let* ((array (narrow/array n))
-		    (stride (leaf-stride (hamt/payload? hamt)))
+            (stride (leaf-stride (hamt/payload? hamt)))
-		    (start (* stride (bit-count (narrow/leaves n))))
+            (start (* stride (bit-count (narrow/leaves n))))
-		    (end (vector-length array)))
+            (end (vector-length array)))
-	       (do ((i start (+ i 1))
+           (do ((i start (+ i 1))
-		    (high 0 (max high (descend (vector-ref array i)))))
+            (high 0 (max high (descend (vector-ref array i)))))
-		   ((= i end) (+ high 1)))))
+           ((= i end) (+ high 1)))))
-	    ((wide? n)
+        ((wide? n)
-	     (let ((array (wide/array n))
+         (let ((array (wide/array n))
-		   (c (wide/children n)))
+           (c (wide/children n)))
-	       (let next-child ((high 0)
+           (let next-child ((high 0)
-				(i 0))
+                (i 0))
-		 (cond ((next-set-bit c i hamt-bucket-size)
+         (cond ((next-set-bit c i hamt-bucket-size)
-			=> (lambda (j)
+            => (lambda (j)
-			     (next-child (max high
+                 (next-child (max high
-					      (descend (vector-ref array j)))
+                          (descend (vector-ref array j)))
-					 (+ j 1))))
+                     (+ j 1))))
-		       (else (+ high 1))))))
+               (else (+ high 1))))))
-	    (else (error "Invalid type of node." n)))))
+        (else (error "Invalid type of node." n)))))
 
   (test-begin "hamt-map")
 
   (test-group "(persistent-hash-map make-phm alist)"
     (let* ((alist '(("a" . 1) ("b" . 2)))
-	   (phm (make-phm string-hash string=? alist)))
+       (phm (make-phm string-hash string=? alist)))
       (test-assert (not (hamt/mutable? phm)))
       (assert-phm= phm alist)))
 
@@ -189,20 +189,20 @@
     (define (flip mutate? phm)
       ((if mutate? phm/mutable phm/immutable) phm))
     (phm-random-test (let ((mutate? #t))
-		       (lambda (phm key datum)
+               (lambda (phm key datum)
-			 (set! mutate? (not mutate?))
+             (set! mutate? (not mutate?))
-			 ((if mutate? phm/put! phm/put)
+             ((if mutate? phm/put! phm/put)
-			  (flip mutate? phm)
+              (flip mutate? phm)
-			  key
+              key
-			  datum)))
+              datum)))
-		     (let ((count 0))
+             (let ((count 0))
-		       (lambda (phm key)
+               (lambda (phm key)
-			 (set! count (remainder (+ count 1) 3))
+             (set! count (remainder (+ count 1) 3))
-			 (let ((mutate? (zero? count)))
+             (let ((mutate? (zero? count)))
-			   ((if mutate? phm/remove! phm/remove)
+               ((if mutate? phm/remove! phm/remove)
-			    (flip mutate? phm)
+                (flip mutate? phm)
-			    key))))
+                key))))
-		     (lambda (m) m)))
+             (lambda (m) m)))
 
   (test-group "(persistent-hash-map remove-non-existent pure)"
     (phm-remove-non-existent-test phm/remove (lambda (m) m)))
@@ -212,12 +212,12 @@
 
   (test-group "(persistent-hash-map phm/add-alist)"
     (let* ((alist '(("foo" . 1) ("bar" . 2) ("baz" . 3)))
-	   (phm (phm/add-alist (make-phm string-hash string=?) alist)))
+       (phm (phm/add-alist (make-phm string-hash string=?) alist)))
       (assert-phm= phm alist)))
 
   (test-group "(persistent-hash-map phm/add-alist!)"
     (let* ((alist '(("foo" . 1) ("bar" . 2) ("baz" . 3)))
-	   (phm (phm/mutable (make-phm string-hash string=?))))
+       (phm (phm/mutable (make-phm string-hash string=?))))
       (phm/add-alist! phm alist)
       (assert-phm= phm alist)))
 
@@ -231,26 +231,26 @@
     "Test that hashes that differ only above `hamt-hash-size' still work."
     (define big-hash
       (let* ((big-1 (expt 2 hamt-hash-size))
-	     (big-2 (* 2 big-1)))
+         (big-2 (* 2 big-1)))
-	(lambda (string)
+    (lambda (string)
-	  (cond ((string=? string "foo") big-1)
+      (cond ((string=? string "foo") big-1)
-		(else big-2)))))
+        (else big-2)))))
     (let* ((alist '(("foo" . 1) ("bar" . 2) ("baz" . 3) ("bat" . 4)
-		    ("quux" . 5)))
+            ("quux" . 5)))
-	   (phm (phm/add-alist (make-phm big-hash string=?) alist)))
+       (phm (phm/add-alist (make-phm big-hash string=?) alist)))
       (assert-phm= phm alist)))
 
   (test-group "(persistent-hash-map same-first-fragment)"
     (define (same-first-fragment string)
       (* hamt-bucket-size (string-hash string)))
     (let* ((alist '(("foo" . 1) ("bar" . 2) ("baz" . 3) ("bat" . 4)
-		    ("quux" . 5)))
+            ("quux" . 5)))
-	   (phm (phm/add-alist (make-phm same-first-fragment string=?) alist)))
+       (phm (phm/add-alist (make-phm same-first-fragment string=?) alist)))
       (assert-phm= phm alist)
       (let ((phm-minus-baz (phm/remove phm "baz")))
-	(assert-phm= phm-minus-baz (alist-delete "baz" alist string=?)))
+    (assert-phm= phm-minus-baz (alist-delete "baz" alist string=?)))
       (let ((phm-minus-nonexistent (phm/remove phm "not-present")))
-	(test-assert (= (phm/count phm-minus-nonexistent) (length alist))))))
+    (test-assert (= (phm/count phm-minus-nonexistent) (length alist))))))
 
   (test-group "(persistent-hash-map pure-mutate-interference)"
     "Test that mutating and pure operations interact with each other
@@ -258,20 +258,20 @@ correctly."
     (define (alist-replace alist key datum)
       (cons (cons key datum) (alist-delete key alist string=?)))
     (let* ((m0 (make-phm string-hash string=?))
-	   (a1 '(("foo" . 1) ("bar" . 2) ("baz" . 3)))
+       (a1 '(("foo" . 1) ("bar" . 2) ("baz" . 3)))
-	   (m1 (phm/add-alist m0 a1))
+       (m1 (phm/add-alist m0 a1))
-	   (a4 (alist-replace a1 "foo" 4))
+       (a4 (alist-replace a1 "foo" 4))
-	   (m2 (phm/put m1 "foo" 4))
+       (m2 (phm/put m1 "foo" 4))
-	   (a5 (alist-replace a1 "foo" 5))
+       (a5 (alist-replace a1 "foo" 5))
-	   (m3 (phm/mutable m2))
+       (m3 (phm/mutable m2))
-	   (m4 (phm/put! m3 "foo" 5))
+       (m4 (phm/put! m3 "foo" 5))
-	   (a6 (alist-replace a1 "foo" 6))
+       (a6 (alist-replace a1 "foo" 6))
-	   (m5 (phm/immutable m4))
+       (m5 (phm/immutable m4))
-	   (m6 (phm/mutable m5))
+       (m6 (phm/mutable m5))
-	   (m7 (phm/put! m6 "foo" 6))
+       (m7 (phm/put! m6 "foo" 6))
-	   (a7 (alist-replace a1 "foo" 7))
+       (a7 (alist-replace a1 "foo" 7))
-	   (a8 (alist-replace a1 "foo" 8))
+       (a8 (alist-replace a1 "foo" 8))
-	   (m8 (phm/put! m6 "foo" 7)))
+       (m8 (phm/put! m6 "foo" 7)))
       (phm/put! m4 "foo" 8)
       (assert-phm= m0 '())
       (assert-phm= m1 a1)
@@ -283,31 +283,31 @@ correctly."
       (assert-phm= m7 a7)
       (assert-phm= m8 a7)
       (let ((a (alist-delete "foo" a1 string=?))
-	    (m9 (phm/remove! m4 "foo")))
+        (m9 (phm/remove! m4 "foo")))
-	(assert-phm= m4 a)
+    (assert-phm= m4 a)
-	(assert-phm= m9 a))))
+    (assert-phm= m9 a))))
 
   (test-group "(persistent-hash-map phm/data)"
     (let* ((alist '(("a" . 1) ("b" . 2) ("c" . 3)))
-	   (data (phm/data (make-phm string-hash string=? alist))))
+       (data (phm/data (make-phm string-hash string=? alist))))
       (test-assert (equal? (map cdr alist)
-			   (list-sort < data)))))
+               (list-sort < data)))))
 
   (test-group "(persistent-hash-map phm/keys)"
     (let* ((alist '(("a" . 1) ("b" . 2) ("c" . 3)))
-	   (keys (phm/keys (make-phm string-hash string=? alist))))
+       (keys (phm/keys (make-phm string-hash string=? alist))))
       (test-assert (equal? (map car alist)
-			   (list-sort string<? keys)))))
+               (list-sort string<? keys)))))
 
   (test-group "(persistent-hash-map phm/for-each)"
     (define (sort-alist alist)
       (list-sort (lambda (a1 a2) (string<? (car a1) (car a2))) alist))
     (let* ((alist '(("a" . 1) ("b" . 2) ("c" . 3)))
-	   (phm (make-phm string-hash string=? alist))
+       (phm (make-phm string-hash string=? alist))
-	   (accumulator '()))
+       (accumulator '()))
       (phm/for-each (lambda (k d) (set! accumulator
-				   (cons (cons k d) accumulator)))
+                   (cons (cons k d) accumulator)))
-		    phm)
+            phm)
       (test-assert (equal? alist (sort-alist accumulator)))))
 
   (test-group "(persistent-hash-map phm/replace)"
@@ -320,12 +320,12 @@ correctly."
     (define (sort-alist alist)
       (list-sort (lambda (a1 a2) (string<? (car a1) (car a2))) alist))
     (let* ((alist-1 '(("a" . 1) ("b" . 2) ("c" . 3)))
-	   (alist-2 '(("a" . 1) ("b" . 5) ("c" . 3)))
+       (alist-2 '(("a" . 1) ("b" . 5) ("c" . 3)))
-	   (phm-1 (phm/mutable (make-phm string-hash string=? alist-1))))
+       (phm-1 (phm/mutable (make-phm string-hash string=? alist-1))))
       (phm/put! phm-1 "b" 4)
       (let ((phm-2 (phm/immutable phm-1
-				  (lambda (k d) (if (string=? k "b") (+ d 1) d)))))
+                  (lambda (k d) (if (string=? k "b") (+ d 1) d)))))
-	(test-assert (equal? alist-2 (sort-alist (phm->alist phm-2)))))))
+    (test-assert (equal? alist-2 (sort-alist (phm->alist phm-2)))))))
 
   (test-group "(persistent-hash-map phm/mutable?)"
     (let ((phm (make-phm string-hash string=?)))
@@ -336,26 +336,26 @@ correctly."
   (test-group "(persistent-hash-map modify-collision add-different-hash)"
     (define (terrible-hash string)
       (cond ((string=? string "foo") 0)
-	    ((string=? string "bar") 0)
+        ((string=? string "bar") 0)
-	    (else hamt-bucket-size)))	; same as 0 in bottom 5 bits
+        (else hamt-bucket-size)))    ; same as 0 in bottom 5 bits
     (let* ((alist '(("foo" . 1) ("bar" . 2)))
-	   (phm-1 (make-phm terrible-hash string=? alist))
+       (phm-1 (make-phm terrible-hash string=? alist))
-	   (phm-2 (phm/put phm-1 "baz" 3)))
+       (phm-2 (phm/put phm-1 "baz" 3)))
       (assert-phm= phm-2 '(("foo" . 1) ("bar" . 2) ("baz" . 3)))))
 
   (test-group "(persistent-hash-map lower-collision)"
     (define same-bottom-three-fragments (expt hamt-bucket-size 3))
     (define (terrible-hash string)
       (if (or (string=? string "foo")
-	      (string=? string "bar"))
+          (string=? string "bar"))
-	  same-bottom-three-fragments
+      same-bottom-three-fragments
-	  (* 2 same-bottom-three-fragments)))
+      (* 2 same-bottom-three-fragments)))
     (let* ((alist '(("foo" . 1) ("bar" . 2)))
-	   (phm-1 (make-phm terrible-hash string=? alist))
+       (phm-1 (make-phm terrible-hash string=? alist))
-	   (phm-2 (phm/put phm-1 "baz" 3))
+       (phm-2 (phm/put phm-1 "baz" 3))
-	   (phm-3 (phm/remove phm-2 "foo"))
+       (phm-3 (phm/remove phm-2 "foo"))
-	   (phm-4 (phm/remove phm-3 "bar"))
+       (phm-4 (phm/remove phm-3 "bar"))
-	   (phm-5 (phm/remove phm-4 "baz")))
+       (phm-5 (phm/remove phm-4 "baz")))
       (assert-phm= phm-2 '(("foo" . 1) ("bar" . 2) ("baz" . 3)))
       (assert-phm= phm-3 '(("bar" . 2) ("baz" . 3)))
       (assert-phm= phm-4 '(("baz" . 3)))

lib/srfi/146/hamt-map.scm

@@ -142,10 +142,10 @@
 (define (make-phm-inner hash = alist)
   (let ((phm (make-hamt = hash #t)))
     (if (null? alist)
-	phm
+    phm
-	(let ((phm-1 (phm/mutable phm)))
+    (let ((phm-1 (phm/mutable phm)))
-	  (phm/add-alist! phm-1 alist)
+      (phm/add-alist! phm-1 alist)
-	  (phm/immutable phm-1)))))
+      (phm/immutable phm-1)))))
 
 (define make-phm
   (case-lambda
@@ -197,8 +197,8 @@
   (assert (phm? phm))
   (let ((result (hamt-fetch phm key)))
     (if (hamt-null? result)
-	default
+    default
-	result)))
+    result)))
 
 (define phm/get
   (case-lambda

lib/srfi/146/hamt-misc-test.scm

@@ -27,13 +27,13 @@
 
   (test-group "(do-list)"
     (let ((index-accumulator '())
-	  (value-accumulator '())
+      (value-accumulator '())
-	  (all-values '(1 2 3 4 5)))
+      (all-values '(1 2 3 4 5)))
       (do-list (value all-values)
-	(set! value-accumulator (cons value value-accumulator)))
+    (set! value-accumulator (cons value value-accumulator)))
       (test all-values (reverse value-accumulator))
       (do-list (value index all-values)
-	(set! index-accumulator (cons index index-accumulator)))
+    (set! index-accumulator (cons index index-accumulator)))
       (test '(4 3 2 1 0) index-accumulator)))
 
   (test-end))

lib/srfi/146/hamt-misc.scm

@@ -27,8 +27,8 @@
     ((_ (operator argument ...))
      (unless (operator argument ...)
        (error "Assertion failed:"
-	      '(operator argument ...)
+          '(operator argument ...)
-	      (list 'operator argument ...))))
+          (list 'operator argument ...))))
     ((_ expression)
      (unless expression
        (error "Assertion failed:" 'expression)))))
@@ -37,15 +37,15 @@
   (syntax-rules ()
     ((_ (variable list) body ...)
      (do ((remaining list (cdr remaining)))
-	 ((null? remaining))
+     ((null? remaining))
        (let ((variable (car remaining)))
-	 body ...)))
+     body ...)))
     ((_ (element-variable index-variable list) body ...)
      (do ((remaining list (cdr remaining))
-	  (index-variable 0 (+ index-variable 1)))
+      (index-variable 0 (+ index-variable 1)))
-	 ((null? remaining))
+     ((null? remaining))
        (let ((element-variable (car remaining)))
-	 body ...)))))
+     body ...)))))
 
 (define string-comparator
   (make-comparator string? string=? #f string-hash))

lib/srfi/146/hash.scm

@@ -26,35 +26,35 @@
 (define (tree-search comparator tree obj failure success)
   (let ((entry (phm/get tree obj)))
     (if entry
-	(success (car entry) (cdr entry)
+    (success (car entry) (cdr entry)
-		 (lambda (new-key new-datum ret)
+         (lambda (new-key new-datum ret)
-		   (let ((tree (phm/remove tree obj)))
+           (let ((tree (phm/remove tree obj)))
-		     (values (phm/put tree new-key (cons new-key new-datum))
+             (values (phm/put tree new-key (cons new-key new-datum))
-			     ret)))
+                 ret)))
-		 (lambda (ret)
+         (lambda (ret)
-		   (values (phm/remove tree obj) ret)))
+           (values (phm/remove tree obj) ret)))
-	(failure (lambda (new-key new-datum ret)
+    (failure (lambda (new-key new-datum ret)
-		   (values (phm/put tree new-key (cons new-key new-datum))
+           (values (phm/put tree new-key (cons new-key new-datum))
-			   ret))
+               ret))
-		 (lambda (ret)
+         (lambda (ret)
-		   (values tree ret))))))
+           (values tree ret))))))
 
 (define (tree-fold proc seed tree)
   (phm/for-each (lambda (key entry)
-		  (set! seed (proc (car entry) (cdr entry) seed)))
+          (set! seed (proc (car entry) (cdr entry) seed)))
-		tree)
+        tree)
   seed)
 
 (define (tree-for-each proc tree)
   (phm/for-each (lambda (key entry)
-		  (proc (car entry) (cdr entry)))
+          (proc (car entry) (cdr entry)))
-		tree))
+        tree))
 
 (define (tree-generator tree)
   (make-coroutine-generator
    (lambda (yield)
      (tree-for-each (lambda item (yield item))
-		    tree))))
+            tree))))
 
 ;;; New types
 
@@ -67,8 +67,8 @@
 (define (make-empty-hashmap comparator)
   (assume (comparator? comparator))
   (%make-hashmap comparator
-		 (make-phm (comparator-hash-function comparator)
+         (make-phm (comparator-hash-function comparator)
-			   (comparator-equality-predicate comparator))))
+               (comparator-equality-predicate comparator))))
 
 ;;; Exported procedures
 
@@ -77,12 +77,12 @@
 (define (hashmap comparator . args)
   (assume (comparator? comparator))
   (hashmap-unfold null?
-	      (lambda (args)
+          (lambda (args)
-		(values (car args)
+        (values (car args)
-			(cadr args)))
+            (cadr args)))
-	      cddr
+          cddr
-	      args
+          args
-	      comparator))
+          comparator))
 
 (define (hashmap-unfold stop? mapper successor seed comparator)
   (assume (procedure? stop?))
@@ -90,13 +90,13 @@
   (assume (procedure? successor))
   (assume (comparator? comparator))
   (let loop ((hashmap (make-empty-hashmap comparator))
-	     (seed seed))
+         (seed seed))
     (if (stop? seed)
-	hashmap
+    hashmap
-	(receive (key value)
+    (receive (key value)
-	    (mapper seed)
+        (mapper seed)
-	  (loop (hashmap-adjoin hashmap key value)
+      (loop (hashmap-adjoin hashmap key value)
-		(successor seed))))))
+        (successor seed))))))
 
 ;; Predicates
 
@@ -109,11 +109,11 @@
   (call/cc
    (lambda (return)
      (hashmap-search hashmap
-		 key
+         key
-		 (lambda (insert ignore)
+         (lambda (insert ignore)
-		   (return #f))
+           (return #f))
-		 (lambda (key value update remove)
+         (lambda (key value update remove)
-		   (return #t))))))
+           (return #t))))))
 
 (define (hashmap-disjoint? hashmap1 hashmap2)
   (assume (hashmap? hashmap1))
@@ -121,9 +121,9 @@
   (call/cc
    (lambda (return)
      (hashmap-for-each (lambda (key value)
-		     (when (hashmap-contains? hashmap2 key)
+             (when (hashmap-contains? hashmap2 key)
-		       (return #f)))
+               (return #f)))
-		   hashmap1)
+           hashmap1)
      #t)))
 
 ;; Accessors
@@ -133,24 +133,24 @@
     ((hashmap key)
      (assume (hashmap? hashmap))
      (hashmap-ref hashmap key (lambda ()
-			(error "hashmap-ref: key not in hashmap" key))))
+            (error "hashmap-ref: key not in hashmap" key))))
     ((hashmap key failure)
      (assume (hashmap? hashmap))
      (assume (procedure? failure))
      (hashmap-ref hashmap key failure (lambda (value)
-				value)))
+                value)))
     ((hashmap key failure success)
      (assume (hashmap? hashmap))
      (assume (procedure? failure))
      (assume (procedure? success))
      ((call/cc
        (lambda (return-thunk)
-	 (hashmap-search hashmap
+     (hashmap-search hashmap
-			 key
+             key
-			 (lambda (insert ignore)
+             (lambda (insert ignore)
-			   (return-thunk failure))
+               (return-thunk failure))
-			 (lambda (key value update remove)
+             (lambda (key value update remove)
-			   (return-thunk (lambda () (success value)))))))))))
+               (return-thunk (lambda () (success value)))))))))))
 
 (define (hashmap-ref/default hashmap key default)
   (assume (hashmap? hashmap))
@@ -161,25 +161,25 @@
 (define (hashmap-adjoin hashmap . args)
   (assume (hashmap? hashmap))
   (let loop ((args args)
-	     (hashmap hashmap))
+         (hashmap hashmap))
     (if (null? args)
-	hashmap
+    hashmap
-	(receive (hashmap value)
+    (receive (hashmap value)
-	    (hashmap-intern hashmap (car args) (lambda () (cadr args)))
+        (hashmap-intern hashmap (car args) (lambda () (cadr args)))
-	  (loop (cddr args) hashmap)))))
+      (loop (cddr args) hashmap)))))
 
 (define hashmap-adjoin! hashmap-adjoin)
 
 (define (hashmap-set hashmap . args)
   (assume (hashmap? hashmap))
   (let loop ((args args)
-	     (hashmap hashmap))
+         (hashmap hashmap))
     (if (null? args)
-	hashmap
+    hashmap
-	(receive (hashmap)
+    (receive (hashmap)
-	    (hashmap-update hashmap (car args) (lambda (value) (cadr args)) (lambda () #f))
+        (hashmap-update hashmap (car args) (lambda (value) (cadr args)) (lambda () #f))
-	  (loop (cddr args)
+      (loop (cddr args)
-		hashmap)))))
+        hashmap)))))
 
 (define hashmap-set! hashmap-set)
 
@@ -187,11 +187,11 @@
   (assume (hashmap? hashmap))
   (receive (hashmap obj)
       (hashmap-search hashmap
-		  key
+          key
-		  (lambda (insert ignore)
+          (lambda (insert ignore)
-		    (ignore #f))
+            (ignore #f))
-		  (lambda (old-key old-value update remove)
+          (lambda (old-key old-value update remove)
-		    (update key value #f)))
+            (update key value #f)))
     hashmap))
 
 (define hashmap-replace! hashmap-replace)
@@ -206,15 +206,15 @@
   (assume (hashmap? hashmap))
   (assume (list? keys))
   (fold (lambda (key hashmap)
-	  (receive (hashmap obj)
+      (receive (hashmap obj)
-	      (hashmap-search hashmap
+          (hashmap-search hashmap
-			  key
+              key
-			  (lambda (insert ignore)
+              (lambda (insert ignore)
-			    (ignore #f))
+                (ignore #f))
-			  (lambda (old-key old-value update remove)
+              (lambda (old-key old-value update remove)
-			    (remove #f)))
+                (remove #f)))
-	    hashmap))
+        hashmap))
-	hashmap keys))
+    hashmap keys))
 
 (define hashmap-delete-all! hashmap-delete-all)
 
@@ -224,13 +224,13 @@
   (call/cc
    (lambda (return)
      (hashmap-search hashmap
-		 key
+         key
-		 (lambda (insert ignore)
+         (lambda (insert ignore)
-		   (receive (value)
+           (receive (value)
-		       (failure)
+               (failure)
-		     (insert value value)))
+             (insert value value)))
-		 (lambda (old-key old-value update remove)
+         (lambda (old-key old-value update remove)
-		   (return hashmap old-value))))))
+           (return hashmap old-value))))))
 
 (define hashmap-intern! hashmap-intern)
 
@@ -238,22 +238,22 @@
   (case-lambda
    ((hashmap key updater)
     (hashmap-update hashmap key updater (lambda ()
-				  (error "hashmap-update: key not found in hashmap" key))))
+                  (error "hashmap-update: key not found in hashmap" key))))
    ((hashmap key updater failure)
     (hashmap-update hashmap key updater failure (lambda (value)
-					  value)))
+                      value)))
    ((hashmap key updater failure success)
     (assume (hashmap? hashmap))
     (assume (procedure? updater))
     (assume (procedure? failure))
     (assume (procedure? success))
     (receive (hashmap obj)
-	(hashmap-search hashmap
+    (hashmap-search hashmap
-		    key
+            key
-		    (lambda (insert ignore)
+            (lambda (insert ignore)
-		      (insert (updater (failure)) #f))
+              (insert (updater (failure)) #f))
-		    (lambda (old-key old-value update remove)
+            (lambda (old-key old-value update remove)
-		      (update key (updater (success old-value)) #f)))
+              (update key (updater (success old-value)) #f)))
       hashmap))))
 
 (define hashmap-update! hashmap-update)
@@ -267,16 +267,16 @@
   (case-lambda
     ((hashmap)
      (hashmap-pop hashmap (lambda ()
-			    (error "hashmap-pop: hashmap has no association"))))
+                (error "hashmap-pop: hashmap has no association"))))
     ((hashmap failure)
      (assume (hashmap? hashmap))
      (assume (procedure? failure))
      ((call/cc
        (lambda (return-thunk)
-	 (receive (key value)
+     (receive (key value)
-	     (hashmap-find (lambda (key value) #t) hashmap (lambda () (return-thunk failure)))
+         (hashmap-find (lambda (key value) #t) hashmap (lambda () (return-thunk failure)))
-	   (lambda ()
+       (lambda ()
-	     (values (hashmap-delete hashmap key) key value)))))))))
+         (values (hashmap-delete hashmap key) key value)))))))))
 
 (define hashmap-pop! hashmap-pop)
 
@@ -287,20 +287,20 @@
   (call/cc
    (lambda (return)
      (let*-values
-	 (((comparator)
+     (((comparator)
-	   (hashmap-key-comparator hashmap))
+       (hashmap-key-comparator hashmap))
-	  ((tree obj)
+      ((tree obj)
-	   (tree-search comparator
+       (tree-search comparator
-			(hashmap-tree hashmap)
+            (hashmap-tree hashmap)
-			key
+            key
-			(lambda (insert ignore)
+            (lambda (insert ignore)
-			  (failure (lambda (value obj)
+              (failure (lambda (value obj)
-				     (insert key value obj))
+                     (insert key value obj))
-				   (lambda (obj)
+                   (lambda (obj)
-				     (return hashmap obj))))
+                     (return hashmap obj))))
-			success)))
+            success)))
        (values (%make-hashmap comparator tree)
-	       obj)))))
+           obj)))))
 
 (define hashmap-search! hashmap-search)
 
@@ -309,8 +309,8 @@
 (define (hashmap-size hashmap)
   (assume (hashmap? hashmap))
   (hashmap-count (lambda (key value)
-	       #t)
+           #t)
-	     hashmap))
+         hashmap))
 
 (define (hashmap-find predicate hashmap failure)
   (assume (procedure? predicate))
@@ -319,19 +319,19 @@
   (call/cc
    (lambda (return)
      (hashmap-for-each (lambda (key value)
-		     (when (predicate key value)
+             (when (predicate key value)
-		       (return key value)))
+               (return key value)))
-		   hashmap)
+           hashmap)
      (failure))))
 
 (define (hashmap-count predicate hashmap)
   (assume (procedure? predicate))
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value count)
-	      (if (predicate key value)
+          (if (predicate key value)
-		  (+ 1 count)
+          (+ 1 count)
-		  count))
+          count))
-	    0 hashmap))
+        0 hashmap))
 
 (define (hashmap-any? predicate hashmap)
   (assume (procedure? predicate))
@@ -339,34 +339,34 @@
   (call/cc
    (lambda (return)
      (hashmap-for-each (lambda (key value)
-		     (when (predicate key value)
+             (when (predicate key value)
-		       (return #t)))
+               (return #t)))
-		   hashmap)
+           hashmap)
      #f)))
 
 (define (hashmap-every? predicate hashmap)
   (assume (procedure? predicate))
   (assume (hashmap? hashmap))
   (not (hashmap-any? (lambda (key value)
-		   (not (predicate key value)))
+           (not (predicate key value)))
-		 hashmap)))
+         hashmap)))
 
 (define (hashmap-keys hashmap)
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value keys)
-		  (cons key keys))
+          (cons key keys))
-		'() hashmap))
+        '() hashmap))
 
 (define (hashmap-values hashmap)
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value values)
-		  (cons value values))
+          (cons value values))
-		'() hashmap))
+        '() hashmap))
 
 (define (hashmap-entries hashmap)
   (assume (hashmap? hashmap))
   (values (hashmap-keys hashmap)
-	  (hashmap-values hashmap)))
+      (hashmap-values hashmap)))
 
 ;; Hashmap and folding
 
@@ -375,11 +375,11 @@
   (assume (comparator? comparator))
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value hashmap)
-	      (receive (key value)
+          (receive (key value)
-		  (proc key value)
+          (proc key value)
-		(hashmap-set hashmap key value)))
+        (hashmap-set hashmap key value)))
-	    (make-empty-hashmap comparator)
+        (make-empty-hashmap comparator)
-	    hashmap))
+        hashmap))
 
 (define (hashmap-for-each proc hashmap)
   (assume (procedure? proc))
@@ -395,19 +395,19 @@
   (assume (procedure? proc))
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value lst)
-		  (cons (proc key value) lst))
+          (cons (proc key value) lst))
-		'()
+        '()
-		hashmap))
+        hashmap))
 
 (define (hashmap-filter predicate hashmap)
   (assume (procedure? predicate))
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value hashmap)
-	      (if (predicate key value)
+          (if (predicate key value)
-		  (hashmap-set hashmap key value)
+          (hashmap-set hashmap key value)
-		  hashmap))
+          hashmap))
-	    (make-empty-hashmap (hashmap-key-comparator hashmap))
+        (make-empty-hashmap (hashmap-key-comparator hashmap))
-	    hashmap))
+        hashmap))
 
 (define hashmap-filter! hashmap-filter)
 
@@ -415,8 +415,8 @@
   (assume (procedure? predicate))
   (assume (hashmap? hashmap))
   (hashmap-filter (lambda (key value)
-		(not (predicate key value)))
+        (not (predicate key value)))
-	      hashmap))
+          hashmap))
 
 (define hashmap-remove! hashmap-remove)
 
@@ -424,7 +424,7 @@
   (assume (procedure? predicate))
   (assume (hashmap? hashmap))
   (values (hashmap-filter predicate hashmap)
-	  (hashmap-remove predicate hashmap)))
+      (hashmap-remove predicate hashmap)))
 
 (define hashmap-partition! hashmap-partition)
 
@@ -437,30 +437,30 @@
 (define (hashmap->alist hashmap)
   (assume (hashmap? hashmap))
   (hashmap-fold (lambda (key value alist)
-		  (cons (cons key value) alist))
+          (cons (cons key value) alist))
-		'() hashmap))
+        '() hashmap))
 
 (define (alist->hashmap comparator alist)
   (assume (comparator? comparator))
   (assume (list? alist))
   (hashmap-unfold null?
-	      (lambda (alist)
+          (lambda (alist)
-		(let ((key (caar alist))
+        (let ((key (caar alist))
-		      (value (cdar alist)))
+              (value (cdar alist)))
-		  (values key value)))
+          (values key value)))
-	      cdr
+          cdr
-	      alist
+          alist
-	      comparator))
+          comparator))
 
 (define (alist->hashmap! hashmap alist)
   (assume (hashmap? hashmap))
   (assume (list? alist))
   (fold (lambda (association hashmap)
-	  (let ((key (car association))
+      (let ((key (car association))
-		(value (cdr association)))
+        (value (cdr association)))
-	    (hashmap-set hashmap key value)))
+        (hashmap-set hashmap key value)))
-	hashmap
+    hashmap
-	alist))
+    alist))
 
 ;; Subhashmaps
 
@@ -500,12 +500,12 @@
   (assume (hashmap? hashmap1))
   (assume (hashmap? hashmap2))
   (hashmap-every? (lambda (key value)
-		    (hashmap-ref hashmap2 key
+            (hashmap-ref hashmap2 key
-				 (lambda ()
+                 (lambda ()
-				   #f)
+                   #f)
-				 (lambda (stored-value)
+                 (lambda (stored-value)
-				   (=? comparator value stored-value))))
+                   (=? comparator value stored-value))))
-		  hashmap1))
+          hashmap1))
 
 (define hashmap>?
   (case-lambda
@@ -580,44 +580,44 @@
 
 (define (%hashmap-union hashmap1 hashmap2)
   (hashmap-fold (lambda (key2 value2 hashmap)
-		  (receive (hashmap obj)
+          (receive (hashmap obj)
-		      (hashmap-search hashmap
+              (hashmap-search hashmap
-				      key2
+                      key2
-				      (lambda (insert ignore)
+                      (lambda (insert ignore)
-					(insert value2 #f))
+                    (insert value2 #f))
-				      (lambda (key1 value1 update remove)
+                      (lambda (key1 value1 update remove)
-					(update key1 value1 #f)))
+                    (update key1 value1 #f)))
-		    hashmap))
+            hashmap))
-		hashmap1 hashmap2))
+        hashmap1 hashmap2))
 
 (define (%hashmap-intersection hashmap1 hashmap2)
   (hashmap-filter (lambda (key1 value1)
-		(hashmap-contains? hashmap2 key1))
+        (hashmap-contains? hashmap2 key1))
-	      hashmap1))
+          hashmap1))
 
 (define (%hashmap-difference hashmap1 hashmap2)
   (hashmap-fold (lambda (key2 value2 hashmap)
-	      (receive (hashmap obj)
+          (receive (hashmap obj)
-		  (hashmap-search hashmap
+          (hashmap-search hashmap
-			      key2
+                  key2
-			      (lambda (insert ignore)
+                  (lambda (insert ignore)
-				(ignore #f))
+                (ignore #f))
-			      (lambda (key1 value1 update remove)
+                  (lambda (key1 value1 update remove)
-				(remove #f)))
+                (remove #f)))
-		hashmap))
+        hashmap))
-	    hashmap1 hashmap2))
+        hashmap1 hashmap2))
 
 (define (%hashmap-xor hashmap1 hashmap2)
   (hashmap-fold (lambda (key2 value2 hashmap)
-	      (receive (hashmap obj)
+          (receive (hashmap obj)
-		  (hashmap-search hashmap
+          (hashmap-search hashmap
-			      key2
+                  key2
-			      (lambda (insert ignore)
+                  (lambda (insert ignore)
-				(insert value2 #f))
+                (insert value2 #f))
-			      (lambda (key1 value1 update remove)
+                  (lambda (key1 value1 update remove)
-				(remove #f)))
+                (remove #f)))
-		hashmap))
+        hashmap))
-	    hashmap1 hashmap2))
+        hashmap1 hashmap2))
 
 (define hashmap-union
   (case-lambda
@@ -695,9 +695,9 @@
 
 (define (make-hashmap-comparator comparator)
   (make-comparator hashmap?
-		   (hashmap-equality comparator)
+           (hashmap-equality comparator)
-		   #f
+           #f
-		   (hashmap-hash-function comparator)))
+           (hashmap-hash-function comparator)))
 
 (define hashmap-comparator (make-hashmap-comparator (make-default-comparator)))
 

lib/srfi/146/mapping.scm

@@ -40,12 +40,12 @@
 (define (mapping comparator . args)
   (assume (comparator? comparator))
   (mapping-unfold null?
-	      (lambda (args)
+          (lambda (args)
-		(values (car args)
+        (values (car args)
-			(cadr args)))
+            (cadr args)))
-	      cddr
+          cddr
-	      args
+          args
-	      comparator))
+          comparator))
 
 (define (mapping-unfold stop? mapper successor seed comparator)
   (assume (procedure? stop?))
@@ -53,13 +53,13 @@
   (assume (procedure? successor))
   (assume (comparator? comparator))
   (let loop ((mapping (make-empty-mapping comparator))
-	     (seed seed))
+         (seed seed))
     (if (stop? seed)
-	mapping
+    mapping
-	(receive (key value)
+    (receive (key value)
-	    (mapper seed)
+        (mapper seed)
-	  (loop (mapping-adjoin mapping key value)
+      (loop (mapping-adjoin mapping key value)
-		(successor seed))))))
+        (successor seed))))))
 
 (define mapping/ordered mapping)
 (define mapping-unfold/ordered mapping-unfold)
@@ -75,11 +75,11 @@
   (call/cc
    (lambda (return)
      (mapping-search mapping
-		 key
+         key
-		 (lambda (insert ignore)
+         (lambda (insert ignore)
-		   (return #f))
+           (return #f))
-		 (lambda (key value update remove)
+         (lambda (key value update remove)
-		   (return #t))))))
+           (return #t))))))
 
 (define (mapping-disjoint? mapping1 mapping2)
   (assume (mapping? mapping1))
@@ -87,9 +87,9 @@
   (call/cc
    (lambda (return)
      (mapping-for-each (lambda (key value)
-		     (when (mapping-contains? mapping2 key)
+             (when (mapping-contains? mapping2 key)
-		       (return #f)))
+               (return #f)))
-		   mapping1)
+           mapping1)
      #t)))
 
 ;; Accessors
@@ -99,24 +99,24 @@
     ((mapping key)
      (assume (mapping? mapping))
      (mapping-ref mapping key (lambda ()
-			(error "mapping-ref: key not in mapping" key))))
+            (error "mapping-ref: key not in mapping" key))))
     ((mapping key failure)
      (assume (mapping? mapping))
      (assume (procedure? failure))
      (mapping-ref mapping key failure (lambda (value)
-				value)))
+                value)))
     ((mapping key failure success)
      (assume (mapping? mapping))
      (assume (procedure? failure))
      (assume (procedure? success))
      ((call/cc
        (lambda (return-thunk)
-	 (mapping-search mapping
+     (mapping-search mapping
-			 key
+             key
-			 (lambda (insert ignore)
+             (lambda (insert ignore)
-			   (return-thunk failure))
+               (return-thunk failure))
-			 (lambda (key value update remove)
+             (lambda (key value update remove)
-			   (return-thunk (lambda () (success value)))))))))))
+               (return-thunk (lambda () (success value)))))))))))
 
 (define (mapping-ref/default mapping key default)
   (assume (mapping? mapping))
@@ -127,25 +127,25 @@
 (define (mapping-adjoin mapping . args)
   (assume (mapping? mapping))
   (let loop ((args args)
-	     (mapping mapping))
+         (mapping mapping))
     (if (null? args)
-	mapping
+    mapping
-	(receive (mapping value)
+    (receive (mapping value)
-	    (mapping-intern mapping (car args) (lambda () (cadr args)))
+        (mapping-intern mapping (car args) (lambda () (cadr args)))
-	  (loop (cddr args) mapping)))))
+      (loop (cddr args) mapping)))))
 
 (define mapping-adjoin! mapping-adjoin)
 
 (define (mapping-set mapping . args)
   (assume (mapping? mapping))
   (let loop ((args args)
-	     (mapping mapping))
+         (mapping mapping))
     (if (null? args)
-	mapping
+    mapping
-	(receive (mapping)
+    (receive (mapping)
-	    (mapping-update mapping (car args) (lambda (value) (cadr args)) (lambda () #f))	
+        (mapping-update mapping (car args) (lambda (value) (cadr args)) (lambda () #f))    
-	  (loop (cddr args)
+      (loop (cddr args)
-		mapping)))))
+        mapping)))))
 
 (define mapping-set! mapping-set)
 
@@ -153,11 +153,11 @@
   (assume (mapping? mapping))
   (receive (mapping obj)
       (mapping-search mapping
-		  key
+          key
-		  (lambda (insert ignore)
+          (lambda (insert ignore)
-		    (ignore #f))
+            (ignore #f))
-		  (lambda (old-key old-value update remove)
+          (lambda (old-key old-value update remove)
-		    (update key value #f)))
+            (update key value #f)))
     mapping))
 
 (define mapping-replace! mapping-replace)
@@ -172,15 +172,15 @@
   (assume (mapping? mapping))
   (assume (list? keys))
   (fold (lambda (key mapping)
-	  (receive (mapping obj)
+      (receive (mapping obj)
-	      (mapping-search mapping
+          (mapping-search mapping
-			  key
+              key
-			  (lambda (insert ignore)
+              (lambda (insert ignore)
-			    (ignore #f))
+                (ignore #f))
-			  (lambda (old-key old-value update remove)
+              (lambda (old-key old-value update remove)
-			    (remove #f)))
+                (remove #f)))
-	    mapping))
+        mapping))
-	mapping keys))
+    mapping keys))
 
 (define mapping-delete-all! mapping-delete-all)
 
@@ -190,13 +190,13 @@
   (call/cc
    (lambda (return)
      (mapping-search mapping
-		 key
+         key
-		 (lambda (insert ignore)
+         (lambda (insert ignore)
-		   (receive (value)
+           (receive (value)
-		       (failure)
+               (failure)
-		     (insert value value)))
+             (insert value value)))
-		 (lambda (old-key old-value update remove)
+         (lambda (old-key old-value update remove)
-		   (return mapping old-value))))))
+           (return mapping old-value))))))
 
 (define mapping-intern! mapping-intern)
 
@@ -204,22 +204,22 @@
   (case-lambda
    ((mapping key updater)
     (mapping-update mapping key updater (lambda ()
-				  (error "mapping-update: key not found in mapping" key))))
+                  (error "mapping-update: key not found in mapping" key))))
    ((mapping key updater failure)
     (mapping-update mapping key updater failure (lambda (value)
-					  value)))
+                      value)))
    ((mapping key updater failure success)
     (assume (mapping? mapping))
     (assume (procedure? updater))
     (assume (procedure? failure))
     (assume (procedure? success))
     (receive (mapping obj)
-	(mapping-search mapping
+    (mapping-search mapping
-		    key
+            key
-		    (lambda (insert ignore)
+            (lambda (insert ignore)
-		      (insert (updater (failure)) #f))
+              (insert (updater (failure)) #f))
-		    (lambda (old-key old-value update remove)
+            (lambda (old-key old-value update remove)
-		      (update key (updater (success old-value)) #f)))
+              (update key (updater (success old-value)) #f)))
       mapping))))
 
 (define mapping-update! mapping-update)
@@ -233,16 +233,16 @@
   (case-lambda
     ((mapping)
      (mapping-pop mapping (lambda ()
-			    (error "mapping-pop: mapping has no association"))))
+                (error "mapping-pop: mapping has no association"))))
     ((mapping failure)
      (assume (mapping? mapping))
      (assume (procedure? failure))
      ((call/cc
        (lambda (return-thunk)
-	 (receive (key value)
+     (receive (key value)
-	     (mapping-find (lambda (key value) #t) mapping (lambda () (return-thunk failure)))
+         (mapping-find (lambda (key value) #t) mapping (lambda () (return-thunk failure)))
-	   (lambda ()
+       (lambda ()
-	     (values (mapping-delete mapping key) key value)))))))))
+         (values (mapping-delete mapping key) key value)))))))))
 
 (define mapping-pop! mapping-pop)
 
@@ -253,20 +253,20 @@
   (call/cc
    (lambda (return)
      (let*-values
-	 (((comparator)
+     (((comparator)
-	   (mapping-key-comparator mapping))
+       (mapping-key-comparator mapping))
-	  ((tree obj)
+      ((tree obj)
-	   (tree-search comparator
+       (tree-search comparator
-			(mapping-tree mapping)
+            (mapping-tree mapping)
-			key
+            key
-			(lambda (insert ignore)
+            (lambda (insert ignore)
-			  (failure (lambda (value obj)
+              (failure (lambda (value obj)
-				     (insert key value obj))
+                     (insert key value obj))
-				   (lambda (obj)
+                   (lambda (obj)
-				     (return mapping obj))))
+                     (return mapping obj))))
-			success)))
+            success)))
        (values (%make-mapping comparator tree)
-	       obj)))))
+           obj)))))
 
 (define mapping-search! mapping-search)
 
@@ -275,8 +275,8 @@
 (define (mapping-size mapping)
   (assume (mapping? mapping))
   (mapping-count (lambda (key value)
-	       #t)
+           #t)
-	     mapping))
+         mapping))
 
 (define (mapping-find predicate mapping failure)
   (assume (procedure? predicate))
@@ -285,19 +285,19 @@
   (call/cc
    (lambda (return)
      (mapping-for-each (lambda (key value)
-		     (when (predicate key value)
+             (when (predicate key value)
-		       (return key value)))
+               (return key value)))
-		   mapping)
+           mapping)
      (failure))))
 
 (define (mapping-count predicate mapping)
   (assume (procedure? predicate))
   (assume (mapping? mapping))
   (mapping-fold (lambda (key value count)
-	      (if (predicate key value)
+          (if (predicate key value)
-		  (+ 1 count)
+          (+ 1 count)
-		  count))
+          count))
-	    0 mapping))
+        0 mapping))
 
 (define (mapping-any? predicate mapping)
   (assume (procedure? predicate))
@@ -305,34 +305,34 @@
   (call/cc
    (lambda (return)
      (mapping-for-each (lambda (key value)
-		     (when (predicate key value)
+             (when (predicate key value)
-		       (return #t)))
+               (return #t)))
-		   mapping)
+           mapping)
      #f)))
 
 (define (mapping-every? predicate mapping)
   (assume (procedure? predicate))
   (assume (mapping? mapping))
   (not (mapping-any? (lambda (key value)
-		   (not (predicate key value)))
+           (not (predicate key value)))
-		 mapping)))
+         mapping)))
 
 (define (mapping-keys mapping)
   (assume (mapping? mapping))
   (mapping-fold/reverse (lambda (key value keys)
-			  (cons key keys))
+              (cons key keys))
-			'() mapping))
+            '() mapping))
 
 (define (mapping-values mapping)
   (assume (mapping? mapping))
   (mapping-fold/reverse (lambda (key value values)
-			  (cons value values))
+              (cons value values))
-			'() mapping))
+            '() mapping))
 
 (define (mapping-entries mapping)
   (assume (mapping? mapping))
   (values (mapping-keys mapping)
-	  (mapping-values mapping)))
+      (mapping-values mapping)))
 
 ;; Mapping and folding
 
@@ -341,11 +341,11 @@
   (assume (comparator? comparator))
   (assume (mapping? mapping))
   (mapping-fold (lambda (key value mapping)
-	      (receive (key value)
+          (receive (key value)
-		  (proc key value)
+          (proc key value)
-		(mapping-set mapping key value)))
+        (mapping-set mapping key value)))
-	    (make-empty-mapping comparator)
+        (make-empty-mapping comparator)
-	    mapping))
+        mapping))
 
 (define (mapping-for-each proc mapping)
   (assume (procedure? proc))
@@ -361,19 +361,19 @@
   (assume (procedure? proc))
   (assume (mapping? mapping))
   (mapping-fold/reverse (lambda (key value lst)
-			  (cons (proc key value) lst))
+              (cons (proc key value) lst))
-			'()
+            '()
-			mapping))
+            mapping))
 
 (define (mapping-filter predicate mapping)
   (assume (procedure? predicate))
   (assume (mapping? mapping))
   (mapping-fold (lambda (key value mapping)
-	      (if (predicate key value)
+          (if (predicate key value)
-		  (mapping-set mapping key value)
+          (mapping-set mapping key value)
-		  mapping))
+          mapping))
-	    (make-empty-mapping (mapping-key-comparator mapping))
+        (make-empty-mapping (mapping-key-comparator mapping))
-	    mapping))
+        mapping))
 
 (define mapping-filter! mapping-filter)
 
@@ -381,8 +381,8 @@
   (assume (procedure? predicate))
   (assume (mapping? mapping))
   (mapping-filter (lambda (key value)
-		(not (predicate key value)))
+        (not (predicate key value)))
-	      mapping))
+          mapping))
 
 (define mapping-remove! mapping-remove)
 
@@ -390,7 +390,7 @@
   (assume (procedure? predicate))
   (assume (mapping? mapping))
   (values (mapping-filter predicate mapping)
-	  (mapping-remove predicate mapping)))
+      (mapping-remove predicate mapping)))
 
 (define mapping-partition! mapping-partition)
 
@@ -404,30 +404,30 @@
   (assume (mapping? mapping))
   (reverse
    (mapping-fold (lambda (key value alist)
-		   (cons (cons key value) alist))
+           (cons (cons key value) alist))
-		 '() mapping)))
+         '() mapping)))
 
 (define (alist->mapping comparator alist)
   (assume (comparator? comparator))
   (assume (list? alist))
   (mapping-unfold null?
-	      (lambda (alist)
+          (lambda (alist)
-		(let ((key (caar alist))
+        (let ((key (caar alist))
-		      (value (cdar alist)))
+              (value (cdar alist)))
-		  (values key value)))
+          (values key value)))
-	      cdr
+          cdr
-	      alist
+          alist
-	      comparator))
+          comparator))
 
 (define (alist->mapping! mapping alist)
   (assume (mapping? mapping))
   (assume (list? alist))
   (fold (lambda (association mapping)
-	  (let ((key (car association))
+      (let ((key (car association))
-		(value (cdr association)))
+        (value (cdr association)))
-	    (mapping-set mapping key value)))
+        (mapping-set mapping key value)))
-	mapping
+    mapping
-	alist))
+    alist))
 
 (define alist->mapping/ordered alist->mapping)
 (define alist->mapping/ordered! alist->mapping!)
@@ -470,28 +470,28 @@
   (assume (mapping? mapping1))
   (assume (mapping? mapping2))
   (let ((less? (comparator-ordering-predicate (mapping-key-comparator mapping1)))
-	(equality-predicate (comparator-equality-predicate comparator))
+    (equality-predicate (comparator-equality-predicate comparator))
-	(gen1 (tree-generator (mapping-tree mapping1)))
+    (gen1 (tree-generator (mapping-tree mapping1)))
-	(gen2 (tree-generator (mapping-tree mapping2))))    
+    (gen2 (tree-generator (mapping-tree mapping2))))    
     (let loop ((item1 (gen1))
-	       (item2 (gen2)))
+           (item2 (gen2)))
       (cond
        ((eof-object? item1)
-	#t)
+    #t)
        ((eof-object? item2)
-	#f)
+    #f)
        (else
-	(let ((key1 (car item1)) (value1 (cadr item1))
+    (let ((key1 (car item1)) (value1 (cadr item1))
-	      (key2 (car item2)) (value2 (cadr item2)))
+          (key2 (car item2)) (value2 (cadr item2)))
-	  (cond
+      (cond
-	   ((less? key1 key2)
+       ((less? key1 key2)
-	    #f)
+        #f)
-	   ((less? key2 key1)
+       ((less? key2 key1)
-	    (loop item1 (gen2)))
+        (loop item1 (gen2)))
-	   ((equality-predicate value1 value2)
+       ((equality-predicate value1 value2)
-	    (loop (gen1) (gen2)))
+        (loop (gen1) (gen2)))
-	   (else
+       (else
-	    #f))))))))
+        #f))))))))
 
 (define mapping>?
   (case-lambda
@@ -566,44 +566,44 @@
 
 (define (%mapping-union mapping1 mapping2)
   (mapping-fold (lambda (key2 value2 mapping)
-		  (receive (mapping obj)
+          (receive (mapping obj)
-		      (mapping-search mapping
+              (mapping-search mapping
-				      key2
+                      key2
-				      (lambda (insert ignore)
+                      (lambda (insert ignore)
-					(insert value2 #f))
+                    (insert value2 #f))
-				      (lambda (key1 value1 update remove)
+                      (lambda (key1 value1 update remove)
-					(update key1 value1 #f)))
+                    (update key1 value1 #f)))
-		    mapping))
+            mapping))
-		mapping1 mapping2))
+        mapping1 mapping2))
 
 (define (%mapping-intersection mapping1 mapping2)
   (mapping-filter (lambda (key1 value1)
-		(mapping-contains? mapping2 key1))
+        (mapping-contains? mapping2 key1))
-	      mapping1))
+          mapping1))
 
 (define (%mapping-difference mapping1 mapping2)
   (mapping-fold (lambda (key2 value2 mapping)
-	      (receive (mapping obj)
+          (receive (mapping obj)
-		  (mapping-search mapping
+          (mapping-search mapping
-			      key2
+                  key2
-			      (lambda (insert ignore)
+                  (lambda (insert ignore)
-				(ignore #f))
+                (ignore #f))
-			      (lambda (key1 value1 update remove)
+                  (lambda (key1 value1 update remove)
-				(remove #f)))
+                (remove #f)))
-		mapping))
+        mapping))
-	    mapping1 mapping2))
+        mapping1 mapping2))
 
 (define (%mapping-xor mapping1 mapping2)
   (mapping-fold (lambda (key2 value2 mapping)
-	      (receive (mapping obj)
+          (receive (mapping obj)
-		  (mapping-search mapping
+          (mapping-search mapping
-			      key2
+                  key2
-			      (lambda (insert ignore)
+                  (lambda (insert ignore)
-				(insert value2 #f))
+                (insert value2 #f))
-			      (lambda (key1 value1 update remove)
+                  (lambda (key1 value1 update remove)
-				(remove #f)))
+                (remove #f)))
-		mapping))
+        mapping))
-	    mapping1 mapping2))
+        mapping1 mapping2))
 
 (define mapping-union
   (case-lambda
@@ -672,8 +672,8 @@
   (call/cc
    (lambda (return)
      (mapping-fold (lambda (key value acc)
-		     (return key))
+             (return key))
-		   #f mapping)
+           #f mapping)
      (error "mapping-min-key: empty map"))))
 
 (define (mapping-max-key mapping)
@@ -681,8 +681,8 @@
   (call/cc
    (lambda (return)
      (mapping-fold/reverse (lambda (key value acc)
-			     (return key))
+                 (return key))
-			   #f mapping)
+               #f mapping)
      (error "mapping-max-key: empty map"))))
 
 (define (mapping-min-value mapping)
@@ -690,8 +690,8 @@
   (call/cc
    (lambda (return)
      (mapping-fold (lambda (key value acc)
-		     (return value))
+             (return value))
-		   #f mapping)
+           #f mapping)
      (error "mapping-min-value: empty map"))))
 
 (define (mapping-max-value mapping)
@@ -699,8 +699,8 @@
   (call/cc
    (lambda (return)
      (mapping-fold/reverse (lambda (key value acc)
-			     (return value))
+                 (return value))
-			   #f mapping)
+               #f mapping)
      (error "mapping-max-value: empty map"))))
 
 (define (mapping-key-predecessor mapping obj failure)
@@ -717,28 +717,28 @@
   (assume (mapping? mapping))
   (let ((comparator (mapping-key-comparator mapping)))
     (receive (tree< tree<= tree= tree>= tree>)
-	(tree-split comparator (mapping-tree mapping) obj)
+    (tree-split comparator (mapping-tree mapping) obj)
       (%make-mapping comparator tree=))))
 
 (define (mapping-range< mapping obj)
   (assume (mapping? mapping))
   (let ((comparator (mapping-key-comparator mapping)))
     (receive (tree< tree<= tree= tree>= tree>)
-	(tree-split comparator (mapping-tree mapping) obj)
+    (tree-split comparator (mapping-tree mapping) obj)
       (%make-mapping comparator tree<))))
 
 (define (mapping-range<= mapping obj)
   (assume (mapping? mapping))
   (let ((comparator (mapping-key-comparator mapping)))
     (receive (tree< tree<= tree= tree>= tree>)
-	(tree-split comparator (mapping-tree mapping) obj)
+    (tree-split comparator (mapping-tree mapping) obj)
       (%make-mapping comparator tree<=))))
 
 (define (mapping-range> mapping obj)
   (assume (mapping? mapping))
   (let ((comparator (mapping-key-comparator mapping)))
     (receive (tree< tree<= tree= tree>= tree>)
-	(tree-split comparator (mapping-tree mapping) obj)
+    (tree-split comparator (mapping-tree mapping) obj)
       (%make-mapping comparator tree>))))
 
 (define (mapping-range>= mapping obj)
@@ -746,7 +746,7 @@
   (assume (mapping? mapping))
   (let ((comparator (mapping-key-comparator mapping)))
     (receive (tree< tree<= tree= tree>= tree>)
-	(tree-split comparator (mapping-tree mapping) obj)
+    (tree-split comparator (mapping-tree mapping) obj)
       (%make-mapping comparator tree>=))))
 
 (define mapping-range=! mapping-range=)
@@ -759,21 +759,21 @@
   (assume (mapping? mapping))
   (let ((comparator (mapping-key-comparator mapping)))
     (receive (tree< tree<= tree= tree>= tree>)
-	(tree-split comparator (mapping-tree mapping) obj)
+    (tree-split comparator (mapping-tree mapping) obj)
       (values (%make-mapping comparator tree<)
-	      (%make-mapping comparator tree<=)
+          (%make-mapping comparator tree<=)
-	      (%make-mapping comparator tree=)
+          (%make-mapping comparator tree=)
-	      (%make-mapping comparator tree>=)
+          (%make-mapping comparator tree>=)
-	      (%make-mapping comparator tree>)))))
+          (%make-mapping comparator tree>)))))
 
 (define (mapping-catenate comparator mapping1 pivot-key pivot-value mapping2)
   (assume (comparator? comparator))
   (assume (mapping? mapping1))
   (assume (mapping? mapping2))
   (%make-mapping comparator (tree-catenate (mapping-tree mapping1)
-					   pivot-key
+                       pivot-key
-					   pivot-value
+                       pivot-value
-					   (mapping-tree mapping2))))
+                       (mapping-tree mapping2))))
 
 (define mapping-catenate! mapping-catenate)
 
@@ -800,30 +800,30 @@
 (define (mapping-ordering comparator)
   (assume (comparator? comparator))
   (let ((value-equality (comparator-equality-predicate comparator))
-	(value-ordering (comparator-ordering-predicate comparator)))
+    (value-ordering (comparator-ordering-predicate comparator)))
     (lambda (mapping1 mapping2)
       (let* ((key-comparator (mapping-key-comparator mapping1))
-	     (equality (comparator-equality-predicate key-comparator))
+         (equality (comparator-equality-predicate key-comparator))
-	     (ordering (comparator-ordering-predicate key-comparator))
+         (ordering (comparator-ordering-predicate key-comparator))
-	     (gen1 (tree-generator (mapping-tree mapping1)))
+         (gen1 (tree-generator (mapping-tree mapping1)))
-	     (gen2 (tree-generator (mapping-tree mapping2))))
+         (gen2 (tree-generator (mapping-tree mapping2))))
-	(let loop ()
+    (let loop ()
-	  (let ((item1 (gen1)) (item2 (gen2)))
+      (let ((item1 (gen1)) (item2 (gen2)))
-	    (cond
+        (cond
-	     ((eof-object? item1)
+         ((eof-object? item1)
-	      (not (eof-object? item2)))
+          (not (eof-object? item2)))
-	     ((eof-object? item2)
+         ((eof-object? item2)
-	      #f)
+          #f)
-	     (else
+         (else
-	      (let ((key1 (car item1)) (value1 (cadr item1))
+          (let ((key1 (car item1)) (value1 (cadr item1))
-		    (key2 (car item2)) (value2 (cadr item2)))
+            (key2 (car item2)) (value2 (cadr item2)))
-		(cond
+        (cond
-		 ((equality key1 key2)
+         ((equality key1 key2)
-		  (if (value-equality value1 value2)
+          (if (value-equality value1 value2)
-		      (loop)
+              (loop)
-		      (value-ordering value1 value2)))
+              (value-ordering value1 value2)))
-		 (else
+         (else
-		  (ordering key1 key2))))))))))))
+          (ordering key1 key2))))))))))))
 
 (define (make-mapping-comparator comparator)
   (make-comparator mapping? (mapping-equality comparator) (mapping-ordering comparator) #f))

lib/srfi/146/rbtree.scm

@@ -57,16 +57,16 @@
     ((compile-patterns (expression* ...) tree (clauses ...) ())
      (call-with-current-continuation
       (lambda (return)
-	(or (and-let* clauses
+    (or (and-let* clauses
-	      (call-with-values
+          (call-with-values
-		  (lambda () . expression*)
+          (lambda () . expression*)
-		return))
+        return))
-	    ...
+        ...
-	    (error "tree does not match any pattern" tree)))))
+        (error "tree does not match any pattern" tree)))))
     
     ((compile-patterns e tree clauses* (pattern . pattern*))
      (compile-pattern tree pattern
-		      (add-pattern e tree clauses* pattern*)))))
+              (add-pattern e tree clauses* pattern*)))))
 
 (define-syntax add-pattern
   (syntax-rules ()
@@ -93,23 +93,23 @@
 
     ((compile-pattern tree (and pt ...) k*)
      (compile-subpatterns () ((t pt) ...)
-			  (compile-and-pattern tree t k*)))
+              (compile-and-pattern tree t k*)))
 
     ((compile-pattern tree (node pc pa px pb) k*)
      (compile-subpatterns () ((c pc) (a pa) (x px) (b pb))
-			  (compile-node-pattern tree c a x b k*)))
+              (compile-node-pattern tree c a x b k*)))
 
     ((compile-pattern tree (red pa px pb) k*)
      (compile-subpatterns () ((a pa) (x px) (b pb))
-			  (compile-color-pattern red? tree a x b k*)))
+              (compile-color-pattern red? tree a x b k*)))
 
     ((compile-pattern tree (black pa px pb) k*)
      (compile-subpatterns () ((a pa) (x px) (b pb))
-			  (compile-color-pattern black? tree a x b k*)))
+              (compile-color-pattern black? tree a x b k*)))
 
     ((compile-pattern tree (white pa px pb) k*)
      (compile-subpatterns () ((a pa) (x px) (b pb))
-			  (compile-color-pattern white? tree a x b k*)))
+              (compile-color-pattern white? tree a x b k*)))
 
     ((compile-pattern tree _ (k ...))
      (k ... ()))
@@ -126,19 +126,19 @@
   (syntax-rules ()
     ((compile-node-pattern tree c a x b (k ...) clauses)
      (k ... (((item tree))
-	     (c (color tree))
+         (c (color tree))
-	     (a (left tree))
+         (a (left tree))
-	     (x (item tree))
+         (x (item tree))
-	     (b (right tree)) . clauses)))))
+         (b (right tree)) . clauses)))))
 
 (define-syntax compile-color-pattern
   (syntax-rules ()
     ((compile-color-pattern pred? tree a x b (k ...) clauses)
      (k ... (((item tree))
-	     ((pred? tree))
+         ((pred? tree))
-	     (a (left tree))
+         (a (left tree))
-	     (x (item tree))
+         (x (item tree))
-	     (b (right tree)) . clauses)))))
+         (b (right tree)) . clauses)))))
 
 (define-syntax compile-subpatterns
   (syntax-rules ()
@@ -186,10 +186,10 @@
        acc)
       ((node _ a x b)
        (let*
-	   ((acc (loop acc a))
+       ((acc (loop acc a))
-	    (acc (proc (item-key x) (item-value x) acc))
+        (acc (proc (item-key x) (item-value x) acc))
-	    (acc (loop acc b)))
+        (acc (loop acc b)))
-	 acc)))))
+     acc)))))
 
 (define (tree-fold/reverse proc seed tree)
   (let loop ((acc seed) (tree tree))
@@ -198,15 +198,15 @@
        acc)
       ((node _ a x b)
        (let*
-	   ((acc (loop acc b))
+       ((acc (loop acc b))
-	    (acc (proc (item-key x) (item-value x) acc))
+        (acc (proc (item-key x) (item-value x) acc))
-	    (acc (loop acc a)))
+        (acc (loop acc a)))
-	 acc)))))
+     acc)))))
 
 (define (tree-for-each proc tree)
   (tree-fold (lambda (key value acc)
-	       (proc key value))
+           (proc key value))
-	     #f tree))
+         #f tree))
 
 (define (tree-generator tree)
   (make-coroutine-generator
@@ -218,51 +218,51 @@
 (define (tree-search comparator tree obj failure success)
   (receive (tree ret op)
       (let search ((tree (redden tree)))
-	(tree-match tree	  
+    (tree-match tree      
-	  ((black)
+      ((black)
-	   (failure
+       (failure
-	    ;; insert
+        ;; insert
-	    (lambda (new-key new-value ret)
+        (lambda (new-key new-value ret)
-	      (values (red (black-leaf) (make-item new-key new-value) (black-leaf))
+          (values (red (black-leaf) (make-item new-key new-value) (black-leaf))
-		      ret
+              ret
-		      balance))
+              balance))
-	    ;; ignore
+        ;; ignore
-	    (lambda (ret)
+        (lambda (ret)
-	      (values (black-leaf) ret identity))))
+          (values (black-leaf) ret identity))))
       
-	  ((and t (node c a x b))
+      ((and t (node c a x b))
-	   (let ((key (item-key x)))
+       (let ((key (item-key x)))
-	     (comparator-if<=> comparator obj key
+         (comparator-if<=> comparator obj key
            
-	       (receive (a ret op) (search a)
+           (receive (a ret op) (search a)
-		 (values (op (node c a x b)) ret op))
+         (values (op (node c a x b)) ret op))
            
-	       (success
+           (success
-		key
+        key
-		(item-value x)
+        (item-value x)
-		;; update
+        ;; update
-		(lambda (new-key new-value ret)
+        (lambda (new-key new-value ret)
-		  (values (node c a (make-item new-key new-value) b)
+          (values (node c a (make-item new-key new-value) b)
-			  ret
+              ret
-			  identity))
+              identity))
-		;; remove
+        ;; remove
-		(lambda (ret)
+        (lambda (ret)
-		  (values
+          (values
-		   (tree-match t
+           (tree-match t
-		     ((red (black) x (black))
+             ((red (black) x (black))
-		      (black-leaf))
+              (black-leaf))
-		     ((black (red a x b) _ (black))
+             ((black (red a x b) _ (black))
-		      (black a x b))
+              (black a x b))
-		     ((black (black) _ (black))
+             ((black (black) _ (black))
-		      (white-leaf))
+              (white-leaf))
-		     (_
+             (_
-		      (receive (x b) (min+delete b)
+              (receive (x b) (min+delete b)
-			(rotate (node c a x b)))))
+            (rotate (node c a x b)))))
-		   ret
+           ret
-		   rotate)))
+           rotate)))
            
-	       (receive (b ret op) (search b)
+           (receive (b ret op) (search b)
-		 (values (op (node c a x b)) ret op)))))))
+         (values (op (node c a x b)) ret op)))))))
       
     (values (blacken tree) ret)))
 
@@ -273,10 +273,10 @@
        (return))
       ((node _ a x b)
        (let ((key (item-key x)))
-	 (comparator-if<=> comparator key obj
+     (comparator-if<=> comparator key obj
-			   (loop return b)
+               (loop return b)
-			   (loop return b)
+               (loop return b)
-			   (loop (lambda () key) a)))))))
+               (loop (lambda () key) a)))))))
 
 (define (tree-key-predecessor comparator tree obj failure)
   (let loop ((return failure) (tree tree))
@@ -285,10 +285,10 @@
        (return))
       ((node _ a x b)
        (let ((key (item-key x)))
-	 (comparator-if<=> comparator key obj
+     (comparator-if<=> comparator key obj
-			   (loop (lambda () key) b)
+               (loop (lambda () key) b)
-			   (loop return a)
+               (loop return a)
-			   (loop return a)))))))
+               (loop return a)))))))
 
 (define (tree-map proc tree)
   (let loop ((tree tree))
@@ -297,64 +297,64 @@
        (black-leaf))
       ((node c a x b)
        (receive (key value)
-	   (proc (item-key x) (item-value x))
+       (proc (item-key x) (item-value x))
-	 (node c (loop a) (make-item key value) (loop b)))))))
+     (node c (loop a) (make-item key value) (loop b)))))))
 
 
 (define (tree-catenate tree1 pivot-key pivot-value tree2)
   (let ((pivot (make-item pivot-key pivot-value))
-	(height1 (black-height tree1))
+    (height1 (black-height tree1))
-	(height2 (black-height tree2)))
+    (height2 (black-height tree2)))
     (cond
      ((= height1 height2)
       (black tree1 pivot tree2))
      ((< height1 height2)
       (blacken
        (let loop ((tree tree2) (depth (- height2 height1)))
-	 (if (zero? depth)
+     (if (zero? depth)
-	     (balance (red tree1 pivot tree))
+         (balance (red tree1 pivot tree))
-	     (balance
+         (balance
-	      (node (color tree) (loop (left tree) (- depth 1)) (item tree) (right tree)))))))
+          (node (color tree) (loop (left tree) (- depth 1)) (item tree) (right tree)))))))
      (else
       (blacken
        (let loop ((tree tree1) (depth (- height1 height2)))
-	 (if (zero? depth)
+     (if (zero? depth)
-	     (balance (red tree pivot tree2))
+         (balance (red tree pivot tree2))
-	     (balance
+         (balance
-	      (node (color tree) (left tree) (item tree) (loop (right tree) (- depth 1)))))))))))
+          (node (color tree) (left tree) (item tree) (loop (right tree) (- depth 1)))))))))))
 
 (define (tree-split comparator tree obj)
   (let loop ((tree1 (black-leaf))
-	     (tree2 (black-leaf))
+         (tree2 (black-leaf))
-	     (pivot1 #f)
+         (pivot1 #f)
-	     (pivot2 #f)
+         (pivot2 #f)
-	     (tree tree))
+         (tree tree))
     (tree-match tree
       ((black)
        (let ((tree1 (catenate-left tree1 pivot1 (black-leaf)))
-	     (tree2 (catenate-right (black-leaf) pivot2 tree2)))
+         (tree2 (catenate-right (black-leaf) pivot2 tree2)))
-	 (values tree1 tree1 (black-leaf) tree2 tree2)))
+     (values tree1 tree1 (black-leaf) tree2 tree2)))
       ((node _ a x b)
        (comparator-if<=> comparator obj (item-key x)
-			 (loop tree1
+             (loop tree1
-			       (catenate-right (blacken b) pivot2 tree2)
+                   (catenate-right (blacken b) pivot2 tree2)
-			       pivot1
+                   pivot1
-			       x
+                   x
-			       (blacken a))
+                   (blacken a))
-			 (let* ((tree1 (catenate-left tree1 pivot1 (blacken a)))
+             (let* ((tree1 (catenate-left tree1 pivot1 (blacken a)))
-				(tree1+ (catenate-left tree1 x (black-leaf)))
+                (tree1+ (catenate-left tree1 x (black-leaf)))
-				(tree2 (catenate-right (blacken b) pivot2 tree2))
+                (tree2 (catenate-right (blacken b) pivot2 tree2))
-				(tree2+ (catenate-right (black-leaf) x tree2)))
+                (tree2+ (catenate-right (black-leaf) x tree2)))
-			   (values tree1
+               (values tree1
-				   tree1+
+                   tree1+
-				   (black (black-leaf) x (black-leaf))
+                   (black (black-leaf) x (black-leaf))
-				   tree2+
+                   tree2+
-				   tree2))
+                   tree2))
-			 (loop (catenate-left tree1 pivot1 (blacken a))
+             (loop (catenate-left tree1 pivot1 (blacken a))
-			       tree2
+                   tree2
-			       x
+                   x
-			       pivot2
+                   pivot2
-			       (blacken b)))))))
+                   (blacken b)))))))
 
 (define (catenate-left tree1 item tree2)
   (if item
@@ -379,14 +379,14 @@
 (define (left-tree tree depth)
   (let loop ((parent #f) (tree tree) (depth depth))
     (if (zero? depth)
-	(values parent tree)
+    (values parent tree)
-	(loop tree (left tree) (- depth 1)))))
+    (loop tree (left tree) (- depth 1)))))
 
 (define (right-tree tree depth)
   (let loop ((parent #f) (tree tree) (depth depth))
     (if (zero? depth)
-	(values parent tree)
+    (values parent tree)
-	(loop tree (right tree) (- depth 1)))))
+    (loop tree (right tree) (- depth 1)))))
 
 ;;; Helper procedures for deleting and balancing
 

lib/srfi/146/vector-edit-test.scm

@@ -28,7 +28,7 @@
   (test-group "(vector-without)"
     (define (check expected start end)
       (let ((v #(0 1 2 3 4)))
-	(test expected (vector-without v start end))))
+    (test expected (vector-without v start end))))
     (check #(0 1 2 3 4) 0 0)
     (check #() 0 5)
     (check #(1 2 3 4) 0 1)
@@ -46,24 +46,24 @@
   (test-group "(vector-edit adjacent-adds)"
     (let ((array (vector 0 1 2)))
       (test #(0 1 2 3 4)
-	    (vector-edit array
+        (vector-edit array
-			 (add 3 3)
+             (add 3 3)
-			 (add 3 4)))))
+             (add 3 4)))))
 
   (test-group "(vector-edit adjacent-drops)"
     (let ((array (vector 0 1 2 3 4 5)))
       (test #(0 1 2)
-	    (vector-edit array
+        (vector-edit array
-			 (drop 3 1)
+             (drop 3 1)
-			 (drop 4 2)))))
+             (drop 4 2)))))
 
   (test-group "(vector-edit alternating-add-drop)"
     (let ((array (vector 0 1 2 2 2 3 4 6 6 6 6 7 9)))
       (test #(0 1 2 3 4 5 6 7 8 9)
-	    (vector-edit array
+        (vector-edit array
-			 (drop 3 2)
+             (drop 3 2)
-			 (add 7 5)
+             (add 7 5)
-			 (drop 8 3)
+             (drop 8 3)
-			 (add 12 8)))))
+             (add 12 8)))))
 
   (test-end))

lib/srfi/146/vector-edit.scm

@@ -31,9 +31,9 @@
 (define (vector-without v start end)
   "Return a copy of vector `v' without the elements with indices [start, end)."
   (let* ((size (vector-length v))
-	 (gap-size (- end start))
+     (gap-size (- end start))
-	 (new-size (- size gap-size))
+     (new-size (- size gap-size))
-	 (result (make-vector new-size)))
+     (result (make-vector new-size)))
     (vector-copy! result 0 v 0 start)
     (vector-copy! result start v end size)
     result))
@@ -63,14 +63,14 @@
        (vector-copy! r (+ o s) v o index)
        (vector-set! r (+ s index) e)
        (let ((skew (+ s 1)))
-	 (vector-edit-code v r index skew . rest))))
+     (vector-edit-code v r index skew . rest))))
     ((_ v r o s (drop i c) . rest)
      (let ((index i))
        (vector-copy! r (+ o s) v o index)
        (let* ((dropped c)
-	      (offset (+ index dropped))
+          (offset (+ index dropped))
-	      (skew (- s dropped)))
+          (skew (- s dropped)))
-	 (vector-edit-code v r offset skew . rest))))))
+     (vector-edit-code v r offset skew . rest))))))
 
 ;; <> Optimize this by allowing one to supply more than one value in
 ;; `add' sub-expressions so that adjacent values can be inserted
@@ -89,5 +89,5 @@
   (syntax-rules ()
     ((_ v . rest)
      (let ((result (make-vector (+ (vector-length v)
-				   (vector-edit-total-skew 0 . rest)))))
+                   (vector-edit-total-skew 0 . rest)))))
        (vector-edit-code v result 0 0 . rest)))))