From 77583a881b03ce38c8065c40641489fe88b61eb2 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 9 Jan 2022 22:55:59 -0800
Subject: Write the linker.

---
 hash-map.csc | 74 +++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 41 insertions(+), 33 deletions(-)

(limited to 'hash-map.csc')

diff --git a/hash-map.csc b/hash-map.csc
index 2c95b36..01d4158 100644
--- a/hash-map.csc
+++ b/hash-map.csc
@@ -1,23 +1,24 @@
 (define-library (csc hash-map)
   (export
-    alist->hash-map
+    alist->map
     hash-bytevector
-    hash-map->alist
-    hash-map-foreach
-    hash-map-insert
-    hash-map-lookup
-    hash-map?
-    make-hash-map)
+    map->alist
+    for-each
+    insert
+    lookup
+    map?
+    key-not-found-error?
+    make-map)
   (import (scheme base)
           (only (csc format) sprintf))
   (begin
 
 
     (define-record-type <key-hash>
-      (make-key-hash hash k)
+      (make-key-hash k hash)
       key-hash?
-      (hash key-hash-hash)
-      (k key-hash-value))
+      (k key-hash-value)
+      (hash key-hash-hash))
 
 
     (define (key-hash<? k1 k2 key<?)
@@ -161,42 +162,48 @@
               (else m))))
 
 
-    (define (insert m k v key<?)
+    (define (insert-node m k v key<?)
       (cond ((null? m) (make-node 'red k v '() '()))
             ((key-hash<? k (node-key m) key<?)
              (rebalance-left
                (make-node (node-color m) (node-key m) (node-value m)
-                          (insert (node-left m) k v key<?)
+                          (insert-node (node-left m) k v key<?)
                           (node-right m))))
             ((key-hash=? k (node-key m)) (make-node (node-color m) k v (node-left m) (node-right m)))
             (else
               (rebalance-right
                 (make-node (node-color m) (node-key m) (node-value m)
                            (node-left m)
-                           (insert (node-right m) k v key<?))))))
+                           (insert-node (node-right m) k v key<?))))))
 
 
     (define-record-type <hash-map>
       (construct-hash-map hash key<? root)
       hash-map?
-      (hash hash-map-hash)
+      (hash hash-map-raw-hash)
       (key<? hash-map-key<?)
       (root hash-map-root))
 
 
-    (define (make-hash-map hash key<?)
+    (define (make-map hash key<?)
       (construct-hash-map hash key<? '()))
 
 
-    (define (hash-map-insert m k v)
-      (let* ((shuffle
-               (lambda (hash)
-                 (truncate-remainder
-                   (* #x9e3779b97f4a7c55 hash)
-                   #x10000000000000000)))
-             (res (insert (hash-map-root m) (make-key-hash (shuffle ((hash-map-hash m) k)) k) v (hash-map-key<? m))))
+    (define (shuffle n)
+      (truncate-remainder
+        (* #x9e3779b97f4a7c55 n)
+        #x10000000000000000))
+
+
+    (define (hash-map-hash m)
+      (lambda (k)
+        (shuffle ((hash-map-raw-hash m) k))))
+
+
+    (define (insert m k v)
+      (let ((res (insert-node (hash-map-root m) (make-key-hash k ((hash-map-hash m) k)) v (hash-map-key<? m))))
         (construct-hash-map
-          (hash-map-hash m)
+          (hash-map-raw-hash m)
           (hash-map-key<? m)
           (make-node 'black (node-key res) (node-value res) (node-left res) (node-right res)))))
 
@@ -206,17 +213,18 @@
       key-not-found-error?)
 
 
-    (define (hash-map-lookup m k)
-      (letrec ((lookup
+    (define (lookup m k)
+      (letrec ((k* (make-key-hash k ((hash-map-hash m) k)))
+               (lookup
                  (lambda (n)
                    (cond ((null? n) (raise (make-key-not-found-error)))
-                         ((key-hash<? k (node-key n) (hash-map-key<? m)) (lookup (node-left n)))
-                         ((key-hash=? k (node-key n)) (node-value n))
+                         ((key-hash<? k* (node-key n) (hash-map-key<? m)) (lookup (node-left n)))
+                         ((key-hash=? k* (node-key n)) (node-value n))
                          (else (lookup (node-right n)))))))
               (lookup (hash-map-root m))))
 
 
-    (define (hash-map-foreach f m)
+    (define (for-each f m)
       (letrec ((node-foreach
                  (lambda (n)
                    (unless (null? n)
@@ -226,21 +234,21 @@
               (node-foreach (hash-map-root m))))
 
 
-    (define (hash-map->alist m)
+    (define (map->alist m)
       (let ((alist '()))
-        (hash-map-foreach
+        (for-each
           (lambda (k v)
             (set! alist (cons (cons k v) alist)))
           m)
         alist))
 
 
-    (define (alist->hash-map hash key<? alist)
+    (define (alist->map hash key<? alist)
       (let loop ((alist alist)
-                 (m (make-hash-map hash key<?)))
+                 (m (make-map hash key<?)))
         (if (null? alist)
             m
-          (loop (cdr alist) (hash-map-insert m (caar alist) (cdar alist))))))
+          (loop (cdr alist) (insert m (caar alist) (cdar alist))))))
 
 
     (define (hash-bytevector b)
-- 
cgit v1.3.1