From 30777031aff94fbbe17dc045a447a95a681b41e5 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Mon, 18 Feb 2013 12:51:31 +0800
Subject: [PATCH] remove hash-length

* fib (hash-length, hash-empty?): Removed.

  (remove-unrelated-blocks): Minimal rework based on the assumption
  that since blocks are being removed, `hash-tree-size' will always be
  less than `hash-table-size'.  Also restructure the final removal
  from `hash-table'.

  (pretty-show): Use hash-fold and return the number of blocks.
  (display-blocks): Always call `pretty-show', using its return value
  to determine if any blocks are found.
---
 fib |   65 +++++++++++++++++++++++------------------------------------------
 1 file changed, 23 insertions(+), 42 deletions(-)

diff --git a/fib b/fib
index dedbf98..a1f2fd4 100755
--- a/fib
+++ b/fib
@@ -520,22 +520,6 @@
     hash-table
     (build-hash-table list-of-lines 1)))
 
-(define (hash-empty? hash-table)
-  (= (hash-length hash-table) 0))
-
-;; read syntax of a hash table is:
-;; #<hash-table 0/31>
-(define (hash-length hash-table)
-  (string->number
-    (car
-      (reverse
-        (string-split
-          (car
-            (string-split
-              (object->string hash-table)
-              #\/))
-          #\sp)))))
-
 (define (remove-sub-blocks hash-table)
   (define (remove-includes k1 v1)
     (for-each
@@ -569,7 +553,6 @@
 ;; remove blocks which unrelated with blocks in list-of-blocks from
 ;; hash-table
 (define (remove-unrelated-blocks list-of-blocks hash-table)
-  (define hash-table-size (hash-length hash-table))
   (define (build-interval-tree-table hash-table)
     (let ((interval-tree-table (make-hash-table)))
       (hash-for-each
@@ -599,36 +582,33 @@
         (let* ((b (car list-of-blocks))
                (hash-of-path (string-hash (block-path b)))
                (interval-tree (hash-ref interval-tree-table
-                                        hash-of-path))
-               (hash-tree-size (hash-size hash-tree)))
-          (if (< hash-tree-size hash-table-size)
-            (begin
-              (if interval-tree
-                (set! hash-tree
+                                        hash-of-path)))
+          (when interval-tree
+            (set! hash-tree
                   (interval-traverse-search (block-interval b)
                                             interval-tree
                                             hash-insert
                                             hash-tree)))
-              (bht hash-tree (cdr list-of-blocks)))
-            hash-tree)))))
-  (let ((interval-tree-table (build-interval-tree-table hash-table)))
-    (let ((hash-tree (build-hash-tree list-of-blocks interval-tree-table)))
-      (let ((hash-tree-size (hash-size hash-tree)))
-        (if (< hash-tree-size hash-table-size)
-          (for-each
-            (lambda (x)
-              (let ((k (car x)))
-                (if (not (hash-search k hash-tree))
-                  (hash-remove! hash-table k))))
-            (hash-map->list cons hash-table))))))
+          (bht hash-tree (cdr list-of-blocks))))))
+  (let* ((interval-tree-table (build-interval-tree-table hash-table))
+         (hash-tree (build-hash-tree list-of-blocks interval-tree-table)))
+    (for-each
+      (lambda (k)
+        (hash-remove! hash-table k))
+      (hash-fold (lambda (k v ks)
+                   (if (hash-search k hash-tree)
+                       ks
+                       (cons k ks)))
+                 '()
+                 hash-table)))
   hash-table)
 
 (define (pretty-show hash-table)
   (define (footprint x)
     (display x)
     (newline))
-  (hash-for-each
-    (lambda (k v)
+  (hash-fold
+    (lambda (k v n-blocks)
       (display "Block footprint:")
       (newline)
       (if (> (length v) 2)
@@ -642,15 +622,16 @@
       (newline)
       (display (block-content (car v)))
       (newline)
-      (newline))
+      (newline)
+      (1+ n-blocks))
+    0
     hash-table))
 
 (define (display-blocks file hash-table)
   (define (show-blocks hash-table)
-    (if (not (hash-empty? hash-table))
-      (begin
-        (set! exit-status 1)
-        (pretty-show hash-table))))
+    (unless (zero? (pretty-show hash-table))
+      ;; Note: most similar programs use `1' to indicate `no matches'.
+      (set! exit-status 1)))
   (let ((eated-table (eat-blocks hash-table)))
     (if diff-commit
       (let ((list-of-changed-blocks nil))
-- 
1.7.10.4