From 82f8bf61e1ded0488334ca4a4b859e969cac100f Mon Sep 17 00:00:00 2001
From: Estevan Castilho <tevo@riajuu.net>
Date: Sat, 19 Sep 2026 03:42:12 +0000
Subject: Associative collections on top of prolly trees

---
 lib/kernel/Prototype.ml | 34 +++++++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

(limited to 'lib/kernel/Prototype.ml')

diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
index 9c1dcd2..8c12b40 100644
--- a/lib/kernel/Prototype.ml
+++ b/lib/kernel/Prototype.ml
@@ -6,6 +6,34 @@ let mixture ps = Protocols.Handle.make @@
                      method protocols = ps
                    end
 
+let rec mixture_of value f =
+  mixture (f (fun value' -> mixture_of value' f) value)
+
+module Associative = struct
+  module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) = struct
+    module Tree = Merkle.Make (S) (K)
+    module SI = Storage.Make (S)
+
+    let make ~storage ~constructor ~node =
+      Protocols.Associative.make @@
+        object
+          method update key value =
+            (* TODO: read-only transactions *)
+            SI.with_transaction storage (fun tx ->
+                let open Utilities.Result in
+                let open Protocols in
+                let* node' = match value with
+                  | None -> Tree.remove tx key node
+                  | Some h ->
+                     let* addressable = Handle.require Addressable.from h in
+                     let addr = Addressable.address addressable in
+                     Tree.insert tx key addr node
+                in
+                constructor node')
+        end
+  end
+end
+
 module Directory = struct
   let of_properties (props) =
     Protocols.Directory.make @@
@@ -17,14 +45,14 @@ module Directory = struct
       end
 
   module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) (V : Merkle.VALUE) = struct
-    module Interface = Merkle.Interface (S) (K) (V)
+    module Tree = Merkle.Interface (S) (K) (V)
     module SI = Storage.Make (S)
 
     let make ~storage ~constructor ~node =
       Protocols.Directory.make @@
         object
-          method list = SI.with_transaction storage (Fun.flip Interface.keys node)
-          method find k = SI.with_transaction storage (fun tx -> Interface.lookup tx k node)
+          method list = SI.with_transaction storage (Fun.flip Tree.keys node)
+          method find k = SI.with_transaction storage (fun tx -> Tree.lookup tx k node)
                           |> Utilities.Result.fmap (function
                                  | None -> Ok None
                                  | Some x -> constructor x |> Result.map (Option.some))
-- 
cgit v1.2.3