diff options
Diffstat (limited to 'benchmarks')
| -rw-r--r-- | benchmarks/benchmark.scm | 60 |
1 files changed, 59 insertions, 1 deletions
diff --git a/benchmarks/benchmark.scm b/benchmarks/benchmark.scm index 013db20..541f5db 100644 --- a/benchmarks/benchmark.scm +++ b/benchmarks/benchmark.scm @@ -9,7 +9,7 @@ ;; value which makes hashing fast. Slsets don't care about the symbol ;; size and don't need a preallocated size. -(import (chicken fixnum) (chicken string) (chicken process-context) srfi-1 srfi-69 slsets) +(import (chicken fixnum) (chicken string) (chicken process-context) (only srfi-1 lset-difference) srfi-69 slsets) (unless (= (length (command-line-arguments)) 2) (error "Need impl name (one of lset, slset, symbolset or srfi-69) and set size")) @@ -95,6 +95,55 @@ lss) (filter (lambda (x) (not (my-hash-table-ref seen x))) ls))) +;;;;; + +(define (my-hash-table-delete! ht key) + (let* ((k (fast-hash-symbol key (##sys#size ht))) + (ib (##sys#slot ht k))) + (let loop ((bucket ib) + (prev #f)) + (if (eq? '() bucket) + (void) + (if (eq? key (##sys#slot (##sys#slot bucket 0) 0)) + (if prev + (##sys#setslot prev 1 (##sys#slot bucket 1)) + (##sys#setslot ht k (##sys#slot bucket 1))) + (loop (##sys#slot bucket 1) bucket)))))) + + +(define (my-hash-table-walk ht fun) + (let loop ((i (##sys#size ht))) + (when (fx> i 0) + (for-each (lambda (x) + (fun (##sys#slot x 0) (##sys#slot x 1))) + (##sys#slot ht (fx- i 1))) + (loop (fx- i 1))))) + +(define (alist-copy x) + (let lp ((x x) + (res '())) + (if (null? x) + res + (lp (cdr x) (cons (cons (car (car x)) (cdr (car x))) res))))) + +(define (my-hash-table-copy ht) + (let ((new-ht (make-my-hash-table (##sys#size ht)))) + (let loop ((i (##sys#size ht))) + (when (fx> i 0) + (##sys#setslot new-ht (fx- i 1) (alist-copy (##sys#slot ht (fx- i 1)))) + (loop (fx- i 1)))) + new-ht)) + +(define (my-hash-table-difference ht1 ht2) + #;(let ((result (my-hash-table-copy ht1))) + (my-hash-table-walk ht2 (lambda (k v) + (my-hash-table-delete! result k))) + result) + (let ((result (make-my-hash-table size))) + (my-hash-table-walk ht2 (lambda (k v) + (when (my-hash-table-ref ht1 k) + (my-hash-table-set! result k v)))))) + ;;;;;;;;;;;; ;; For comparison, a bit strange @@ -116,6 +165,15 @@ (when (eq? impl 'cached-symbolset) (set! symbol-cache? #t)) (symbolset-difference lst (cons 'aha lst))) + ((hash-table cached-hash-table) + (when (pair? lst) + (when (eq? impl 'cached-hash-table) + (set! symbol-cache? #t)) + (let ((ht (make-my-hash-table size))) + (begin + (for-each (lambda (x) (my-hash-table-set! ht x #t)) lst) + (set! lst ht)))) + (my-hash-table-difference lst lst)) ((srfi-69 cached-srfi-69) (when (pair? lst) (when (eq? impl 'cached-srfi-69) |