Add hacky cache for symbol hash

Makes a bit of an impact - about 20% faster

1 files changed, 31 insertions, 11 deletions

diff --git a/benchmarks/benchmark.scm b/benchmarks/benchmark.scm
index 21d3c43..013db20 100644
--- a/benchmarks/benchmark.scm
+++ b/benchmarks/benchmark.scm
@@ -28,6 +28,12 @@
 (define lst (list-tabulate size (lambda (i) (string->symbol (conc "x" i)))))
 (define lst (list-tabulate size (lambda (i) (string->symbol (conc "y" i)))))
 
+;; Super-hacky way to determine impact of caching the hash value in a symbol.
+;; We abuse the symbol's toplevel value slot to store the hash.  A slightly
+;; cleaner but slower implementation could use the plist to store it.
+;; Oddly enough, the impact seems very minor.
+(define symbol-cache? #f)
+
 (define-inline (filter pred lst)
   (let lp ((lst lst)
            (res '()))
@@ -45,25 +51,35 @@
 	;; NOTE: All low-level hash tables share the same randomization factor
 	(rand (##core#inline "C_rand" #x10000)))
     (lambda (s n)
-      (if (eq? s cache-s)
-	  (##core#inline "C_fixnum_modulo" cache-h n)
-	  (let ((bv (##sys#slot s 1)))
-	    (set! cache-s s)
-	    (set! cache-h (##core#inline "C_u_i_bytevector_hash" bv 0 (fx- (##sys#size bv) 1) rand))
-	    (##core#inline "C_fixnum_modulo" cache-h n))))))
+      (cond ((not (##core#inline "C_unboundvaluep" (##sys#slot s 0))) ; Repeated here for cached-srfi-69
+             (##core#inline "C_fixnum_modulo" (##sys#slot s 0) n))
+            ((eq? s cache-s)
+             (##core#inline "C_fixnum_modulo" cache-h n))
+            (else
+             (let ((bv (##sys#slot s 1)))
+	       (set! cache-s s)
+	       (set! cache-h (##core#inline "C_u_i_bytevector_hash" bv 0 (fx- (##sys#size bv) 1) rand))
+               (when symbol-cache?
+                 (##sys#setslot s 0 cache-h))
+	       (##core#inline "C_fixnum_modulo" cache-h n)))))))
+
+(define-inline (fast-hash-symbol s n)
+  (if (not (##core#inline "C_unboundvaluep" (##sys#slot s 0)))
+      (##core#inline "C_fixnum_modulo" (##sys#slot s 0) n)
+      (hash-symbol s n)))
 
 (define (make-my-hash-table #!optional (size 301))
   (make-vector size '()))
 
 (define (my-hash-table-ref ht key)
-  (let loop ((bucket (##sys#slot ht (hash-symbol key (##sys#size ht)))))
+  (let loop ((bucket (##sys#slot ht (fast-hash-symbol key (##sys#size ht)))))
     (and (not (eq? '() bucket))
 	 (if (eq? key (##sys#slot (##sys#slot bucket 0) 0))
 	     (##sys#slot (##sys#slot bucket 0) 1)
 	     (loop (##sys#slot bucket 1))))))
 
 (define (my-hash-table-set! ht key val)
-  (let* ((k (hash-symbol key (##sys#size ht)))
+  (let* ((k (fast-hash-symbol key (##sys#size ht)))
 	 (ib (##sys#slot ht k)))
       (let loop ((bucket ib))
 	(if (eq? '() bucket)
@@ -96,11 +112,15 @@
      (lset-difference eq? lst (cons 'aha lst)))
     ((slset)
      (slset-difference lst (cons 'aha lst)))
-    ((symbolset)
+    ((symbolset cached-symbolset)
+     (when (eq? impl 'cached-symbolset)
+       (set! symbol-cache? #t))
      (symbolset-difference lst (cons 'aha lst)))
-    ((srfi-69)
+    ((srfi-69 cached-srfi-69)
      (when (pair? lst)
-       (let ((ht (make-hash-table eq? symbol-hash size)))
+       (when (eq? impl 'cached-srfi-69)
+         (set! symbol-cache? #t))
+       (let ((ht (make-hash-table eq? (if (eq? impl 'cached-srfi-69) hash-symbol symbol-hash) size)))
          (begin 
            (for-each (lambda (x) (hash-table-set! ht x #t)) lst)
            (set! lst ht))))