⚡ Bound the main side of a branch compare to the pages main moved

A page whose fragment id main shares with the branch's base holds the
same document on both sides, because a fragment row never changes after
it is written. The derive now hands back the fragment ids of the base
pages, and a comparison loads only the pages of main whose id differs:
the base's realized page stands in for every other page. The direction
that reports main's changes (the compare's main->branch and the reverse
pass of the diff counts) is bounded to those pages with :only-pages.

A base that was migrated, or that holds no pointers, gives no ids and
keeps the whole-file comparison. On a copy of the scaling corpus rung L7
(69 pages, 47,514 objects) the main->branch compare drops from 5,690 ms
to 1,965 ms and the branch->main compare from 3,254 ms to 1,981 ms; what
remains is the branch derive, which still realizes the whole base.

The compare's size gate now runs after the derive, because main's
document is assembled from the base. The depth gate still runs before
it, and the base passed the size gate when it was written.

AI-assisted-by: claude-opus-5-5
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>

backend/src/app/binfile/common.clj

@@ -459,6 +459,10 @@
 
         base (fdata/resolve-file-data cfg base)
         base (fdata/decode-file-data cfg base)
+        ;; the fragment ids the base names, read before the realize
+        ;; drops them: a comparison skips every page main still shares
+        base-ids (fdata/get-page-pointer-ids (:data base))
+
         ;; the base shares the source file's fragments; past this point
         ;; the replay, the migrations and every caller see plain data
         base (realize-branch-base cfg base)
@@ -526,7 +530,11 @@
         (cond-> (some? (:migrations doc))
           (assoc :migrations (:migrations doc)))
         (cond-> include-base-data?
-          (assoc ::base-data base-data))
+          (assoc ::base-data base-data
+                 ;; a migrated base no longer holds what its fragments
+                 ;; hold, so its ids say nothing about main
+                 ::base-page-pointers (when (identical? base-data (:data base))
+                                        base-ids)))
         ;; the numbers travel with the value, because the RPC audit event
         ;; of the read that paid for this derive reads `::audit/props` off
         ;; the result metadata

backend/src/app/features/fdata.clj

@@ -378,6 +378,17 @@
        (into #{} (comp (filter pmap/pointer-map?)
                        (map pmap/get-id)))))
 
+(defn get-page-pointer-ids
+  "`{page-id fragment-id}` of every page of `fdata` held as a pointer. Two
+  documents whose page names the same fragment hold the same page,
+  because a fragment row never changes after it is written."
+  [fdata]
+  (into {}
+        (keep (fn [[page-id page]]
+                (when (pmap/pointer-map? page)
+                  [page-id (pmap/get-id page)])))
+        (:pages-index fdata)))
+
 (defn enable-pointer-map
   "Enable the fdata/pointer-map feature on the file."
   [file & _opts]

backend/src/app/rpc/commands/files_branch.clj

@@ -349,6 +349,41 @@
                     :hint "the branch file was read without `:include-base-data? true`"))
       (bm/remap-refs (branch-media-pairs cfg id source-file-id))))
 
+(defn- moved-pages
+  "The pages on which main can differ from a branch's base: every page
+  whose fragment main does not share with the base. Nil when fragment ids
+  cannot tell, because main or the base holds no pointers, which leaves
+  the whole-file comparison in place. `stored` is main's `:data` with its
+  pointers unrealized, and `base-ids` the `::bfc/base-page-pointers` of
+  the branch read."
+  [stored base-ids]
+  (when (seq base-ids)
+    (let [main-ids (fdata/get-page-pointer-ids stored)]
+      (when (seq main-ids)
+        (into #{}
+              (remove (fn [page-id]
+                        (let [id (get main-ids page-id)]
+                          (and (some? id) (= id (get base-ids page-id))))))
+              (into (set (keys (:pages-index stored))) (keys base-ids)))))))
+
+(defn- comparison-main
+  "Main realized for a comparison with a branch, and the pages main moved
+  since the branch's base (`moved-pages`). Only the moved pages load:
+  every other page holds the same document as the base's, so the base's
+  page, which the derive already realized, stands in for it. `base-data`
+  is the comparison's base, in main's id space."
+  [cfg source-file-id branch-file base-data]
+  (let [stored (bfc/get-file cfg source-file-id)
+        moved  (moved-pages (:data stored) (::bfc/base-page-pointers branch-file))
+        shared (fn [pages page-id page]
+                 (if (contains? moved page-id)
+                   (assoc pages page-id page)
+                   (assoc pages page-id (get-in base-data [:pages-index page-id]))))
+        stored (cond-> stored
+                 (some? moved)
+                 (update-in [:data :pages-index] #(reduce-kv shared {} %)))]
+    [(fdata/realize cfg stored) moved]))
+
 (defn- release-base-snapshot!
   "Reschedule a branch's base snapshot for normal deletion: it is pinned
   ~10 years while the branch is open, and must be released when the branch
@@ -704,9 +739,10 @@
   branches of the same source; otherwise it is loaded on demand.
 
   The forward pass is bounded to the pages the branch's op log touched
-  when that set is complete (`branch-affected-pages`); the reverse pass
-  reports MAIN's changes and stays whole-file, because nothing here knows
-  what main touched.
+  when that set is complete (`branch-affected-pages`), and the reverse
+  pass, which reports MAIN's changes, to the pages whose fragment main no
+  longer shares with the base (`moved-pages`). Without a shared
+  `main-data`, main loads only those pages (`comparison-main`).
 
   Raises on failure instead of degrading: the caller decides whether the
   result is worth caching, and a value computed from an error must never
@@ -715,8 +751,7 @@
   (bp/with-policies
     (if (and (zero? ahead-revn) (zero? behind-revn))
       [0 0 0]
-      (let [main-data   (or main-data (:data (bfc/get-file cfg source-file-id :realize? true)))
-            ;; the derive hands back the merge base it replayed the log over,
+      (let [;; the derive hands back the merge base it replayed the log over,
             ;; so the comparison's `base` costs one decode of the snapshot
             ;; rather than two
             branch-file (bfc/get-file cfg branch-file-id :realize? true
@@ -725,6 +760,20 @@
                          (:data branch-file)
                          (branch-id-map cfg branch-file-id source-file-id))
             base-data   (branch-base-data cfg source-file-id branch-file)
+            base-ids    (::bfc/base-page-pointers branch-file)
+            [main-data moved]
+            (cond
+              (nil? main-data)
+              (let [[file moved] (comparison-main cfg source-file-id branch-file base-data)]
+                [(:data file) moved])
+
+              ;; the stored document is a handful of pointers, read only
+              ;; when the base holds pointers to compare them with
+              (seq base-ids)
+              [main-data (moved-pages (:data (bfc/get-file cfg source-file-id)) base-ids)]
+
+              :else
+              [main-data nil])
             clean-count (fn [m] (let [s (:stats m)]
                                   (+ (:added s) (:modified s) (:deleted s))))
             fwd (when (pos? ahead-revn)
@@ -732,7 +781,8 @@
                                     (when-let [pages (branch-affected-pages cfg branch-file-id)]
                                       {:only-pages pages})))
             bwd (when (pos? behind-revn)
-                  (bm/compute-merge base-data branch-data main-data :branch->main))]
+                  (bm/compute-merge base-data branch-data main-data :branch->main
+                                    (when moved {:only-pages moved})))]
         [(if fwd (clean-count fwd) 0)
          (if bwd (clean-count bwd) 0)
          ;; conflicts are symmetric; only possible when both sides diverged
@@ -917,19 +967,23 @@
 
       (let [tpoint      (ct/tpoint)
             dir         (or direction :branch->main)
-            main-file   (-> (bfc/get-file cfg (:source-file-id branch) :realize? true)
-                            (check-file-size-limits! :compare))
             _           (check-oplog-depth-limit! (bfc/get-branch-oplog-depth cfg (:branch-file-id branch))
                                                   (:branch-file-id branch)
                                                   :compare)
             log         (branch-log cfg (:branch-file-id branch))
             branch-file (bfc/get-file cfg (:branch-file-id branch)
                                       :realize? true :include-base-data? true)
+            base-data   (branch-base-data cfg (:source-file-id branch) branch-file)
+            ;; the size gate runs after the derive: main loads only the
+            ;; pages it moved since the base, so the base is needed first,
+            ;; and the derive's own cost is bounded by the gates the base
+            ;; passed when it was written
+            [main-file moved] (comparison-main cfg (:source-file-id branch) branch-file base-data)
+            _           (check-file-size-limits! main-file :compare)
             main-data   (:data main-file)
             branch-data (bm/remap-refs
                          (:data branch-file)
                          (branch-id-map cfg (:branch-file-id branch) (:source-file-id branch)))
-            base-data   (branch-base-data cfg (:source-file-id branch) branch-file)
             ;; when the CURRENT merge-base snapshot row was created: the
             ;; base moves whenever `update-branch-from-main` repositions it,
             ;; and a pinned base carries a future `deleted-at`
@@ -937,12 +991,15 @@
                                               {:id (:base-snapshot-id branch)}
                                               {::sql/columns [:created-at]
                                                ::db/remove-deleted false}))
-            ;; only the branch->main direction may be bounded to the pages
-            ;; the branch touched: the other direction is main's changes and
-            ;; nothing here knows which pages those are
-            opts        (when (= dir :branch->main)
+            ;; each direction is bounded to the pages the side it reports
+            ;; can have changed: the branch's to the pages its log
+            ;; touched, main's to the pages whose fragment it no longer
+            ;; shares with the base
+            opts        (if (= dir :branch->main)
                           (when-let [pages (affected-pages log)]
-                            {:only-pages pages}))]
+                            {:only-pages pages})
+                          (when moved
+                            {:only-pages moved}))]
         ;; `:meta` carries the "when" of each side so the resolution UI can show
         ;; how recent main/branch are (base is the snapshot its
         ;; `base-snapshot-id` currently points at), plus

backend/test/backend_tests/branch_pointer_base_test.clj

@@ -13,10 +13,12 @@
   (:require
    [app.binfile.common :as bfc]
    [app.common.features :as cfeat]
+   [app.common.files.branch-merge :as bm]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.features.fdata :as fdata]
    [app.features.file-snapshots :as fsnap]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files-branch :as fbranch]
@@ -223,3 +225,60 @@
         ;; the merged page is new, the untouched one keeps its fragment
         (t/is (not= (get before page-a) (get after page-a)))
         (t/is (= (get before page-b) (get after page-b)))))))
+
+(defn- rename-shape
+  [page-id shape-id name]
+  {:type :mod-obj
+   :page-id page-id
+   :id shape-id
+   :operations [{:type :set :attr :name :val name}]})
+
+(defn- eager-compare
+  "The comparison with every page of every side realized and no bound."
+  [file-id branch-file-id dir]
+  (db/run! th/*system*
+           (fn [cfg]
+             (let [main   (:data (bfc/get-file cfg file-id :realize? true))
+                   bfile  (bfc/get-file cfg branch-file-id :realize? true :include-base-data? true)
+                   base   (#'fbranch/branch-base-data cfg file-id bfile)
+                   branch (bm/remap-refs (:data bfile)
+                                         (#'fbranch/branch-id-map cfg branch-file-id file-id))]
+               (bm/compute-merge base main branch dir)))))
+
+(t/deftest compare-loads-only-the-pages-main-moved
+  (with-redefs [cf/flags (conj cf/flags :branching)]
+    (let [{:keys [profile-id file-id]} (setup)
+          page-a  (first (:pages (realized-data file-id)))
+          others  (vec (repeatedly 5 uuid/random))
+          rect    (add-rect page-a)
+          shape   (:id rect)
+          _       (update-file! profile-id file-id
+                                (into [rect]
+                                      (map (fn [id] {:type :add-page :id id :name (str id)}))
+                                      others))
+          branch  (create-branch! profile-id file-id "lazy")
+          bfid    (:branch-file-id branch)
+          page-b  (first others)]
+      ;; the branch renames the shape main renames too, a conflict on
+      ;; page A, and adds a shape; main also adds a shape on page B, so
+      ;; main moved two of six pages
+      (update-file! profile-id bfid [(rename-shape page-a shape "branch") (add-rect page-a)])
+      (update-file! profile-id file-id [(rename-shape page-a shape "main") (add-rect page-b)])
+
+      (doseq [dir [:branch->main :main->branch]]
+        (let [loads (atom 0)
+              load  fdata/load-pointer
+              out   (with-redefs [fdata/load-pointer (fn [& args] (swap! loads inc) (apply load args))]
+                      (th/command! {::th/type :get-branch-diff
+                                    ::rpc/profile-id profile-id
+                                    :branch-id (:id branch)
+                                    :direction dir}))
+              eager (eager-compare file-id bfid dir)]
+          (t/is (nil? (:error out)))
+          (t/testing (str dir " gives the summary of the whole-file comparison")
+            (t/is (= (:stats eager) (:stats (:result out))))
+            (t/is (= (:changes eager) (:changes (:result out))))
+            (t/is (= (:conflicts eager) (:conflicts (:result out))))
+            (t/is (= 1 (count (:conflicts eager)))))
+          (t/testing (str dir " loads the base's six pages and main's two moved ones")
+            (t/is (= 8 @loads))))))))