narslan · December 11, 2024 11:34 · Feb 19, 2021 · Jul 12, 2019 · Jun 18, 2019 · Oct 11, 2018
diff --git a/circledb.rkt b/circledb.rkt
@@ -1,9 +1,9 @@
 #lang racket
-(require racket/generic)
-(require racket/match)
-(require racket/pretty)
-(require struct-update)
-(require threading)
+(require racket/generic
+         racket/match
+         racket/pretty
+         struct-update
+         threading)
 
 (define flip
   (curry (λ (f a b) (f b a))))
@@ -19,13 +19,10 @@
 
 ; START hash-table utilities (via Clojure)
 (define (get-in m ks (not-found #f))
-  (foldl
-   (lambda (k m)
-     (if (hash? m)
-         (hash-ref m k not-found)
-         not-found))
-   m
-   ks))
+  (for/fold ((m m))
+            ((k ks)
+             #:break (not (hash? m)))
+    (hash-ref m k not-found)))
 
 (define (assoc-in m ks v)
   (match ks
@@ -214,7 +211,7 @@
   (let* ((update-path (drop-right path 1))
          (update-value (last path))
          (index-store (Index-store index))
-         (to-be-updated-set (get-in index update-path (set))))
+         (to-be-updated-set (get-in index-store update-path (set))))
     (Index-store-update
      index (λ (index-store)
              (assoc-in index-store
@@ -296,7 +293,7 @@
 (define (update-layer layer ent-id old-attr updated-attr new-val operation)
   (let* ((storage (Layer-store layer))
          (new-layer (foldl (λ (index) (update-index ent-id old-attr new-val operation index layer) layer indexes))))
-    (Layer-store-set (write-entity storage (put-entity storage ent-id updated-attr)))))
+    (Layer-store-set new-layer (write-entity storage (put-entity storage ent-id updated-attr)))))
 
 (define (update-entity db ent-id attr-name new-val (operation 'db/reset-to))
   (let* ((update-ts (next-ts db))
@@ -363,9 +360,6 @@
        (attr (make-attr "user-id" 0 'db/user))
        (entity (add-attr (make-entity) attr))
        (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'db/user)))
-       (db-2 (transact db [add-entity entity]
-                       [add-entity entity-2])))
+       (db-2 (transact db [add-entity entity] [add-entity entity-2])))
   (pretty-print db-2)
-  (displayln "")
-  (pretty-print (transact db-2 [remove-entity 1]
-                          [remove-entity 2])))
+  (pretty-print (transact db-2 [remove-entity 1] [remove-entity 2])))
diff --git a/circledb.rkt b/circledb.rkt
@@ -49,7 +49,7 @@
   #:transparent
   #:methods gen:Storage
   ((define (get-entity in-mem eid)
-     (hash-ref (InMemory-store in-mem) (if (number? eid) (number->symbol eid) eid)))
+     (hash-ref (InMemory-store in-mem) eid))
 
    (define (write-entity in-mem entity)
      (InMemory-store-update in-mem (λ (store) (hash-set store (Entity-id entity) entity))))
@@ -118,7 +118,7 @@
 
 (define entity-at
   (case-lambda
-    ((db ent-id) (entity-at db (Database-curr-time db) ent-id))
+    ((db ent-id) (entity-at db (Database-curr-time db) (if (number? ent-id) (number->symbol ent-id) ent-id)))
     ((db ts ent-id)
      (let* ((db-layers (Database-layers db))
             (layer-at-ts (list-ref db-layers ts))
@@ -326,25 +326,46 @@
       (Attr-ts-set new-ts)
       (update-attr-value attr new-val operation)))
 
-(define (apply-tx tx db)
-  (let* ((tx-fn (car tx))
-         (tx-args (cdr tx))
-         (db-with-tx-applied (apply tx-fn db tx-args)))
-    (Database-curr-time-set db-with-tx-applied (next-ts db-with-tx-applied))))
-
 (define-syntax-rule (transact db (tx-f tx-args ...) ...)
-  (foldl apply-tx db (list (list tx-f tx-args ...) ...)))
+  (foldr
+   (λ (tx curr-db)
+     (Database-curr-time-set
+      (apply (car tx) curr-db (cdr tx))
+      (next-ts curr-db)))
+   db
+   (list (list tx-f tx-args ...) ...)))
 
 (define (incoming-refs db ts ent-id . ref-names)
   (let* ((VAET-index (index-at db 'VAET ts))
          (all-attr-map (hash-ref (Index-store VAET-index) ent-id))
          (filtered-map (if (not (null? ref-names))
-                           (make-immutable-hash (filter (λ (attr) (member (Attr-name attr) ref-names)) (hash->list all-attr-map)))
+                           (make-immutable-hash
+                            (filter (λ (attr) (member (Attr-name attr) ref-names))
+                                              (hash->list all-attr-map)))
                            all-attr-map)))
     (list->set (hash-values all-attr-map))))
 
+(define (select-keys h ks)
+  (for/hash ((k ks) #:when (hash-has-key? h k))
+    (values k (hash-ref h k))))
+
+(define (select-attrs ref-names attrs-map)
+  (if (null? ref-names)
+      (hash-values attrs-map)
+      (hash-values (select-keys attrs-map ref-names))))
+
+(define (outgoing-refs db ts ent-id . ref-names)
+  (for/list ((attr (select-attrs ref-names (Entity-attrs (entity-at db ts ent-id))))
+             #:when (ref? attr))
+    (Attr-value attr)))
+
 (let* ((db (make-db))
        (attr (make-attr "user-id" 0 'db/user))
        (entity (add-attr (make-entity) attr))
-       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'db/user))))
-  (pretty-print (transact db [add-entity entity] [add-entity entity-2] [remove-entity 2])))
+       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'db/user)))
+       (db-2 (transact db [add-entity entity]
+                       [add-entity entity-2])))
+  (pretty-print db-2)
+  (displayln "")
+  (pretty-print (transact db-2 [remove-entity 1]
+                          [remove-entity 2])))
diff --git a/circledb.rkt b/circledb.rkt
@@ -332,10 +332,8 @@
          (db-with-tx-applied (apply tx-fn db tx-args)))
     (Database-curr-time-set db-with-tx-applied (next-ts db-with-tx-applied))))
 
-(define-syntax (transact stx)
-  (syntax-case stx ()
-    ((_name db (tx-f tx-args ...) ...)
-     #'(foldl apply-tx db (list (list tx-f tx-args ...) ...)))))
+(define-syntax-rule (transact db (tx-f tx-args ...) ...)
+  (foldl apply-tx db (list (list tx-f tx-args ...) ...)))
 
 (define (incoming-refs db ts ent-id . ref-names)
   (let* ((VAET-index (index-at db 'VAET ts))

diff --git a/circledb.rkt b/circledb.rkt
@@ -85,25 +85,20 @@
 (define (make-index from-eav to-eav usage-pred)
   (Index #hash() from-eav to-eav usage-pred))
 
-(define (make-VAET-index)
-  (make-index (λ (e a v) (list v a e))
-              (λ (v a e) (list e a v))
-              ref?))
-
-(define (make-AVET-index)
-  (make-index (λ (e a v) (list a v e))
-              (λ (a v e) (list e a v))
-              always))
-
-(define (make-VEAT-index)
-  (make-index (λ (e a v) (list v e a))
-              (λ (v e a) (list e a v))
-              always))
-
-(define (make-EAVT-index)
-  (make-index (λ (e a v) (list e a v))
-              (λ (e a v) (list e a v))
-              always))
+(define (eav->vae e a v) (list v a e))
+(define (vae->eav v a e) (list e a v))
+(define (make-VAET-index) (make-index eav->vae vae->eav ref?))
+
+(define (eav->ave e a v) (list a v e))
+(define (ave->eav a v e) (list e a v))
+(define (make-AVET-index) (make-index eav->ave ave->eav always))
+
+(define (eav->vea e a v) (list v e a))
+(define (vea->eav v e a) (list e a v))
+(define (make-VEAT-index) (make-index eav->vea vea->eav always))
+
+(define (eav->eav e a v) (list e a v))
+(define (make-EAVT-index) (make-index eav->eav eav->eav always))
 
 (define (initial-db-layer)
   (Layer (InMemory #hash()) (make-VAET-index) (make-AVET-index) (make-VEAT-index) (make-EAVT-index)))
@@ -143,7 +138,7 @@
 (define index-at
   (case-lambda
     ((db kind) (index-at db kind (Database-curr-time db)))
-    ((db kind ts) (kind (list-ref (Database-layers db) ts)))))
+    ((db kind ts) ((get-index-fn kind) (list-ref (Database-layers db) ts)))))
 
 (define (evolution-of db ent-id attr-name)
   (define (at-time res ts)
@@ -317,20 +312,41 @@
 (define (update-attr-value attr value operation)
   (if (equal? 'db/single (Attr-cardinality attr))
       (Attr-value-set attr (set value))
-      (case operation
-        ('db/reset-to (Attr-value-set attr value))
-        ('db/add (Attr-value-update (λ (curr-value-set) (set-union curr-value-set (set value)))))
-        ('db/remove (Attr-value-update (λ (curr-value-set) (set-subtract curr-value-set (set value))))))))
+      (Attr-value-update
+       attr
+       (λ (curr-value)
+         (case operation
+           ('db/reset-to value)
+           ('db/add (set-union curr-value (set value)))
+           ('db/remove (set-subtract curr-value (set value))))))))
 
 (define (update-attr attr new-val new-ts operation)
   (~> attr
       (Attr-prev-ts-set (Attr-ts attr))
       (Attr-ts-set new-ts)
       (update-attr-value attr new-val operation)))
 
+(define (apply-tx tx db)
+  (let* ((tx-fn (car tx))
+         (tx-args (cdr tx))
+         (db-with-tx-applied (apply tx-fn db tx-args)))
+    (Database-curr-time-set db-with-tx-applied (next-ts db-with-tx-applied))))
+
+(define-syntax (transact stx)
+  (syntax-case stx ()
+    ((_name db (tx-f tx-args ...) ...)
+     #'(foldl apply-tx db (list (list tx-f tx-args ...) ...)))))
+
+(define (incoming-refs db ts ent-id . ref-names)
+  (let* ((VAET-index (index-at db 'VAET ts))
+         (all-attr-map (hash-ref (Index-store VAET-index) ent-id))
+         (filtered-map (if (not (null? ref-names))
+                           (make-immutable-hash (filter (λ (attr) (member (Attr-name attr) ref-names)) (hash->list all-attr-map)))
+                           all-attr-map)))
+    (list->set (hash-values all-attr-map))))
+
 (let* ((db (make-db))
        (attr (make-attr "user-id" 0 'db/user))
        (entity (add-attr (make-entity) attr))
-       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'db/user)))
-       (db-2 (Database-curr-time-set (add-entities db entity entity-2) 2)))
-  (pretty-print (remove-entity db-2 '2)))
+       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'db/user))))
+  (pretty-print (transact db [add-entity entity] [add-entity entity-2] [remove-entity 2])))
diff --git a/circledb.rkt b/circledb.rkt
@@ -9,19 +9,23 @@
   (curry (λ (f a b) (f b a))))
 
 (define (ref? attr)
-  (equal? 'db/ref (Attr-type attr)))
+  (symbol=? 'db/ref (Attr-type attr)))
 
 (define (always . etc)
   #t)
 
-; Hash-table utilities (via Clojure)
-(define get-in
-  (case-lambda
-    ((m ks) (get-in m ks #f))
-    ((m ks not-found)
-     (foldl (lambda (k m) (if (hash? m)
-                              (hash-ref m k not-found)
-                              not-found)) m ks))))
+(define number->symbol
+  (compose string->symbol number->string))
+
+; START hash-table utilities (via Clojure)
+(define (get-in m ks (not-found #f))
+  (foldl
+   (lambda (k m)
+     (if (hash? m)
+         (hash-ref m k not-found)
+         not-found))
+   m
+   ks))
 
 (define (assoc-in m ks v)
   (match ks
@@ -34,6 +38,7 @@
   (match ks
     ((list k) (hash-set m k (apply f (hash-ref m k) args)))
     ((list-rest k ks) (hash-set m k (apply update-in (hash-ref m k) ks f args)))))
+; END hash-table utilities (via Clojure)
 
 (define-generics Storage
   (get-entity Storage eid)
@@ -43,19 +48,14 @@
 (struct InMemory (store)
   #:transparent
   #:methods gen:Storage
-  ((define (get-entity store eid)
-     (hash-ref (InMemory-store store) eid))
-
-   (define (write-entity store entity)
-     (struct-copy InMemory store
-                  (store (hash-set (InMemory-store store)
-                                   (Entity-id entity)
-                                   entity))))
-
-   (define (drop-entity store entity)
-     (struct-copy InMemory store
-                  (store (hash-remove (InMemory-store store)
-                                      (Entity-id entity)))))))
+  ((define (get-entity in-mem eid)
+     (hash-ref (InMemory-store in-mem) (if (number? eid) (number->symbol eid) eid)))
+
+   (define (write-entity in-mem entity)
+     (InMemory-store-update in-mem (λ (store) (hash-set store (Entity-id entity) entity))))
+
+   (define (drop-entity in-mem entity)
+     (InMemory-store-update in-mem (λ (store) (hash-remove store (Entity-id entity)))))))
 (define-struct-updaters InMemory)
 
 (struct Index (store from-eav to-eav usage-pred) #:transparent)
@@ -73,8 +73,6 @@
 (struct Attr (name value ts prev-ts type cardinality) #:transparent)
 (define-struct-updaters Attr)
 
-; Keywords are functions in Clojure ... map symbols to functions to emulate here
-; TODO: Refactor (??)
 (define indexes '(VAET AVET VEAT EAVT))
 (define index-fns (hash 'VAET Layer-VAET
                         'AVET Layer-AVET
@@ -88,23 +86,23 @@
   (Index #hash() from-eav to-eav usage-pred))
 
 (define (make-VAET-index)
-  (make-index (λ (x y z) (list z y x))
-              (λ (x y z) (list z y x))
+  (make-index (λ (e a v) (list v a e))
+              (λ (v a e) (list e a v))
               ref?))
 
 (define (make-AVET-index)
-  (make-index (λ (x y z) (list y z x))
-              (λ (x y z) (list z x y))
+  (make-index (λ (e a v) (list a v e))
+              (λ (a v e) (list e a v))
               always))
 
 (define (make-VEAT-index)
-  (make-index (λ (x y z) (list z x y))
-              (λ (x y z) (list y z y))
+  (make-index (λ (e a v) (list v e a))
+              (λ (v e a) (list e a v))
               always))
 
 (define (make-EAVT-index)
-  (make-index (λ (x y z) (list x y z))
-              (λ (x y z) (list x y z))
+  (make-index (λ (e a v) (list e a v))
+              (λ (e a v) (list e a v))
               always))
 
 (define (initial-db-layer)
@@ -113,7 +111,8 @@
 (define (make-db)
   (Database (list (initial-db-layer)) 0 0))
 
-(define (make-entity (id 'db/no-id-yet)) (Entity id (hash)))
+(define (make-entity (id 'db/no-id-yet))
+  (Entity id (hash)))
 
 (define (make-attr name value type #:cardinality (cardinality 'db/single))
   (Attr name value -1 -1 type cardinality))
@@ -125,7 +124,7 @@
 (define entity-at
   (case-lambda
     ((db ent-id) (entity-at db (Database-curr-time db) ent-id))
-    ((db ts ent-id) 
+    ((db ts ent-id)
      (let* ((db-layers (Database-layers db))
             (layer-at-ts (list-ref db-layers ts))
             (ts-layer-store (Layer-store layer-at-ts)))
@@ -157,16 +156,15 @@
 (define (add-entity db ent)
   (match-let* (((cons new-entity new-id) (fix-new-entity db ent))
                (latest-layer (last (Database-layers db)))
-               (layer-with-updated-store (struct-copy Layer latest-layer
-                                                      (store (write-entity (Layer-store latest-layer)
-                                                                           new-entity))))
+               (layer-with-updated-store (Layer-store-update latest-layer (λ (store) (write-entity store new-entity))))
                (add-fn (λ (index layer) (add-entity-to-index new-entity layer index)))
                (new-layer (foldl add-fn layer-with-updated-store indexes)))
-    (struct-copy Database db
-                 (layers (append (Database-layers db) (list new-layer)))
-                 (top-id new-id))))
+    (~> db
+        (Database-layers-update (λ (layers) (append layers (list new-layer))))
+        (Database-top-id-set new-id))))
 
 (define (next-ts db) (+ (Database-curr-time db) 1))
+
 (define (update-creation-ts ent ts-val)
   (Entity-attrs-update
    ent (λ (attrs) (make-immutable-hash
@@ -184,18 +182,18 @@
 (define (fix-new-entity db ent)
   (match-let* (((cons ent-id next-top-id) (next-id db ent))
                (new-ts (next-ts db)))
-    (cons (update-creation-ts (struct-copy Entity ent (id ent-id)) new-ts) next-top-id)))
+    (cons (update-creation-ts (Entity-id-set ent ent-id) new-ts) next-top-id)))
 
 (define (get-update-layer-fn layer layer-fn-name)
   (match layer-fn-name
-    ('VAET (λ (q) (struct-copy Layer layer (VAET q))))
-    ('AVET (λ (q) (struct-copy Layer layer (AVET q))))
-    ('VEAT (λ (q) (struct-copy Layer layer (VEAT q))))
-    ('EAVT (λ (q) (struct-copy Layer layer (EAVT q))))))
+    ('VAET (λ (q) (Layer-VAET-set layer q)))
+    ('AVET (λ (q) (Layer-AVET-set layer q)))
+    ('VEAT (λ (q) (Layer-VEAT-set layer q)))
+    ('EAVT (λ (q) (Layer-EAVT-set layer q)))))
 
 (define (add-entity-to-index ent layer index-fn)
   (let* ((ent-id (Entity-id ent))
-         (index ((hash-ref index-fns index-fn) layer))
+         (index ((get-index-fn index-fn) layer))
          (all-attrs (hash-values (Entity-attrs ent)))
          (relevant-attrs (filter (λ (attr) ((Index-usage-pred index) attr)) all-attrs))
          (add-in-index-fn (λ (attr ind) (update-attr-in-index ind ent-id
@@ -235,35 +233,39 @@
   (let* ((ent (entity-at db ent-id))
          (layer (remove-back-refs db ent-id (last (Database-layers db))))
          (VAET-index (Layer-VAET layer))
-         (no-ref-layer ((get-update-layer-fn 'VAET) (hash-remove (Index-store VAET-index) ent-id)))
-         (no-ent-layer (struct-copy Layer no-ref-layer (store (drop-entity (Layer-store layer) ent))))
-         (new-layer (foldl (λ (index layer) (remove-entity-from-index layer index ent) no-ent-layer indexes))))
-    (struct-copy Database db (layers (append (Database-layers db) (list new-layer))))))
+         (no-ref-layer (Layer-VAET-update layer
+                                          (λ (VAET-index)
+                                            (Index-store-update VAET-index
+                                                                (λ (store)
+                                                                  (hash-remove store ent-id))))))
+         (no-ent-layer (Layer-store-update no-ref-layer (λ (store) (drop-entity store ent))))
+         (new-layer (foldl (λ (index layer) (remove-entity-from-index ent layer index)) no-ent-layer indexes)))
+    (Database-layers-update db (λ (layers) (append layers (list new-layer))))))
 
 (define (remove-entity-from-index ent layer ind-name)
   (let* ((ent-id (Entity-id ent))
-         (index ((index-fns ind-name) layer))
+         (index ((get-index-fn ind-name) layer))
          (all-attrs (hash-values (Entity-attrs ent)))
          (relevant-attrs (filter (λ (attr) ((Index-usage-pred index) attr)) all-attrs))
          (remove-from-index-fn (λ (attr index) (remove-entries-from-index ent-id 'db/remove index attr))))
     ((get-update-layer-fn layer ind-name) (foldl remove-from-index-fn index relevant-attrs))))
 
-(define (remove-entry-from-index index path)
+(define (remove-entry-from-index path index)
   (let* ((path-head (first path))
          (path-to-items (drop-right path 1))
          (val-to-remove (last path))
-         (old-entries-set (get-in index path-to-items)))
+         (old-entries-set (get-in (Index-store index) path-to-items)))
     (cond
-      ((not (member val-to-remove old-entries-set)) index)
-      ((= 1 (length old-entries-set)) (Index-store-update (λ (store)
-                                                            (update-in store
-                                                                       (collify path-head)
-                                                                       hash-remove
-                                                                       (cadr path)))))
+      ((not (set-member? old-entries-set val-to-remove)) index)
+      ((= 1 (set-count old-entries-set)) (Index-store-update index (λ (store)
+                                                                     (update-in store
+                                                                                (collify path-head)
+                                                                                hash-remove
+                                                                                (cadr path)))))
       (else (Index-store-update (λ (store) (update-in store path-to-items set-remove val-to-remove)))))))
 
 (define (remove-entries-from-index ent-id operation index attr)
-  (if (not (equal? operation 'db/add))
+  (if (not (symbol=? operation 'db/add))
       (let* ((attr-name (Attr-name attr))
              (datom-vals (collify (Attr-value attr)))
              (paths (map (λ (datom-val) ((Index-from-eav index) ent-id attr-name datom-val)) datom-vals)))
@@ -278,20 +280,18 @@
 
 (define (reffing-to eid layer)
   (let ((VAET-index (Layer-VAET layer)))
-    (for ((attr-name-and-reffing-set (hash-ref (Layer-store layer) eid)))
-      (let ((attr-name (car attr-name-and-reffing-set))
-            (reffing-set (cadr attr-name-and-reffing-set)))
-        (for ((reffing reffing-set))
-          (list reffing (car attr-name-and-reffing-set)))))))
+    (for*/list (((attr-name reffing-set) (hash-ref (Index-store VAET-index) (number->symbol eid) '()))
+                (reffing reffing-set))
+      (list reffing attr-name))))
 
 (define (update-index ent-id old-attr target-val operation layer ind-name)
   (if (((Index-usage-pred ((get-index-fn ind-name) layer)) (get-in layer (list ind-name))) old-attr)
-      (let* ((index ((index-fns ind-name) layer))
+      (let* ((index ((get-index-fn ind-name) layer))
              (cleaned-index (remove-entries-from-index ent-id operation index old-attr))
              (updated-index (if (symbol=? operation 'db/remove)
                                 cleaned-index
                                 (update-attr-in-index cleaned-index ent-id (Attr-name old-attr) target-val operation))))
-        ((get-update-layer-fn ind-name) updated-index))
+        ((get-update-layer-fn layer ind-name) updated-index))
       layer))
 
 (define (put-entity storage eid new-attr)
@@ -329,9 +329,8 @@
       (update-attr-value attr new-val operation)))
 
 (let* ((db (make-db))
-       (attr (make-attr "user-id" 0 'int))
+       (attr (make-attr "user-id" 0 'db/user))
        (entity (add-attr (make-entity) attr))
-       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'int)))
-       (db-2 (add-entities db entity entity-2)))
-  (pretty-print db-2)
-  (pretty-print (remove-entity db-2 "user-id")))
+       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'db/user)))
+       (db-2 (Database-curr-time-set (add-entities db entity entity-2) 2)))
+  (pretty-print (remove-entity db-2 '2)))
diff --git a/circledb.rkt b/circledb.rkt
@@ -0,0 +1,337 @@
+#lang racket
+(require racket/generic)
+(require racket/match)
+(require racket/pretty)
+(require struct-update)
+(require threading)
+
+(define flip
+  (curry (λ (f a b) (f b a))))
+
+(define (ref? attr)
+  (equal? 'db/ref (Attr-type attr)))
+
+(define (always . etc)
+  #t)
+
+; Hash-table utilities (via Clojure)
+(define get-in
+  (case-lambda
+    ((m ks) (get-in m ks #f))
+    ((m ks not-found)
+     (foldl (lambda (k m) (if (hash? m)
+                              (hash-ref m k not-found)
+                              not-found)) m ks))))
+
+(define (assoc-in m ks v)
+  (match ks
+    ('() m)
+    ((list k) (hash-set m k v))
+    ((list-rest k ks) (hash-set m k (assoc-in (hash-ref m k (hash)) ks v)))
+    (else (hash-set m ks v))))
+
+(define (update-in m ks f . args)
+  (match ks
+    ((list k) (hash-set m k (apply f (hash-ref m k) args)))
+    ((list-rest k ks) (hash-set m k (apply update-in (hash-ref m k) ks f args)))))
+
+(define-generics Storage
+  (get-entity Storage eid)
+  (write-entity Storage entity)
+  (drop-entity Storage entity))
+
+(struct InMemory (store)
+  #:transparent
+  #:methods gen:Storage
+  ((define (get-entity store eid)
+     (hash-ref (InMemory-store store) eid))
+
+   (define (write-entity store entity)
+     (struct-copy InMemory store
+                  (store (hash-set (InMemory-store store)
+                                   (Entity-id entity)
+                                   entity))))
+
+   (define (drop-entity store entity)
+     (struct-copy InMemory store
+                  (store (hash-remove (InMemory-store store)
+                                      (Entity-id entity)))))))
+(define-struct-updaters InMemory)
+
+(struct Index (store from-eav to-eav usage-pred) #:transparent)
+(define-struct-updaters Index)
+
+(struct Layer (store VAET AVET VEAT EAVT) #:transparent)
+(define-struct-updaters Layer)
+
+(struct Database (layers top-id curr-time) #:transparent)
+(define-struct-updaters Database)
+
+(struct Entity (id attrs) #:transparent)
+(define-struct-updaters Entity)
+
+(struct Attr (name value ts prev-ts type cardinality) #:transparent)
+(define-struct-updaters Attr)
+
+; Keywords are functions in Clojure ... map symbols to functions to emulate here
+; TODO: Refactor (??)
+(define indexes '(VAET AVET VEAT EAVT))
+(define index-fns (hash 'VAET Layer-VAET
+                        'AVET Layer-AVET
+                        'VEAT Layer-VEAT
+                        'EAVT Layer-EAVT))
+
+(define (get-index-fn idx)
+  (hash-ref index-fns idx))
+
+(define (make-index from-eav to-eav usage-pred)
+  (Index #hash() from-eav to-eav usage-pred))
+
+(define (make-VAET-index)
+  (make-index (λ (x y z) (list z y x))
+              (λ (x y z) (list z y x))
+              ref?))
+
+(define (make-AVET-index)
+  (make-index (λ (x y z) (list y z x))
+              (λ (x y z) (list z x y))
+              always))
+
+(define (make-VEAT-index)
+  (make-index (λ (x y z) (list z x y))
+              (λ (x y z) (list y z y))
+              always))
+
+(define (make-EAVT-index)
+  (make-index (λ (x y z) (list x y z))
+              (λ (x y z) (list x y z))
+              always))
+
+(define (initial-db-layer)
+  (Layer (InMemory #hash()) (make-VAET-index) (make-AVET-index) (make-VEAT-index) (make-EAVT-index)))
+
+(define (make-db)
+  (Database (list (initial-db-layer)) 0 0))
+
+(define (make-entity (id 'db/no-id-yet)) (Entity id (hash)))
+
+(define (make-attr name value type #:cardinality (cardinality 'db/single))
+  (Attr name value -1 -1 type cardinality))
+
+(define (add-attr ent attr)
+  ; Returns a new entity containing attr in its attr map
+  (Entity-attrs-update ent (λ (attrs) (hash-set attrs (string->symbol (Attr-name attr)) attr))))
+
+(define entity-at
+  (case-lambda
+    ((db ent-id) (entity-at db (Database-curr-time db) ent-id))
+    ((db ts ent-id) 
+     (let* ((db-layers (Database-layers db))
+            (layer-at-ts (list-ref db-layers ts))
+            (ts-layer-store (Layer-store layer-at-ts)))
+       (get-entity ts-layer-store ent-id)))))
+
+(define attr-at
+  (case-lambda
+    ((db ent-id attr-name) (attr-at db ent-id attr-name (Database-curr-time db)))
+    ((db ent-id attr-name ts) (hash-ref (Entity-attrs (entity-at db ts ent-id)) attr-name))))
+
+(define value-of-at
+  (case-lambda
+    ((db ent-id attr-name) (Attr-value (attr-at db ent-id attr-name)))
+    ((db ent-id attr-name ts) (Attr-value (attr-at db ent-id attr-name ts)))))
+
+(define index-at
+  (case-lambda
+    ((db kind) (index-at db kind (Database-curr-time db)))
+    ((db kind ts) (kind (list-ref (Database-layers db) ts)))))
+
+(define (evolution-of db ent-id attr-name)
+  (define (at-time res ts)
+    (if (-1 ts)
+        res
+        (let ((attr (attr-at db ent-id attr-name ts)))
+          (at-time (cons (hash (Attr-ts attr) (Attr-value attr)) res) (Attr-prev-ts attr)))))
+  (at-time '() (Database-curr-time db)))
+
+(define (add-entity db ent)
+  (match-let* (((cons new-entity new-id) (fix-new-entity db ent))
+               (latest-layer (last (Database-layers db)))
+               (layer-with-updated-store (struct-copy Layer latest-layer
+                                                      (store (write-entity (Layer-store latest-layer)
+                                                                           new-entity))))
+               (add-fn (λ (index layer) (add-entity-to-index new-entity layer index)))
+               (new-layer (foldl add-fn layer-with-updated-store indexes)))
+    (struct-copy Database db
+                 (layers (append (Database-layers db) (list new-layer)))
+                 (top-id new-id))))
+
+(define (next-ts db) (+ (Database-curr-time db) 1))
+(define (update-creation-ts ent ts-val)
+  (Entity-attrs-update
+   ent (λ (attrs) (make-immutable-hash
+                   (hash-map attrs
+                             (λ (k v) (cons k (Attr-ts-set v ts-val))))))))
+
+(define (next-id db ent)
+  (let* ((top-id (Database-top-id db))
+         (ent-id (Entity-id ent))
+         (increased-id (+ top-id 1)))
+    (if (symbol=? ent-id 'db/no-id-yet)
+        (cons (string->symbol (number->string increased-id)) increased-id)
+        (cons ent-id top-id))))
+
+(define (fix-new-entity db ent)
+  (match-let* (((cons ent-id next-top-id) (next-id db ent))
+               (new-ts (next-ts db)))
+    (cons (update-creation-ts (struct-copy Entity ent (id ent-id)) new-ts) next-top-id)))
+
+(define (get-update-layer-fn layer layer-fn-name)
+  (match layer-fn-name
+    ('VAET (λ (q) (struct-copy Layer layer (VAET q))))
+    ('AVET (λ (q) (struct-copy Layer layer (AVET q))))
+    ('VEAT (λ (q) (struct-copy Layer layer (VEAT q))))
+    ('EAVT (λ (q) (struct-copy Layer layer (EAVT q))))))
+
+(define (add-entity-to-index ent layer index-fn)
+  (let* ((ent-id (Entity-id ent))
+         (index ((hash-ref index-fns index-fn) layer))
+         (all-attrs (hash-values (Entity-attrs ent)))
+         (relevant-attrs (filter (λ (attr) ((Index-usage-pred index) attr)) all-attrs))
+         (add-in-index-fn (λ (attr ind) (update-attr-in-index ind ent-id
+                                                              (Attr-name attr)
+                                                              (Attr-value attr)
+                                                              'db/add))))
+    ((get-update-layer-fn layer index-fn) (foldl add-in-index-fn index relevant-attrs))))
+
+(define (collify item)
+  (if (list? item)
+      item
+      (list item)))
+
+(define (update-attr-in-index index ent-id attr-name target-val operation)
+  (let* ((colled-target-val (collify target-val))
+         (update-entry-fn (λ (vl ind)
+                            (update-entry-in-index ind
+                                                   ((Index-from-eav index) ent-id attr-name vl)
+                                                   operation))))
+    (foldl update-entry-fn index colled-target-val)))
+
+(define (update-entry-in-index index path operation)
+  (let* ((update-path (drop-right path 1))
+         (update-value (last path))
+         (index-store (Index-store index))
+         (to-be-updated-set (get-in index update-path (set))))
+    (Index-store-update
+     index (λ (index-store)
+             (assoc-in index-store
+                       update-path
+                       (set-add to-be-updated-set
+                                update-value))))))
+
+(define (add-entities db . ents) (foldl (flip add-entity) db ents))
+
+(define (remove-entity db ent-id)
+  (let* ((ent (entity-at db ent-id))
+         (layer (remove-back-refs db ent-id (last (Database-layers db))))
+         (VAET-index (Layer-VAET layer))
+         (no-ref-layer ((get-update-layer-fn 'VAET) (hash-remove (Index-store VAET-index) ent-id)))
+         (no-ent-layer (struct-copy Layer no-ref-layer (store (drop-entity (Layer-store layer) ent))))
+         (new-layer (foldl (λ (index layer) (remove-entity-from-index layer index ent) no-ent-layer indexes))))
+    (struct-copy Database db (layers (append (Database-layers db) (list new-layer))))))
+
+(define (remove-entity-from-index ent layer ind-name)
+  (let* ((ent-id (Entity-id ent))
+         (index ((index-fns ind-name) layer))
+         (all-attrs (hash-values (Entity-attrs ent)))
+         (relevant-attrs (filter (λ (attr) ((Index-usage-pred index) attr)) all-attrs))
+         (remove-from-index-fn (λ (attr index) (remove-entries-from-index ent-id 'db/remove index attr))))
+    ((get-update-layer-fn layer ind-name) (foldl remove-from-index-fn index relevant-attrs))))
+
+(define (remove-entry-from-index index path)
+  (let* ((path-head (first path))
+         (path-to-items (drop-right path 1))
+         (val-to-remove (last path))
+         (old-entries-set (get-in index path-to-items)))
+    (cond
+      ((not (member val-to-remove old-entries-set)) index)
+      ((= 1 (length old-entries-set)) (Index-store-update (λ (store)
+                                                            (update-in store
+                                                                       (collify path-head)
+                                                                       hash-remove
+                                                                       (cadr path)))))
+      (else (Index-store-update (λ (store) (update-in store path-to-items set-remove val-to-remove)))))))
+
+(define (remove-entries-from-index ent-id operation index attr)
+  (if (not (equal? operation 'db/add))
+      (let* ((attr-name (Attr-name attr))
+             (datom-vals (collify (Attr-value attr)))
+             (paths (map (λ (datom-val) ((Index-from-eav index) ent-id attr-name datom-val)) datom-vals)))
+        (foldl remove-entry-from-index index paths))
+      index))
+
+(define (remove-back-refs db eid layer)
+  (let* ((reffing-datoms (reffing-to eid layer))
+         (remove-fn (λ (ea db) (update-entity db (car ea) (cadr ea) eid 'db/remove)))
+         (clean-db (foldl remove-fn db reffing-datoms)))
+    (last (Database-layers clean-db))))
+
+(define (reffing-to eid layer)
+  (let ((VAET-index (Layer-VAET layer)))
+    (for ((attr-name-and-reffing-set (hash-ref (Layer-store layer) eid)))
+      (let ((attr-name (car attr-name-and-reffing-set))
+            (reffing-set (cadr attr-name-and-reffing-set)))
+        (for ((reffing reffing-set))
+          (list reffing (car attr-name-and-reffing-set)))))))
+
+(define (update-index ent-id old-attr target-val operation layer ind-name)
+  (if (((Index-usage-pred ((get-index-fn ind-name) layer)) (get-in layer (list ind-name))) old-attr)
+      (let* ((index ((index-fns ind-name) layer))
+             (cleaned-index (remove-entries-from-index ent-id operation index old-attr))
+             (updated-index (if (symbol=? operation 'db/remove)
+                                cleaned-index
+                                (update-attr-in-index cleaned-index ent-id (Attr-name old-attr) target-val operation))))
+        ((get-update-layer-fn ind-name) updated-index))
+      layer))
+
+(define (put-entity storage eid new-attr)
+  (Entity-attrs-update (get-entity storage eid)
+                       (λ (attrs) (hash-set attrs (Attr-name new-attr) new-attr))))
+
+(define (update-layer layer ent-id old-attr updated-attr new-val operation)
+  (let* ((storage (Layer-store layer))
+         (new-layer (foldl (λ (index) (update-index ent-id old-attr new-val operation index layer) layer indexes))))
+    (Layer-store-set (write-entity storage (put-entity storage ent-id updated-attr)))))
+
+(define (update-entity db ent-id attr-name new-val (operation 'db/reset-to))
+  (let* ((update-ts (next-ts db))
+         (layer (last (Database-layers db)))
+         (attr (attr-at db ent-id attr-name))
+         (updated-attr (update-attr attr new-val update-ts operation))
+         (fully-updated-layer (update-layer layer ent-id attr updated-attr new-val operation)))
+    (Database-layers-update db (λ (layer) (append layer (list fully-updated-layer))))))
+
+(define (update-attr-modification-time attr new-ts)
+  (Attr-ts-set (Attr-prev-ts-set attr (Attr-ts attr)) new-ts))
+
+(define (update-attr-value attr value operation)
+  (if (equal? 'db/single (Attr-cardinality attr))
+      (Attr-value-set attr (set value))
+      (case operation
+        ('db/reset-to (Attr-value-set attr value))
+        ('db/add (Attr-value-update (λ (curr-value-set) (set-union curr-value-set (set value)))))
+        ('db/remove (Attr-value-update (λ (curr-value-set) (set-subtract curr-value-set (set value))))))))
+
+(define (update-attr attr new-val new-ts operation)
+  (~> attr
+      (Attr-prev-ts-set (Attr-ts attr))
+      (Attr-ts-set new-ts)
+      (update-attr-value attr new-val operation)))
+
+(let* ((db (make-db))
+       (attr (make-attr "user-id" 0 'int))
+       (entity (add-attr (make-entity) attr))
+       (entity-2 (add-attr (make-entity) (make-attr "user-id" 1 'int)))
+       (db-2 (add-entities db entity entity-2)))
+  (pretty-print db-2)
+  (pretty-print (remove-entity db-2 "user-id")))