datahike-browser-tests 1.0.0

package/src/datahike/index/persistent_set.cljc

@@ -0,0 +1,469 @@
+(ns ^:no-doc datahike.index.persistent-set
+  (:require [clojure.string]
+            [org.replikativ.persistent-sorted-set :as psset]
+            #?(:cljs [org.replikativ.persistent-sorted-set.btset :refer [BTSet]])
+            #?(:cljs [org.replikativ.persistent-sorted-set.branch :refer [Branch]])
+            #?(:cljs [org.replikativ.persistent-sorted-set.leaf :refer [Leaf]])
+            #?(:cljs [org.replikativ.persistent-sorted-set.impl.storage :refer [IStorage]])
+            [org.replikativ.persistent-sorted-set.arrays :as arrays]
+            #?@(:clj  [[clojure.core.cache :as cache]
+                       [clojure.core.cache.wrapped :as wrapped]]
+                :cljs [[cljs.cache :as cache]
+                       [cljs.cache.wrapped :as wrapped]])
+            [datahike.datom :as dd :refer [index-type->cmp-quick]]
+            [datahike.constants :refer [tx0 txmax]]
+            [datahike.index.interface :as di :refer [IIndex]]
+            [datahike.tools :as dt]
+            [konserve.core :as k]
+            [konserve.serializers :refer [fressian-serializer]]
+            #?(:cljs [fress.api :as fress])
+            [hasch.core :refer [uuid squuid]]
+            [taoensso.timbre :refer [trace]])
+  #?(:cljs (:require-macros [datahike.index.persistent-set :refer [generate-slice-comparator-constructor]]))
+  #?(:clj (:import [datahike.datom Datom]
+                   [org.fressian.handlers WriteHandler ReadHandler]
+                   [org.replikativ.persistent_sorted_set PersistentSortedSet IStorage Leaf Branch ANode Settings]
+                   [java.util List])))
+
+(def index-type->kwseq
+  {:eavt [:e :a :v :tx :added]
+   :aevt [:a :e :v :tx :added]
+   :avet [:a :v :e :tx :added]})
+
+(defn slice-from-to-tree
+  "This function generates code for deciding which datom elements that need to be compared based on which elements in the slice bounds are nil, as well as the index. Once all datom elements have been considered, `leaf-fn` is called with a vector containing the keywords of the actual elements to compare."
+  [from-sym to-sym index-spec acc leaf-fn]
+  (if (empty? index-spec)
+
+    ;; When there is nothing left to compare,
+    ;; return the correct comparator.
+    (leaf-fn acc)
+
+    (let [[findex & index-spec] index-spec]
+      `(if (and (nil? (~findex ~from-sym))
+                (nil? (~findex ~to-sym)))
+
+         ;; Whenever both slice bounds are nil, there is nothing more to compare
+         ;; and we know what comparator to return.
+         ~(leaf-fn acc)
+
+         ;; Otherwise, if at least one slie bound is non-nil, we need a comparator for
+         ;; the remaining datom elements.
+         ~(slice-from-to-tree from-sym to-sym index-spec (conj acc findex) leaf-fn)))))
+
+(defn cmp-for-kwseq-sub
+  "This function generates the actual body of the comparator"
+  [datom0 datom1 kwseq]
+  (let [result (gensym)]
+    (if (empty? kwseq)
+      0
+      (let [[k & kwseq] kwseq]
+        `(let [;; Compare the datoms at the element with key `k`
+               ~result ~(dd/cmp-val-expr k datom0 datom1)]
+           (cond
+             ;; If it is nil, typically return 0
+             (nil? ~result) 0
+
+             ;; If it is zero, we need to proceed with the next datom element to compare.
+             (zero? ~result) ~(cmp-for-kwseq-sub datom0 datom1 kwseq)
+
+             ;; If it is non-zero, it means that this is the result of the comparison.
+             :else ~result))))))
+
+(defn cmp-for-kwseq
+  "Given a sequence of keywords for datom elements to compare, generate the code for a function that performs the comparison."
+  [kwseq]
+  (let [datom0 (dd/type-hint-datom (gensym))
+        datom1 (dd/type-hint-datom (gensym))]
+    `(fn [~datom0 ~datom1] ~(cmp-for-kwseq-sub datom0 datom1 kwseq))))
+
+(defmacro generate-slice-comparator-constructor []
+  (let [index-sym (gensym)
+        from-sym (gensym)
+        to-sym (gensym)
+
+        ;; List keyword sequences referring to datom elements for
+        ;; all combinations of indexes and leftmost slices of the
+        ;; corresponding datom elements.
+        all-kwseqs (set (for [[_ kwseq] index-type->kwseq
+                              limit (range 6)]
+                          (vec (take limit kwseq))))
+        kwseq-sym-map (zipmap all-kwseqs (repeatedly gensym))]
+    `(let [;; Pre-build comparators for every sequence
+           ;; of keywords referring to datom elements.
+           ;; A comparator is a function taking two datoms
+           ;; as arguments.
+           ~@(mapcat (fn [[kwseq sym]]
+                       [sym (cmp-for-kwseq kwseq)])
+                     kwseq-sym-map)]
+
+;; This is the function generated by this macro
+       ;; and it is called by the `-slice` method.
+       (fn [~index-sym ~from-sym ~to-sym]
+
+         ;; First branch based on which index to use ...
+         (case ~index-sym
+           ~@(mapcat
+              (fn [[index-key index-spec]]
+                [index-key
+
+                 ;; ... then branch based on what elements
+                 ;; are non-nil in the slice bound datoms ...
+                 (slice-from-to-tree
+                  from-sym to-sym
+                  index-spec
+                  []
+
+                  (fn [acc]
+                    {:post [(symbol? %)]}
+
+                    ;; ... and eventually return a precomputed comparator
+                    ;; that will be used by `psset/slice`. The generated
+                    ;; code is the symbol that is bound to a comparator.
+                    (get kwseq-sym-map acc)))])
+              index-type->kwseq))))))
+
+(def slice-comparator-constructor (generate-slice-comparator-constructor))
+
+(defn remove-datom [pset ^Datom datom index-type]
+  (psset/disj pset datom (index-type->cmp-quick index-type false)))
+
+(defn insert [pset ^Datom datom index-type]
+  ;; Use lookup with prefix comparator - O(log n) with zero allocations
+  ;; Prefix comparator checks only (e,a,v) to find if ANY datom exists with same triple
+  (if #?(:clj (.lookup ^PersistentSortedSet pset datom (dd/index-type->cmp-prefix index-type))
+         :cljs (psset/lookup pset datom (dd/index-type->cmp-prefix index-type)))
+    pset
+    (psset/conj pset datom (index-type->cmp-quick index-type))))
+
+(defn temporal-insert [pset ^Datom datom index-type]
+  (psset/conj pset datom (index-type->cmp-quick index-type false)))
+
+(defn upsert [pset ^Datom datom index-type old-datom]
+  (if old-datom
+    (if (= index-type :avet)
+      (-> pset
+          (psset/disj old-datom (index-type->cmp-quick index-type))
+          (psset/conj datom (index-type->cmp-quick index-type)))
+      #?(:clj (.replace ^PersistentSortedSet pset old-datom datom (dd/index-type->cmp-replace index-type))
+         :cljs (psset/replace pset old-datom datom (dd/index-type->cmp-replace index-type))))
+    (psset/conj pset datom (index-type->cmp-quick index-type))))
+
+(defn temporal-upsert [pset ^Datom datom index-type {old-val :v}]
+  (let [{:keys [e a v tx added]} datom]
+    (if added
+      (if old-val
+        (if (= v old-val)
+          pset
+          (-> pset
+              (psset/conj (dd/datom e a old-val tx false)
+                          (index-type->cmp-quick index-type false))
+              (psset/conj datom
+                          (index-type->cmp-quick index-type false))))
+        (psset/conj pset datom (index-type->cmp-quick index-type false)))
+      (if old-val
+        (psset/conj pset
+                    (dd/datom e a old-val tx false)
+                    (index-type->cmp-quick index-type false))
+        pset))))
+
+(defn mark [^PersistentSortedSet pset]
+  (when-not (.-_address pset)
+    (throw (ex-info "Index needs to be properly flushed before marking."
+                    {:type :flush-before-marking})))
+  (let [addresses (atom #{})]
+    (psset/walk-addresses pset (fn [address] (swap! addresses conj address)))
+    @addresses))
+
+(extend-type #?(:clj PersistentSortedSet :cljs BTSet)
+  IIndex
+  (-slice [^PersistentSortedSet pset from to index-type]
+    (psset/slice pset from to (slice-comparator-constructor index-type from to)))
+  (-all [pset]
+    (identity pset))
+  (-seq [^PersistentSortedSet pset]
+    (seq pset))
+  (-count [^PersistentSortedSet pset]
+    (count pset))
+  (-insert [^PersistentSortedSet pset datom index-type _op-count]
+    (insert pset datom index-type))
+  (-temporal-insert [^PersistentSortedSet pset datom index-type _op-count]
+    (psset/conj pset datom (index-type->cmp-quick index-type)))
+  (-upsert [^PersistentSortedSet pset datom index-type _op-count old-datom]
+    (upsert pset datom index-type old-datom))
+  (-temporal-upsert [^PersistentSortedSet pset datom index-type _op-count old-val]
+    (temporal-upsert pset datom index-type old-val))
+  (-remove [^PersistentSortedSet pset datom index-type _op-count]
+    (remove-datom pset datom index-type))
+  (-flush [^PersistentSortedSet pset _]
+    (psset/store pset)
+    pset)
+  (-transient [^PersistentSortedSet pset]
+    (transient pset))
+  (-persistent! [^PersistentSortedSet pset]
+    (persistent! pset))
+  (-mark [^PersistentSortedSet pset]
+    (mark pset)))
+
+(defn- gen-address [^ANode node crypto-hash?]
+  (if crypto-hash?
+    (if (instance? Branch node)
+      (uuid (vec (.addresses ^Branch node)))
+      (uuid (mapv (comp vec seq) (.keys node))))
+    (squuid)))  ;; Sequential UUID for better index locality
+
+(defn- freelist-pop!
+  "Atomically pop an address from the freelist. Returns nil if empty."
+  [freelist-atom]
+  (loop []
+    (let [current @freelist-atom]
+      (if (empty? current)
+        nil
+        (let [addr (peek current)
+              new-list (pop current)]
+          (if (compare-and-set! freelist-atom current new-list)
+            addr
+            (recur)))))))
+
+(defrecord CachedStorage [store config cache stats pending-writes freed-addresses freed-set freelist cost-center-fn]
+  IStorage
+  (store [_ node #?(:cljs opts)]
+    (@cost-center-fn :store)
+    (swap! stats update :writes inc)
+    (let [;; Only reuse addresses when not using crypto-hash (content-addressed storage
+          ;; requires the address to match the content)
+          reused (when-not (:crypto-hash? config)
+                   (freelist-pop! freelist))
+          address (or reused (gen-address node (:crypto-hash? config)))
+          _ (trace "writing storage: " address " reused: " (boolean reused) " crypto: " (:crypto-hash? config))]
+      ;; Evict old cached value when reusing an address
+      (when reused
+        (wrapped/evict cache address))
+      (swap! pending-writes conj [address node])
+      (wrapped/miss cache address node)
+      address))
+  (accessed [_ address]
+    (@cost-center-fn :accessed)
+    (trace "accessing storage: " address)
+    (swap! stats update :accessed inc)
+    (wrapped/hit cache address)
+    nil)
+  (restore [_ address #?(:cljs opts)]
+    (@cost-center-fn :restore)
+    (trace "reading: " address)
+    (if-let [cached (wrapped/lookup cache address)]
+      cached
+      (let [node (k/get store address nil {:sync? true})]
+        (when (nil? node)
+          (dt/raise "Node not found in storage." {:type :node-not-found
+                                                  :address address
+                                                  :store store}))
+        (swap! stats update :reads inc)
+        (wrapped/miss cache address node)
+        node)))
+  (markFreed [_ address]
+    (when address
+      (let [now #?(:clj (java.util.Date.) :cljs (js/Date.))]
+        (trace "marking address as freed: " address)
+        (swap! freed-set conj address)
+        (swap! freed-addresses conj [address now]))))
+  (isFreed [_ address]
+    (contains? @freed-set address))
+  (freedInfo [_ address]
+    (when (contains? @freed-set address)
+      "Address has been marked as freed")))
+
+(def init-stats {:writes   0
+                 :reads    0
+                 :accessed 0})
+
+(defn create-storage [store config]
+  (CachedStorage. store config
+                  (atom (cache/lru-cache-factory {} :threshold (:store-cache-size config)))
+                  (atom init-stats)
+                  (atom [])
+                  (atom [])  ;; freed-addresses: vector of [address timestamp] pairs
+                  (atom #{}) ;; freed-set: HashSet for O(1) isFreed lookups
+                  (atom [])  ;; freelist: vector of reusable addresses (used as stack via peek/pop)
+                  (atom (fn [_] nil))))
+
+(def ^:const DEFAULT_BRANCHING_FACTOR 512)
+
+(defmethod di/empty-index :datahike.index/persistent-set [_index-name store index-type _]
+  (let [^PersistentSortedSet pset (psset/sorted-set* {:cmp (index-type->cmp-quick index-type false)
+                                                      :storage (:storage store)
+                                                      :branching-factor DEFAULT_BRANCHING_FACTOR})]
+    (with-meta pset
+      {:index-type index-type})))
+
+(defmethod di/init-index :datahike.index/persistent-set [_index-name store datoms index-type _ {:keys [indexed]}]
+  (let [arr (if (= index-type :avet)
+              (->> datoms
+                   (filter #(contains? indexed (.-a ^Datom %)))
+                   to-array)
+              (cond-> datoms
+                (not (arrays/array? datoms))
+                (arrays/into-array)))
+        _ (arrays/asort arr (index-type->cmp-quick index-type false))
+        ^PersistentSortedSet pset (psset/from-sorted-array (index-type->cmp-quick index-type false)
+                                                           arr
+                                                           (arrays/alength arr)
+                                                           {:branching-factor DEFAULT_BRANCHING_FACTOR})]
+    (set! (.-_storage pset) (:storage store))
+    (with-meta pset
+      {:index-type index-type})))
+
+;; temporary import from psset until public
+(defn- map->settings ^Settings [m]
+  #?(:cljs m
+     :clj (Settings.
+           (int (or (:branching-factor m) 0))
+           nil                                             ;; weak ref default
+           )))
+
+(defmethod di/add-konserve-handlers :datahike.index/persistent-set [config store]
+  ;; Check if store has pre-configured handlers (e.g., LMDB with buffer encoder).
+  ;; If so, the store will have :storage-atom that handlers close over.
+  (if-let [storage-atom (:storage-atom store)]
+    ;; Non-fressian store - handlers already configured, just create storage
+    (let [storage (or (:storage store)
+                      (create-storage store config))]
+      (reset! storage-atom storage)
+      (assoc store :storage storage))
+
+    ;; Standard fressian store - set up serializers
+    ;; deal with circular reference between storage and store
+    (let [settings (map->settings {:branching-factor DEFAULT_BRANCHING_FACTOR})
+          storage (atom nil)
+          store
+          (k/assoc-serializers
+           store
+           {:FressianSerializer (fressian-serializer
+
+                               ;; read handlers
+                                 {"datahike.index.PersistentSortedSet"
+                                  #?(:clj
+                                     (reify ReadHandler
+                                       (read [_ reader _tag _component-count]
+                                         (let [{:keys [meta address count]} (.readObject reader)
+                                               cmp                          (index-type->cmp-quick (:index-type meta) false)]
+                                         ;; The following fields are reset as they cannot be accessed from outside:
+                                         ;; - 'edit' is set to false, i.e. the set is assumed to be persistent, not transient
+                                         ;; - 'version' is set back to 0
+                                           (PersistentSortedSet. meta cmp address @storage nil count settings 0))))
+                                     :cljs
+                                     (fn [reader _tag _component-count]
+                                       (let [{:keys [meta address count]} (fress/read-object reader)
+                                             cmp                          (index-type->cmp-quick (:index-type meta) false)]
+                                       ;; CLJS BTSet deftype: [root cnt comparator meta _hash storage address settings]
+                                         (BTSet. nil count cmp meta nil @storage address settings))))
+                                  "datahike.index.PersistentSortedSet.Leaf"
+                                  #?(:clj
+                                     (reify ReadHandler
+                                       (read [_ reader _tag _component-count]
+                                         (let [{:keys [keys _level]} (.readObject reader)]
+                                           (Leaf. ^List keys settings))))
+                                     :cljs
+                                     (fn [reader _tag _component-count]
+                                       (let [{:keys [keys _level]} (fress/read-object reader)]
+                                       ;; CLJS Leaf deftype: [keys settings _measure]
+                                         (Leaf. (clj->js keys) settings nil))))
+                                  "datahike.index.PersistentSortedSet.Branch"
+                                  #?(:clj
+                                     (reify ReadHandler
+                                       (read [_ reader _tag _component-count]
+                                         (let [{:keys [keys level addresses subtree-count]} (.readObject reader)]
+                                           (Branch. (int level) (count keys) (into-array Object keys) (into-array Object (seq addresses)) nil (long (or subtree-count -1)) settings))))
+                                     :cljs
+                                     (fn [reader _tag _component-count]
+                                       (let [{:keys [keys level addresses subtree-count]} (fress/read-object reader)]
+                                       ;; CLJS Branch deftype: [level keys children addresses subtree-count _measure settings]
+                                         (Branch. (int level) (clj->js keys) nil (clj->js addresses) (or subtree-count -1) nil settings))))
+                                  "datahike.datom.Datom"
+                                  #?(:clj
+                                     (reify ReadHandler
+                                       (read [_ reader _tag _component-count]
+                                         (dd/datom-from-reader (.readObject reader))))
+                                     :cljs
+                                     (fn [reader _tag _component-count]
+                                       (dd/datom-from-reader (fress/read-object reader))))}
+
+                               ;; write handlers
+                               ;; CLJ format: nested {Type {"tag" handler}} for clojure.data.fressian
+                               ;; CLJS format: flat {Type handler-fn} for fress library
+                                 #?(:clj
+                                    {org.replikativ.persistent_sorted_set.PersistentSortedSet
+                                     {"datahike.index.PersistentSortedSet"
+                                      (reify WriteHandler
+                                        (write [_ writer pset]
+                                          (when (nil? (.-_address ^PersistentSortedSet pset))
+                                            (dt/raise "Must be flushed." {:type :must-be-flushed
+                                                                          :pset pset}))
+                                          (.writeTag writer "datahike.index.PersistentSortedSet" 1)
+                                          (.writeObject writer {:meta    (meta pset)
+                                                                :address (.-_address ^PersistentSortedSet pset)
+                                                                :count   (count pset)})))}
+
+                                     org.replikativ.persistent_sorted_set.Leaf
+                                     {"datahike.index.PersistentSortedSet.Leaf"
+                                      (reify WriteHandler
+                                        (write [_ writer leaf]
+                                          (.writeTag writer "datahike.index.PersistentSortedSet.Leaf" 1)
+                                          (.writeObject writer {:level (.level ^Leaf leaf)
+                                                                :keys  (.keys ^Leaf leaf)})))}
+
+                                     org.replikativ.persistent_sorted_set.Branch
+                                     {"datahike.index.PersistentSortedSet.Branch"
+                                      (reify WriteHandler
+                                        (write [_ writer node]
+                                          (.writeTag writer "datahike.index.PersistentSortedSet.Branch" 1)
+                                          (.writeObject writer {:level     (.level ^Branch node)
+                                                                :keys      (.keys ^Branch node)
+                                                                :addresses (.addresses ^Branch node)
+                                                                :subtree-count (.subtreeCount ^Branch node)})))}
+
+                                     datahike.datom.Datom
+                                     {"datahike.datom.Datom"
+                                      (reify WriteHandler
+                                        (write [_ writer datom]
+                                          (.writeTag writer "datahike.datom.Datom" 1)
+                                          (.writeObject writer (vec (seq ^Datom datom)))))}}
+
+                                    :cljs
+                                    {BTSet
+                                     (fn [writer pset]
+                                       (when (nil? (.-address ^BTSet pset))
+                                         (dt/raise "Must be flushed." {:type :must-be-flushed
+                                                                       :pset pset}))
+                                       (fress/write-tag writer "datahike.index.PersistentSortedSet" 1)
+                                       (fress/write-object writer {:meta    (meta pset)
+                                                                   :address (.-address ^BTSet pset)
+                                                                   :count   (count pset)}))
+
+                                     Leaf
+                                     (fn [writer leaf]
+                                       (fress/write-tag writer "datahike.index.PersistentSortedSet.Leaf" 1)
+                                       (fress/write-object writer {:level 0 ;; not supported in cljs
+                                                                   :keys  (vec (.-keys ^Leaf leaf))}))
+
+                                     Branch
+                                     (fn [writer node]
+                                       (fress/write-tag writer "datahike.index.PersistentSortedSet.Branch" 1)
+                                       (fress/write-object writer {:level     (.-level ^Branch node)
+                                                                   :keys      (vec (.-keys ^Branch node))
+                                                                   :addresses (vec (.-addresses ^Branch node))
+                                                                   :subtree-count (.-subtree-count ^Branch node)}))
+
+                                     datahike.datom.Datom
+                                     (fn [writer datom]
+                                       (fress/write-tag writer "datahike.datom.Datom" 1)
+                                       (fress/write-object writer (vec (seq ^Datom datom))))}))})]
+      (reset! storage (or (:storage store)
+                          (create-storage store config)))
+      (assoc store :storage @storage))))
+
+(defmethod di/konserve-backend :datahike.index/persistent-set [_index-name store]
+  store)
+
+(defmethod di/default-index-config :datahike.index/persistent-set [_index-name]
+  {})

package/src/datahike/index/utils.cljc

@@ -0,0 +1,44 @@
+(ns datahike.index.utils
+  (:require [datahike.constants :refer [e0 tx0 emax txmax]]
+            [datahike.datom :as dd])
+  #?(:clj (:import [datahike.datom Datom])))
+
+(defn datom-to-vec [^Datom datom index-type start?]
+  (let [e (fn [^Datom datom] (when-not (or (and start? (= e0 (.-e datom)))
+                                           (and (not start?) (= emax (.-e datom))))
+                               (.-e datom)))
+        tx (fn [^Datom datom] (when-not (or (and start? (= tx0 (.-tx datom)))
+                                            (and (not start?) (= txmax (.-tx datom))))
+                                (.-tx datom)))
+        datom-seq (case index-type
+                    :aevt (list (.-a datom) (e datom) (.-v datom) (tx datom))
+                    :avet (list (.-a datom) (.-v datom) (e datom) (tx datom))
+                    (list (e datom) (.-a datom) (.-v datom) (tx datom)))]
+    (->> datom-seq
+         (take-while some?)
+         vec)))
+
+(defn- slice-datom-compare [cmp]
+  (fn [v1 v2] (-> (filter #(not (= % 0)) (map cmp v1 v2))
+                  first
+                  (or 0))))
+
+(defn prefix-scan [cmp [e f g h]]
+  (let [datom-vec-compare (slice-datom-compare cmp)]
+    (fn [[i j k l]]
+      (< (cond (and e f g h)  (datom-vec-compare [i j k l] [e f g h])
+               (and e f g)    (datom-vec-compare [i j k] [e f g])
+               (and e f)      (datom-vec-compare [i j] [e f])
+               e              (cmp i e)
+               :else          0)
+         1))))
+
+(defn equals-on-indices?
+  "Returns true if 'k1' and 'k2' have the same value at positions indicated by 'indices'"
+  [k1, k2, indices]
+  (reduce (fn [_ i]
+            (if (= (nth k1 i) (nth k2 i))
+              true
+              (reduced false)))
+          true
+          indices))

package/src/datahike/index.cljc

@@ -0,0 +1,32 @@
+(ns ^:no-doc datahike.index
+  (:refer-clojure :exclude [-persistent! -flush -count -seq])
+  (:require [datahike.index.interface :as di]
+            [datahike.index.persistent-set]))
+
+;; Aliases for protocol functions
+
+(def -all di/-all)
+(def -seq di/-seq)
+(def -count di/-count)
+(def -insert di/-insert)
+(def -temporal-insert di/-temporal-insert)
+(def -upsert di/-upsert)
+(def -temporal-upsert di/-temporal-upsert)
+(def -remove di/-remove)
+(def -slice di/-slice)
+(def -flush di/-flush)
+(def -transient di/-transient)
+(def -persistent! di/-persistent!)
+(def -mark di/-mark)
+
+;; Aliases for multimethods
+
+(def empty-index di/empty-index)
+(def init-index di/init-index)
+(def add-konserve-handlers di/add-konserve-handlers)
+(def konserve-backend di/konserve-backend)
+(def default-index-config di/default-index-config)
+
+;; Other functions
+
+(def index-types (keys (methods empty-index)))