diff options
Diffstat (limited to 'csc/hash-map.csc')
| -rw-r--r-- | csc/hash-map.csc | 57 |
1 files changed, 48 insertions, 9 deletions
diff --git a/csc/hash-map.csc b/csc/hash-map.csc index 5a604ad..064b4ae 100644 --- a/csc/hash-map.csc +++ b/csc/hash-map.csc @@ -1,17 +1,24 @@ (define-library (csc hash-map) (export alist->map + compare-numbers + compare-strings + compare-symbols + delete hash-bytevector insert key-not-found-error? lookup + make-comparer make-map - delete map->alist map-for-each map? merge) (import (scheme base) + (only (csc loop) + loop + return) (only (csc match) define-match-record-type match) @@ -198,8 +205,15 @@ (root map-root)) - (define (make-map hash cmp) - (construct-map hash cmp '())) + (define-record-type <comparer> + (make-comparer hash cmp) + comparer? + (hash comparer-hash) + (cmp comparer-cmp)) + + + (define (make-map comparer) + (construct-map (comparer-hash comparer) (comparer-cmp comparer) '())) (define (shuffle n) @@ -269,12 +283,11 @@ alist)) - (define (alist->map hash cmp alist) - (let loop ((alist alist) - (m (make-map hash cmp))) - (if (null? alist) - m - (loop (cdr alist) (insert m (caar alist) (cdar alist)))))) + (define (alist->map comparer alist) + (loop with m = (make-map comparer) + for elem in alist + do (set! m (insert m (car elem) (cdr elem))) + finally (return m))) (define (hash-bytevector b) @@ -285,6 +298,32 @@ (loop (+ 1 i) (+ (* hash #x100) (bytevector-u8-ref b i)))))) + (define compare-symbols + (make-comparer + (lambda (s) (hash-bytevector (string->utf8 (symbol->string s)))) + (lambda (s1 s2) + (cond + ((symbol=? s1 s2) 0) + ((string<? (symbol->string s1) (symbol->string s2)) -1) + (else 1))))) + + + (define compare-numbers + (make-comparer + (lambda (x) x) + (lambda (y x) (- y x)))) + + + (define compare-strings + (make-comparer + (lambda (s) (hash-bytevector (string->utf8 s))) + (lambda (s1 s2) + (cond + ((string=? s1 s2) 0) + ((string<? (symbol->string s1) (symbol->string s2)) -1) + (else 1))))) + + (define (merge2 m1 m2) (let ((m1 m1)) (map-for-each |