Cache partition map and update materialized partition view once. Fixes #47.

This caches a partition map per DB, which is helpful because it exposes
what the point in time DB partition state is, but is unhelpful because
the partition state can advance underneath the DB cache.  This is
generally true of the approach -- this can happen to the ident/entid
maps, and the datoms themselves -- so we'll roll with it for now.

This reduces the number of SQL UPDATE operations from linear in the
number of id-literals used to constant in the number of known
partitions.

src/datomish/db.cljc

@@ -88,6 +88,10 @@
     [db eid]
     "Returns the keyword associated with an id, or the key itself if passed.")
 
+  (part-map
+    [db]
+    "Return the partition map of this database, like {:db.part/user {:start 0x100 :idx 0x101}, ...}.")
+
   (in-transaction!
     [db chan-fn]
     "Evaluate the given pair-chan `chan-fn` in an exclusive transaction. If it returns non-nil,
@@ -113,10 +117,9 @@
     [db fragment merge]
     "Apply added schema fragment to the store, using `merge` as a `merge-with` function.")
 
-  (<next-eid
+  (<apply-db-part-map
-    [db id-literal]
+    [db part-map]
-    "Return a unique integer for the given id-literal, accounting for the literal's partition.  The
+    "Apply updated partition map."))
-    returned integer should never be returned again."))
 
 (defn db? [x]
   (and (satisfies? IDB x)
@@ -495,14 +498,17 @@
                    ;; We index on tx, so the following is fast.
                    ["SELECT * FROM transactions WHERE tx = ?" tx])))))))
 
-(defrecord DB [sqlite-connection schema ident-map]
+(defrecord DB [sqlite-connection schema ident-map part-map]
   ;; ident-map maps between keyword idents and integer entids.  The set of idents and entids is
   ;; disjoint, so we represent both directions of the mapping in the same map for simplicity.  Also
   ;; for simplicity, we assume that an entid has at most one associated ident, and vice-versa.  See
   ;; http://docs.datomic.com/identity.html#idents.
+  ;;
+  ;; The partition-map part-map looks like {:db.part/user {:start 0x100 :idx 0x101}, ...}.  It maps
+  ;; between keyword ident part names and integer ranges, where start is the beginning of the
+  ;; range (for future use to help identify which partition entids lie in, and idx is the current
+  ;; maximum entid in the partition.
 
-  ;; TODO: cache parts.  parts looks like {:db.part/db {:start 0 :current 10}}.  It maps between
-  ;; keyword ident part names and integer ranges.
   IDB
   (query-context [db] (context/make-context (datoms-source db)))
 
@@ -518,6 +524,9 @@
       (get (.-ident-map db) eid eid)
       eid))
 
+  (part-map [db]
+    (:part-map db))
+
   (in-transaction! [db chan-fn]
     (s/in-transaction!
       (:sqlite-connection db) chan-fn))
@@ -551,27 +560,27 @@
           <?
           yield-datom))))
 
-  (<next-eid [db tempid]
-    {:pre [(id-literal? tempid)]}
-    {:post [ds/entid?]}
-    (go-pair
-      ;; TODO: keep all of these eid allocations in the transaction report and apply them at the end
-      ;; of the transaction.
-      (let [exec (partial s/execute! (:sqlite-connection db))
-            part (entid db (:part tempid))]
-        (when-not (ds/entid? part) ;; TODO: cache parts materialized view.
-          (raise "Cannot allocate entid for id-literal " tempid " because part " (:part tempid) " is not known"
-                 {:error :db/bad-part
-                  :part (:part tempid)}))
-
-        (p :next-eid-body
-           (<? (exec ["UPDATE parts SET idx = idx + 1 WHERE part = ?" part]))
-        (:eid (first (<? (s/all-rows (:sqlite-connection db) ["SELECT (start + idx) AS eid FROM parts WHERE part = ?" part]))))))))
-
   (<apply-entities [db tx entities]
     {:pre [(db? db) (sequential? entities)]}
     (-<apply-entities db tx entities))
 
+  (<apply-db-part-map [db part-map]
+    (go-pair
+      (let [exec (partial s/execute! (:sqlite-connection db))]
+        (let [pairs (mapcat (fn [[part {:keys [start idx]}]]
+                              (when-not (= idx (get-in db [:part-map part :idx]))
+                                [(sqlite-schema/->SQLite part) idx]))
+                            part-map)]
+          ;; TODO: chunk into 999/2 sections, for safety.
+          (when-not (empty? pairs)
+            (<?
+              (exec
+                (cons (apply str "UPDATE parts SET idx = CASE"
+                             (concat
+                               (repeat (count pairs) " WHEN part = ? THEN ?")
+                               [" ELSE idx END"]))
+                      pairs))))))
+      (assoc db :part-map part-map)))
 
   (<apply-db-ident-assertions [db added-idents merge]
     (go-pair
@@ -612,9 +621,11 @@
 (defn with-ident [db ident entid]
   (update db :ident-map #(assoc % ident entid, entid ident)))
 
-(defn db [sqlite-connection idents schema]
+(defn db [sqlite-connection idents parts schema]
   {:pre [(map? idents)
          (every? keyword? (keys idents))
+         (map? parts)
+         (every? keyword? (keys parts))
          (map? schema)
          (every? keyword? (keys schema))]}
   (let [entid-schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) schema))) ;; TODO: fail if ident missing.
@@ -622,9 +633,9 @@
     (map->DB
       {:sqlite-connection sqlite-connection
        :ident-map         ident-map
+       :part-map          parts
        :symbolic-schema   schema
        :schema            entid-schema
-       ;; TODO :parts
        })))
 
 ;; TODO: factor this into the overall design.

src/datomish/db_factory.cljc

@@ -34,6 +34,17 @@
                      (s/all-rows sqlite-connection)))]
       (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:ident row)) (:entid row)])) rows))))
 
+(defn <parts [sqlite-connection]
+  "Read the parts map materialized view from the given SQLite store.
+  Returns a map (keyword part) -> {:start integer :idx integer}, like {:db.part/user {start: 0x100 idx: 0x101}}."
+
+  (go-pair
+    (let [rows (<? (->>
+                     {:select [:part :start :idx] :from [:parts]}
+                     (s/format)
+                     (s/all-rows sqlite-connection)))]
+      (into {} (map (fn [row] [(sqlite-schema/<-SQLite :db.type/keyword (:part row)) (select-keys row [:start :idx])])) rows))))
+
 (defn <symbolic-schema [sqlite-connection]
   "Read the schema map materialized view from the given SQLite store.
   Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like
@@ -72,7 +83,7 @@
     (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
       (raise "Could not ensure current SQLite schema version."))
 
-    (let [db            (db/db sqlite-connection bootstrap/idents bootstrap/symbolic-schema)
+    (let [db            (db/db sqlite-connection bootstrap/idents bootstrap/parts bootstrap/symbolic-schema)
           bootstrapped? (<? (db/<bootstrapped? db))]
       (when-not bootstrapped?
         ;; We need to bootstrap the DB.
@@ -84,40 +95,48 @@
                                                (raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
                                                       {:error :schema/alter-schema :old old :new new})
                                                new))]
-          (do
+          (let [exec (partial s/execute! (:sqlite-connection db))
-            (let [exec (partial s/execute! (:sqlite-connection db))]
+                part->vector (fn [[part {:keys [start idx]}]]
-              ;; TODO: allow inserting new parts.
+                               (println "part->vector" part start idx)
-              ;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
+                               [(sqlite-schema/->SQLite part) start idx])]
-              (<? (exec
+            ;; TODO: allow inserting new parts.
-                    ["INSERT INTO parts VALUES (?, ?, ?)" (db/entid db :db.part/db) 0x0 (inc (apply max (vals bootstrap/idents)))]))
+            ;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
-              (<? (exec
+            ;; TODO: install these using bootstrap assertions.  It's tricky because the part ranges are implicit.
-                    ["INSERT INTO parts VALUES (?, ?, ?)" (db/entid db :db.part/user) 0x10000 0]))
+            ;; TODO: chunk into 999/3 sections, for safety.
-              (<? (exec
+            (<? (exec
-                    ["INSERT INTO parts VALUES (?, ?, ?)" (db/entid db :db.part/tx) 0x10000000 0])))
+                  (cons (str "INSERT INTO parts VALUES "
-            (-> db
+                             (apply str (interpose ", " (repeat (count bootstrap/parts) "(?, ?, ?)"))))
-                ;; We use <with-internal rather than <transact! to apply the bootstrap transaction
+                        (mapcat part->vector bootstrap/parts)))))
-                ;; data but to not follow the regular schema application process.  We can't apply the
+
-                ;; schema changes, since the applied datoms would conflict with the bootstrapping
+          (-> db
-                ;; idents and schema.  (The bootstrapping idents and schema are required to be able to
+              ;; We use <with-internal rather than <transact! to apply the bootstrap transaction
-                ;; write to the database conveniently; without them, we'd have to manually write
+              ;; data but to not follow the regular schema application process.  We can't apply the
-                ;; datoms to the store.  It's feasible but awkward.)  After bootstrapping, we read
+              ;; schema changes, since the applied datoms would conflict with the bootstrapping
-                ;; back the idents and schema, just like when we re-open.
+              ;; idents and schema.  (The bootstrapping idents and schema are required to be able to
-                (transact/<with-internal (bootstrap/tx-data) fail-alter-ident fail-alter-attr)
+              ;; write to the database conveniently; without them, we'd have to manually write
-                (<?)))))
+              ;; datoms to the store.  It's feasible but awkward.)  After bootstrapping, we read
+              ;; back the idents and schema, just like when we re-open.
+              (transact/<with-internal (bootstrap/tx-data) fail-alter-ident fail-alter-attr)
+              (<?))))
 
       ;; We just bootstrapped, or we are returning to an already bootstrapped DB.
       (let [idents          (<? (<idents sqlite-connection))
+            parts           (<? (<parts sqlite-connection))
             symbolic-schema (<? (<symbolic-schema sqlite-connection))]
         (when-not bootstrapped?
-          ;; TODO: parts.
           (when (not (= idents bootstrap/idents))
             (raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
                    {:error :bootstrap/bad-idents,
                     :new   idents :old bootstrap/idents
                     }))
+          (when (not (= (dissoc parts :db.part/tx) (dissoc bootstrap/parts :db.part/tx))) ;; TODO: work around tx allocation.
+            (raise "After bootstrapping database, expected new materialized parts and old bootstrapped parts to be identical (outside of db.part/tx)"
+                   {:error :bootstrap/bad-parts,
+                    :new   (dissoc parts :db.part/tx) :old (dissoc bootstrap/parts :db.part/tx)
+                    }))
           (when (not (= symbolic-schema bootstrap/symbolic-schema))
             (raise "After bootstrapping database, expected new materialized symbolic schema and old bootstrapped symbolic schema to be identical"
                    {:error :bootstrap/bad-symbolic-schema,
                     :new   symbolic-schema :old bootstrap/symbolic-schema
                     })))
-        (db/db sqlite-connection idents symbolic-schema)))))
+        (db/db sqlite-connection idents parts symbolic-schema)))))

src/datomish/sqlite_schema.cljc

@@ -112,7 +112,7 @@
    ;; TODO: allow arbitrary schema values (true/false) and tag the resulting values.
    "CREATE TABLE schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value TEXT NOT NULL, FOREIGN KEY (ident) REFERENCES idents (ident))"
    "CREATE INDEX idx_schema_unique ON schema (ident, attr, value)"
-   "CREATE TABLE parts (part INTEGER NOT NULL PRIMARY KEY, start INTEGER NOT NULL, idx INTEGER NOT NULL)"
+   "CREATE TABLE parts (part TEXT NOT NULL PRIMARY KEY, start INTEGER NOT NULL, idx INTEGER NOT NULL)"
    ])
 
 (defn <create-current-version

src/datomish/transact.cljc

@@ -64,6 +64,7 @@
                      entities  ;; The set of entities (like [:db/add e a v tx]) processed.
                      tx-data   ;; The set of datoms applied to the database, like (Datom. e a v tx added).
                      tempids   ;; The map from id-literal -> numeric entid.
+                     part-map  ;; Map {:db.part/user {:start 0x10000 :idx 0x10000}, ...}.
                      added-parts ;; The set of parts added during the transaction via :db.part/db :db.install/part.
                      added-idents ;; The map of idents -> entid added during the transaction, via e :db/ident ident.
                      added-attributes ;; The map of schema attributes (ident -> schema fragment) added during the transaction, via :db.part/db :db.install/attribute.
@@ -72,11 +73,19 @@
 (defn- report? [x]
   (and (instance? TxReport x)))
 
-(defonce -eid (atom (- 0x200 1)))
+(defn- -next-eid! [part-map-atom tempid]
-
+  "Advance {:db.part/user {:start 0x10 :idx 0x11}, ...} to {:db.part/user {:start 0x10 :idx 0x12}, ...} and return 0x12."
-;; TODO: better here.
+  {:pre [(id-literal? tempid)]}
-(defn- next-eid [db]
+  (let [part (:part tempid)
-  (swap! -eid inc))
+        next (fn [part-map]
+               (let [idx (get-in part-map [part :idx])]
+                 (when-not idx
+                   (raise "Cannot allocate entid for id-literal " tempid " because part " part " is not known"
+                          {:error :db/bad-part
+                           :parts (sorted-set (keys part-map))
+                           :part  part}))
+                 (update-in part-map [part :idx] inc)))]
+    (get-in (swap! part-map-atom next) [part :idx])))
 
 (defn- allocate-eid
   [report id-literal eid]
@@ -327,22 +336,22 @@
                   allocated-eid (get-in report [:tempids e])]
               (if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
                 (<? (<retry-with-tempid db initial-report initial-entities e upserted-eid)) ;; TODO: not initial report, just the sorted entities here.
-                (let [eid (or upserted-eid allocated-eid (<? (db/<next-eid db e)))]
+                (let [eid (or upserted-eid allocated-eid (-next-eid! (:part-map-atom report) e))]
                   (recur (allocate-eid report e eid) (cons [op eid a v] entities)))))
 
             ;; Start allocating and retrying.  We try with e last, so as to eventually upsert it.
             (id-literal? v)
             ;; We can't fail with unbound literals here, since we could have multiple.
-            (let [eid (or (get-in report [:tempids v]) (<? (db/<next-eid db e)))]
+            (let [eid (or (get-in report [:tempids v]) (-next-eid! (:part-map-atom report) e))]
               (recur (allocate-eid report v eid) (cons [op e a eid] entities)))
 
             (id-literal? a)
             ;; TODO: should we even allow id-literal attributes?  Datomic fails in some cases here.
-            (let [eid (or (get-in report [:tempids a]) (<? (db/<next-eid db e)))]
+            (let [eid (or (get-in report [:tempids a]) (-next-eid! (:part-map-atom report) e))]
               (recur (allocate-eid report a eid) (cons [op e eid v] entities)))
 
             (id-literal? e)
-            (let [eid (or (get-in report [:tempids e]) (<? (db/<next-eid db e)))]
+            (let [eid (or (get-in report [:tempids e]) (-next-eid! (:part-map-atom report) e))]
               (recur (allocate-eid report e eid) (cons [op eid a v] entities)))
 
             true
@@ -453,22 +462,29 @@
 ;; TODO: expose this in a more appropriate way.
 (defn <with-internal [db tx-data merge-ident merge-attr]
   (go-pair
-    (let [report (->>
+    (let [part-map-atom
+          (atom (db/part-map db))
+
+          tx
+          (-next-eid! part-map-atom (id-literal :db.part/tx))
+
+          report (->>
                    (map->TxReport
-                     {:db-before         db
+                     {:db-before        db
-                      :db-after          db
+                      :db-after         db
                       ;; This mimics DataScript.  It's convenient to be able to extract the
                       ;; transaction ID and transaction timestamp directly from the report; Datomic
                       ;; makes this surprisingly difficult: one needs a :db.part/tx temporary and an
                       ;; explicit upsert of that temporary.
-                      :tx                (<? (db/<next-eid db (id-literal :db.part/tx)))
+                      :part-map-atom    part-map-atom
-                      :txInstant         (db/now db)
+                      :tx               tx
-                      :entities          tx-data
+                      :txInstant        (db/now db)
-                      :tx-data           []
+                      :entities         tx-data
-                      :tempids           {}
+                      :tx-data          []
-                      :added-parts       {}
+                      :tempids          {}
-                      :added-idents      {}
+                      :added-parts      {}
-                      :added-attributes  {}
+                      :added-idents     {}
+                      :added-attributes {}
                       })
 
                    (<transact-tx-data db)
@@ -484,6 +500,10 @@
           db-after (->
                      db
 
+                     (db/<apply-db-part-map @(:part-map-atom report))
+                     (<?)
+                     (->> (p :apply-db-part-changes))
+
                      (db/<apply-db-ident-assertions (:added-idents report) merge-ident)
                      (<?)
                      (->> (p :apply-db-ident-assertions))

src/datomish/transact/bootstrap.cljc

@@ -76,9 +76,16 @@
    :db/doc               35
    })
 
+(def parts
+  {:db.part/db   {:start 0 :idx (inc (apply max (vals idents)))}
+   :db.part/user {:start 0x10000 :idx 0x10000}
+   :db.part/tx   {:start 0x10000000 :idx 0x10000000}
+   })
+
 (defn tx-data []
   (concat
     (map (fn [[ident entid]] [:db/add entid :db/ident ident]) idents)
+    ;; TODO: install partitions as well, like (map (fn [[ident entid]] [:db/add :db.part/db :db.install/partition ident])).
     (map (fn [[ident attrs]] (assoc attrs :db/id ident)) symbolic-schema)
     (map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get idents ident)]) symbolic-schema) ;; TODO: fail if nil.
     ))