Add ihashtable

We will back entities' components with this.

Makefile

@@ -4,7 +4,8 @@ modules := \
 	$(wildcard modules/ces/component/*.scm) \
 	$(wildcard modules/ces/system/*.scm) \
 	$(wildcard modules/dom/*.scm) \
-	$(wildcard modules/math/*.scm)
+	$(wildcard modules/math/*.scm) \
+	$(wildcard modules/lib/*.scm)
 
 game.wasm: game.scm $(modules)
 	guild compile-wasm -L modules -o $@ $<

modules/lib/README.org

@@ -0,0 +1,3 @@
+Contains libraries that are useful for the game and general CES library.
+
+In particular, the immutable hashtables power the entire system.

modules/lib/ihashtable.scm

@@ -0,0 +1,96 @@
+(define-module (lib ihashtable)
+  #:pure
+  #:use-module (scheme base)
+  #:use-module (scheme case-lambda)
+  #:use-module (hoot hashtables)
+  #:use-module ((hoot syntax) #:select (define*))
+  #:export (ihashtable?
+            ihashtable
+            ihashtable-contains?
+            ihashtable-get
+            ihashtable-assoc
+            ihashtable-dissoc
+            ihashtable-update))
+
+;; Since entities are intended to be immutable until the next
+;; generation, we are backing the components with a hacky immutable
+;; hashtable. Once we have time to implement an actual immutable
+;; datastructure, this will be replaced.
+(define-record-type <ihashtable>
+    (make-ihashtable entries)
+  ihashtable?
+  (entries ihashtable-entries))
+
+(define (%copy-ihashtable table)
+  (if (ihashtable? table)
+      (make-ihashtable (ihashtable-entries table))))
+
+(define (%assoc-list->hashtable lst)
+  (if (list? lst)
+      (let ((table (make-eq-hashtable)))
+        (for-each (lambda (v)
+                    (unless (null? (cdr v))
+                      (hashtable-set! table (car v) (cdr v))))
+                  lst))
+      #f))
+
+(define ihashtable
+  (case-lambda
+    (() (make-ihashtable (make-eq-hashtable)))
+    ((initial-values)
+     (cond
+      ((hashtable? initial-values)
+       (make-ihashtable (hashtable-copy values)))
+      ((ihashtable? initial-values)
+       (%copy-ihashtable initial-values))
+      ((list? initial-values)
+       (make-ihashtable (%assoc-list->hashtable initial-values)))
+      (else (ihashtable))))))
+
+(define (ihashtable-contains? ihashtable key)
+  "Returns true if the hashtable contains key"
+  (and (ihashtable? ihashtable)
+       (hashtable-contains? (ihashtable-entries ihashtable) key)))
+
+(define* (ihashtable-get ihashtable key default-value)
+  "Returns the value for key. Returns default-value if the key does not exist.
+Returns false if there is an error."
+  (if (ihashtable? ihashtable)
+      (hashtable-ref (ihashtable-entries ihashtable) key default-value)
+      #f))
+
+(define (ihashtable-assoc ihashtable key val)
+  "Returns a copy of hashtable with key set to val.
+Returns false if there is an error."
+  (if (ihashtable? ihashtable)
+      (let* ((backing-table (ihashtable-entries ihashtable))
+             (new-table (hashtable-copy backing-table)))
+        (begin
+          (hashtable-set! new-table key val)
+          (ihashtable new-table)))
+      #f))
+
+(define (ihashtable-dissoc ihashtable key)
+  "Returns a copy of hashtable without key.
+Returns false on error."
+  (if (ihashtable? ihashtable)
+      (let* ((backing-table (ihashtable-entries ihashtable))
+             (new-table (hashtable-copy backing-table)))
+        (begin
+          (hashtable-delete! new-table key)
+          (ihashtable new-table)))
+      #f))
+
+(define (ihashtable-update ihashtable key proc)
+  "Takes a two arity proc (key,value) and returns a new hashtable
+with the entry at key replaced with the result of calling proc with
+the key and value of the table entry.
+Returns false if there is an error."
+  (if (and (ihashtable? ihashtable)
+           (procedure? proc)
+           (ihashtable-contains? ihashtable key))
+      (let* ((old-value (ihashtable-get ihashtable key #f))
+             (new-value (proc key old-value)))
+        (assoc ihashtable key new-value))
+      #f))
+