Branching and naïve merge strategies

* AGPL license

* branching and merging

* Delete LICENSE in favor of separate PR

Signed-off-by: Marcos Magueta <maguetamarcos@gmail.com>

* add unmonitored tests and docs

---------

Signed-off-by: Marcos Magueta <maguetamarcos@gmail.com>

11 files changed, 617 insertions, 61 deletions

diff --git a/lib/dcl/ast.ml b/lib/dcl/ast.ml
index 95e0271..e1dae13 100644
--- a/lib/dcl/ast.ml
+++ b/lib/dcl/ast.ml
@@ -1,23 +1,13 @@
 open Sexplib.Std
 
-type binding_expr =
-  | Var of string
-  | Const of Drl.Ast.value  (** reuse DRL value for literals *)
-[@@deriving sexp]
-
-type constraint_body =
-  | MemberOf of { target: string; binding: (string * binding_expr) list }
-  | Not of { body: constraint_body; universe: string }
-  | And of constraint_body list
-  | Or of constraint_body list
-  | Exists of { variable: string; quantifier: string; body: constraint_body }
-  | Forall of { variable: string; quantifier: string; body: constraint_body }
+type merge_strategy = PreferLeft | PreferRight | RevertToAncestor
 [@@deriving sexp]
 
 type statement =
-  | RegisterConstraint of {
-      constraint_name: string;
-      relation_name: string;
-      body: constraint_body;
-    }
+  | CreateBranch of { name: string; hash: string option [@sexp.option] }
+  | Checkout of string
+  | GetHead
+  | GetBranchTip of string
+  | UpdateBranchTip of { name: string; hash: string }
+  | Merge of { left: string; right: string; strategy: merge_strategy }
 [@@deriving sexp]
diff --git a/lib/dcl/executor.ml b/lib/dcl/executor.ml
index 810781f..bf549ec 100644
--- a/lib/dcl/executor.ml
+++ b/lib/dcl/executor.ml
@@ -1,54 +1,94 @@
-module Make (Storage : Management.Physical.S) = struct
-  module Ops = Manipulation.Make(Storage)
+module Make (Storage : Management.Physical.S with type error = string) = struct
+  module Ops      = Manipulation.Make(Storage)
+  module Branch   = Management.Branch.Make(Storage)
+  module MergeOps = Management.Merge.Make(Storage)(Ops)
 
   type error =
-    | ManipulationError of Manipulation.error
-    | ConversionError of string
-
-  let wrap_manip = Result.map_error (fun e -> ManipulationError e)
-
-  (** Convert a DCL binding_expr to a runtime Constraint.binding_expr *)
-  let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = function
-    | Ast.Var name -> Constraint.Var name
-    | Ast.Const value -> Constraint.Const (Drl.Ast.value_to_abstract value)
-
-  (** Convert a list of (target_attr, binding_expr) pairs to a Constraint.binding (BindingMap) *)
-  let convert_binding (pairs : (string * Ast.binding_expr) list) : Constraint.binding =
-    List.fold_left
-      (fun acc (key, expr) ->
-        Constraint.BindingMap.add key (convert_binding_expr expr) acc)
-      Constraint.BindingMap.empty
-      pairs
-
-  (** Convert a DCL constraint_body AST to a runtime Constraint.t *)
-  let rec convert_body : Ast.constraint_body -> Constraint.t = function
-    | Ast.MemberOf { target; binding } ->
-      Constraint.MemberOf { target; binding = convert_binding binding }
-    | Ast.Not { body; universe } ->
-      Constraint.Not { body = convert_body body; universe }
-    | Ast.And bodies ->
-      Constraint.And (List.map convert_body bodies)
-    | Ast.Or bodies ->
-      Constraint.Or (List.map convert_body bodies)
-    | Ast.Exists { variable; quantifier; body } ->
-      Constraint.Exists { variable; quantifier; body = convert_body body }
-    | Ast.Forall { variable; quantifier; body } ->
-      Constraint.Forall { variable; quantifier; body = convert_body body }
+    | BranchError of string
+    | MergeError  of string
+
+  let convert_strategy : Ast.merge_strategy -> Management.Merge.strategy = function
+    | Ast.PreferLeft       -> Management.Merge.PreferLeft
+    | Ast.PreferRight      -> Management.Merge.PreferRight
+    | Ast.RevertToAncestor -> Management.Merge.RevertToAncestor
+
+  let manip_err = function
+    | Manipulation.RelationNotFound s      -> "RelationNotFound: " ^ s
+    | Manipulation.RelationAlreadyExists s -> "RelationAlreadyExists: " ^ s
+    | Manipulation.TupleNotFound h         -> "TupleNotFound: " ^ h
+    | Manipulation.DuplicateTuple h        -> "DuplicateTuple: " ^ h
+    | Manipulation.ConstraintViolation s   -> "ConstraintViolation: " ^ s
+    | Manipulation.StorageError s          -> "StorageError: " ^ s
 
   let execute
       (storage : Storage.t)
       (db : Management.Database.t)
       (stmt : Ast.statement)
-    : (Management.Database.t, error) result =
+    : (Management.Database.t * string, error) result =
     match stmt with
-    | Ast.RegisterConstraint { constraint_name; relation_name; body } ->
-      (* TODO: Additional constraint operations (drop constraint, list constraints,
-         validate existing tuples against new constraint) are not supported via DCL.
-         Use the OCaml API for these advanced operations. *)
-      let runtime_body = convert_body body in
-      Ops.register_constraint storage db
-        ~constraint_name ~relation_name ~body:runtime_body
-      |> wrap_manip
+
+    | Ast.CreateBranch { name; hash } ->
+      let tip = match hash with
+        | Some h -> h
+        | None   -> db.Management.Database.hash
+      in
+      (match Branch.create storage ~name ~tip with
+       | Error e -> Error (BranchError e)
+       | Ok ()   -> Ok (db, "Branch " ^ name ^ " created"))
+
+    | Ast.Checkout branch_name ->
+      (match Branch.get_tip storage branch_name with
+       | Error e       -> Error (BranchError e)
+       | Ok None       -> Error (BranchError ("Branch not found: " ^ branch_name))
+       | Ok (Some tip) ->
+         (match Branch.checkout storage branch_name with
+          | Error e -> Error (BranchError e)
+          | Ok ()   ->
+            (match Ops.load_database storage tip with
+             | Error e -> Error (BranchError (manip_err e))
+             | Ok None -> Error (BranchError ("No database at hash: " ^ tip))
+             | Ok (Some loaded_db) ->
+               Ok (loaded_db, "HEAD:" ^ branch_name))))
+
+    | Ast.GetHead ->
+      (match Branch.get_head storage with
+       | Error e        -> Error (BranchError e)
+       | Ok None        -> Ok (db, "HEAD is unset")
+       | Ok (Some name) -> Ok (db, "HEAD:" ^ name))
+
+    | Ast.GetBranchTip name ->
+      (match Branch.get_tip storage name with
+       | Error e        -> Error (BranchError e)
+       | Ok None        -> Error (BranchError ("Branch not found: " ^ name))
+       | Ok (Some hash) -> Ok (db, "branch:" ^ name ^ "=" ^ hash))
+
+    | Ast.UpdateBranchTip { name; hash } ->
+      (match Branch.update_tip storage ~name ~tip:hash with
+       | Error e -> Error (BranchError e)
+       | Ok ()   -> Ok (db, "Branch " ^ name ^ " updated"))
+
+    | Ast.Merge { left; right; strategy } ->
+      (match Branch.get_tip storage left, Branch.get_tip storage right with
+       | Error e, _ | _, Error e -> Error (BranchError e)
+       | Ok None, _  -> Error (BranchError ("Branch not found: " ^ left))
+       | _, Ok None  -> Error (BranchError ("Branch not found: " ^ right))
+       | Ok (Some left_tip), Ok (Some right_tip) ->
+         let strat = convert_strategy strategy in
+         (match MergeOps.merge ~storage ~strategy:strat ~left_tip ~right_tip with
+          | Error e -> Error (MergeError (manip_err e))
+          | Ok (Management.Merge.Failed conflicts) ->
+            let msgs = List.map (function
+              | Management.Merge.TupleConflict    { relation; hash } ->
+                "tuple conflict in " ^ relation ^ " (" ^ hash ^ ")"
+              | Management.Merge.SchemaConflict   r -> "schema conflict in " ^ r
+              | Management.Merge.ConstraintConflict r -> "constraint conflict in " ^ r
+            ) conflicts in
+            Error (MergeError ("Merge failed: " ^ String.concat "; " msgs))
+          | Ok (Management.Merge.Clean merged_db) ->
+            let _ = Branch.update_tip storage ~name:left
+                      ~tip:merged_db.Management.Database.hash in
+            Ok (merged_db,
+                "Merged:" ^ right ^ "→" ^ left)))
 end
 
 module Memory = Make(Management.Physical.Memory)
diff --git a/lib/dcl/parser.ml b/lib/dcl/parser.ml
index a7981c0..3caf748 100644
--- a/lib/dcl/parser.ml
+++ b/lib/dcl/parser.ml
@@ -1,7 +1,13 @@
 type error = ParseError of string
 
 let of_string s =
-  match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
+  (* ppx_sexp_conv encodes no-argument variants as bare atoms, so
+     unwrap a single-element list (e.g. (GetHead)) → atom (GetHead). *)
+  let sexp = match Sexplib.Sexp.of_string s with
+    | Sexplib.Sexp.List [atom] -> atom
+    | other -> other
+  in
+  match Ast.statement_of_sexp sexp with
   | stmt          -> Ok stmt
   | exception exn -> Error (ParseError (Printexc.to_string exn))
 
diff --git a/lib/icl/ast.ml b/lib/icl/ast.ml
new file mode 100644
index 0000000..95e0271
--- /dev/null
+++ b/lib/icl/ast.ml
@@ -0,0 +1,23 @@
+open Sexplib.Std
+
+type binding_expr =
+  | Var of string
+  | Const of Drl.Ast.value  (** reuse DRL value for literals *)
+[@@deriving sexp]
+
+type constraint_body =
+  | MemberOf of { target: string; binding: (string * binding_expr) list }
+  | Not of { body: constraint_body; universe: string }
+  | And of constraint_body list
+  | Or of constraint_body list
+  | Exists of { variable: string; quantifier: string; body: constraint_body }
+  | Forall of { variable: string; quantifier: string; body: constraint_body }
+[@@deriving sexp]
+
+type statement =
+  | RegisterConstraint of {
+      constraint_name: string;
+      relation_name: string;
+      body: constraint_body;
+    }
+[@@deriving sexp]
diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml
new file mode 100644
index 0000000..a895135
--- /dev/null
+++ b/lib/icl/executor.ml
@@ -0,0 +1,50 @@
+module Make (Storage : Management.Physical.S) = struct
+  module Ops = Manipulation.Make(Storage)
+
+  type error =
+    | ManipulationError of Manipulation.error
+    | ConversionError of string
+
+  let wrap_manip = Result.map_error (fun e -> ManipulationError e)
+
+  let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = function
+    | Ast.Var name -> Constraint.Var name
+    | Ast.Const value -> Constraint.Const (Drl.Ast.value_to_abstract value)
+
+  let convert_binding (pairs : (string * Ast.binding_expr) list) : Constraint.binding =
+    List.fold_left
+      (fun acc (key, expr) ->
+        Constraint.BindingMap.add key (convert_binding_expr expr) acc)
+      Constraint.BindingMap.empty
+      pairs
+
+  let rec convert_body : Ast.constraint_body -> Constraint.t = function
+    | Ast.MemberOf { target; binding } ->
+      Constraint.MemberOf { target; binding = convert_binding binding }
+    | Ast.Not { body; universe } ->
+      Constraint.Not { body = convert_body body; universe }
+    | Ast.And bodies ->
+      Constraint.And (List.map convert_body bodies)
+    | Ast.Or bodies ->
+      Constraint.Or (List.map convert_body bodies)
+    | Ast.Exists { variable; quantifier; body } ->
+      Constraint.Exists { variable; quantifier; body = convert_body body }
+    | Ast.Forall { variable; quantifier; body } ->
+      Constraint.Forall { variable; quantifier; body = convert_body body }
+
+  let execute
+      (storage : Storage.t)
+      (db : Management.Database.t)
+      (stmt : Ast.statement)
+    : (Management.Database.t * string, error) result =
+    match stmt with
+    | Ast.RegisterConstraint { constraint_name; relation_name; body } ->
+      let runtime_body = convert_body body in
+      (match Ops.register_constraint storage db
+               ~constraint_name ~relation_name ~body:runtime_body
+             |> wrap_manip with
+       | Ok new_db -> Ok (new_db, "Constraint registered: " ^ constraint_name)
+       | Error e   -> Error e)
+end
+
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/icl/parser.ml b/lib/icl/parser.ml
new file mode 100644
index 0000000..a7981c0
--- /dev/null
+++ b/lib/icl/parser.ml
@@ -0,0 +1,9 @@
+type error = ParseError of string
+
+let of_string s =
+  match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
+  | stmt          -> Ok stmt
+  | exception exn -> Error (ParseError (Printexc.to_string exn))
+
+let to_string stmt =
+  Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum
diff --git a/lib/management/branch.ml b/lib/management/branch.ml
new file mode 100644
index 0000000..70dfd85
--- /dev/null
+++ b/lib/management/branch.ml
@@ -0,0 +1,138 @@
+(** Branch registry: named pointers to database tip hashes, plus HEAD tracking.
+    Stored in the Physical backend under reserved key prefixes:
+    - "branch:<name>" → serialized { name; tip }
+    - "branch_names"  → serialized string list (index for enumeration)
+    - "head"          → branch name as raw bytes *)
+
+type t = {
+  name : string;
+  tip  : Conventions.Hash.t;
+}
+
+type head = string
+
+type error = string
+
+let branch_key name = "branch:" ^ name
+let head_key = "head"
+let names_key = "branch_names"
+
+module Make (Storage : Physical.S with type error = string) = struct
+
+  let load_names storage =
+    match Storage.load_raw storage names_key with
+    | Ok (Some bytes) -> (Marshal.from_bytes bytes 0 : string list)
+    | _ -> []
+
+  let store_names storage names =
+    let bytes = Marshal.to_bytes names [] in
+    ignore (Storage.store_raw storage names_key bytes)
+
+  let create storage ~name ~tip =
+    let record = { name; tip } in
+    let bytes = Marshal.to_bytes record [] in
+    (match Storage.store_raw storage (branch_key name) bytes with
+     | Error e -> Error e
+     | Ok () ->
+       let names = load_names storage in
+       if not (List.mem name names) then
+         store_names storage (name :: names);
+       Ok ())
+
+  let checkout storage branch_name =
+    let bytes = Bytes.of_string branch_name in
+    Storage.store_raw storage head_key bytes
+
+  let get_head storage =
+    match Storage.load_raw storage head_key with
+    | Ok (Some bytes) -> Ok (Some (Bytes.to_string bytes))
+    | Ok None -> Ok None
+    | Error e -> Error e
+
+  let get_tip storage name =
+    match Storage.load_raw storage (branch_key name) with
+    | Ok (Some bytes) ->
+      let record : t = Marshal.from_bytes bytes 0 in
+      Ok (Some record.tip)
+    | Ok None -> Ok None
+    | Error e -> Error e
+
+  let update_tip storage ~name ~tip =
+    match Storage.load_raw storage (branch_key name) with
+    | Ok (Some _) ->
+      let record = { name; tip } in
+      let bytes = Marshal.to_bytes record [] in
+      Storage.store_raw storage (branch_key name) bytes
+    | Ok None -> Error ("Branch not found: " ^ name)
+    | Error e -> Error e
+
+  let list storage =
+    let names = load_names storage in
+    let branches = List.filter_map (fun name ->
+      match get_tip storage name with
+      | Ok (Some tip) -> Some (name, tip)
+      | _ -> None
+    ) names in
+    Ok branches
+
+  let branch_relation storage : Relation.t =
+    let schema =
+      Schema.empty |> Schema.add "name" "string" |> Schema.add "hash" "string"
+    in
+    let mk v = { Attribute.value = Obj.repr v } in
+    let rec generator position =
+      match position with
+      | None -> Generator.Error "random access not supported for sakura:branch"
+      | Some pos ->
+        (match list storage with
+         | Error _ -> Generator.Done
+         | Ok branches ->
+           if pos >= List.length branches then Generator.Done
+           else
+             let (name, tip) = List.nth branches pos in
+             let short = String.sub tip 0 (min 8 (String.length tip)) in
+             let attributes =
+               Tuple.AttributeMap.of_list
+                 [ ("name", mk name)
+                 ; ("hash", mk short)
+                 ]
+             in
+             Generator.Value
+               ( Tuple.make_materialized ~relation:Prelude.Catalog.branch_rel_name ~attributes
+               , generator ))
+    in
+    Relation.make ~hash:None ~name:Prelude.Catalog.branch_rel_name ~schema
+      ~tree:None ~constraints:None
+      ~cardinality:Conventions.Cardinality.ConstrainedFinite
+      ~generator:(Some generator)
+      ~membership_criteria:(fun _ -> true)
+      ~provenance:(Relation.Provenance.Base Prelude.Catalog.branch_rel_name)
+      ~lineage:(Relation.Lineage.Base Prelude.Catalog.branch_rel_name)
+
+  let head_relation storage : Relation.t =
+    let schema = Schema.empty |> Schema.add "branch" "string" in
+    let mk v = { Attribute.value = Obj.repr v } in
+    let generator position =
+      match position with
+      | None -> Generator.Error "random access not supported for sakura:head"
+      | Some 0 ->
+        (match get_head storage with
+         | Ok None | Error _ -> Generator.Done
+         | Ok (Some branch_name) ->
+           let attributes =
+             Tuple.AttributeMap.of_list [ ("branch", mk branch_name) ]
+           in
+           Generator.Value
+             ( Tuple.make_materialized ~relation:Prelude.Catalog.head_rel_name ~attributes
+             , fun _ -> Generator.Done ))
+      | Some _ -> Generator.Done
+    in
+    Relation.make ~hash:None ~name:Prelude.Catalog.head_rel_name ~schema
+      ~tree:None ~constraints:None
+      ~cardinality:Conventions.Cardinality.ConstrainedFinite
+      ~generator:(Some generator)
+      ~membership_criteria:(fun _ -> true)
+      ~provenance:(Relation.Provenance.Base Prelude.Catalog.head_rel_name)
+      ~lineage:(Relation.Lineage.Base Prelude.Catalog.head_rel_name)
+
+end
diff --git a/lib/management/diff.ml b/lib/management/diff.ml
new file mode 100644
index 0000000..865c757
--- /dev/null
+++ b/lib/management/diff.ml
@@ -0,0 +1,60 @@
+(** Structural delta between two Database.t states.
+    Computes what changed from ancestor → target at the relation level. *)
+
+type relation_diff =
+  | RelationAdded   of Relation.t
+  | RelationRemoved of string
+  | RelationModified of {
+      name           : string;
+      added_tuples   : Conventions.Hash.t list;
+      removed_tuples : Conventions.Hash.t list;
+      schema_changed : bool;
+    }
+
+type t = {
+  ancestor       : Conventions.Hash.t;
+  left           : Conventions.Hash.t;
+  right          : Conventions.Hash.t;
+  relation_diffs : relation_diff list;
+}
+
+module StringSet = Set.Make(String)
+
+let relation_keys rel =
+  match rel.Relation.tree with
+  | None -> StringSet.empty
+  | Some tree -> StringSet.of_list (Merkle.keys tree)
+
+(** Compute relation-level diffs from ancestor → target. *)
+let diff ~ancestor ~(target : Database.t) =
+  let ancestor_names =
+    Database.get_relation_names ancestor |> StringSet.of_list
+  in
+  let target_names =
+    Database.get_relation_names target |> StringSet.of_list
+  in
+  let all_names = StringSet.union ancestor_names target_names in
+  StringSet.fold (fun name acc ->
+    let in_ancestor = StringSet.mem name ancestor_names in
+    let in_target   = StringSet.mem name target_names   in
+    match in_ancestor, in_target with
+    | false, true ->
+      let rel = Option.get (Database.get_relation target name) in
+      RelationAdded rel :: acc
+    | true, false ->
+      RelationRemoved name :: acc
+    | true, true ->
+      let anc_rel = Option.get (Database.get_relation ancestor name) in
+      let tgt_rel = Option.get (Database.get_relation target  name) in
+      (* Compare hashes — if identical, no diff *)
+      if anc_rel.Relation.hash = tgt_rel.Relation.hash then acc
+      else begin
+        let anc_keys = relation_keys anc_rel in
+        let tgt_keys = relation_keys tgt_rel in
+        let added_tuples   = StringSet.diff tgt_keys anc_keys |> StringSet.elements in
+        let removed_tuples = StringSet.diff anc_keys tgt_keys |> StringSet.elements in
+        let schema_changed = anc_rel.Relation.schema <> tgt_rel.Relation.schema in
+        RelationModified { name; added_tuples; removed_tuples; schema_changed } :: acc
+      end
+    | false, false -> acc (* impossible *)
+  ) all_names []
diff --git a/lib/management/merge.ml b/lib/management/merge.ml
new file mode 100644
index 0000000..e50d0e6
--- /dev/null
+++ b/lib/management/merge.ml
@@ -0,0 +1,235 @@
+(** 3-way merge of two branch tips using their Lowest Common Ancestor.
+    Walks the history chain to find it, diffs both sides against it,
+    applies merge rules, validates constraints, and persists the result. *)
+
+type conflict =
+  | TupleConflict    of { relation: string; hash: Conventions.Hash.t }
+  | SchemaConflict   of string
+  | ConstraintConflict of string
+
+type strategy = PreferLeft | PreferRight | RevertToAncestor
+
+type merge_result =
+  | Clean  of Database.t
+  | Failed of conflict list
+
+(** Module type for the subset of Manipulation.Make we need. *)
+module type MANIPULATION = sig
+  type storage
+  type error
+  val of_string_error    : string -> error
+  val load_database  : storage -> Conventions.Hash.t -> (Database.t option, error) result
+  val store_database : storage -> Database.t -> (unit, error) result
+end
+
+module StringSet = Set.Make(String)
+
+(** Walk history to find LCA. First hash in right's ancestry that also appears
+    in left's ancestry set. *)
+let find_lca left_db right_db =
+  let left_ancestors =
+    StringSet.of_list (left_db.Database.hash
+                       :: left_db.Database.history)
+  in
+  let right_chain =
+    right_db.Database.hash
+    :: right_db.Database.history
+  in
+  List.find_opt (fun h -> StringSet.mem h left_ancestors) right_chain
+
+(** Apply a single relation diff to a database, using strategy on conflicts. *)
+let apply_diff db ~strategy ~left_db ~right_db ~(left_diff : Diff.relation_diff)
+    ~(right_diff : Diff.relation_diff option) : Database.t * conflict list =
+  match left_diff with
+  | Diff.RelationAdded rel ->
+    (* Only left added it; right_diff must be None or same *)
+    (Database.add_relation db ~relation:rel, [])
+
+  | Diff.RelationRemoved name ->
+    (Database.remove_relation db ~name, [])
+
+  | Diff.RelationModified { name; added_tuples; removed_tuples; schema_changed } ->
+    let conflicts = ref [] in
+    (* Determine the merged relation's Merkle tree *)
+    let base_rel_opt = Database.get_relation db name in
+    (match base_rel_opt with
+     | None -> (db, [])
+     | Some base_rel ->
+       let base_tree = Option.value base_rel.Relation.tree ~default:Merkle.empty in
+       (* Handle schema conflict *)
+       let (resolved_rel, schema_conflict) =
+         if schema_changed then
+           match right_diff with
+           | Some (Diff.RelationModified { schema_changed = true; _ }) ->
+             (* Both changed schema — apply strategy *)
+             let winner = match strategy with
+               | PreferLeft -> Database.get_relation left_db name
+               | PreferRight -> Database.get_relation right_db name
+               | RevertToAncestor -> Some base_rel
+             in
+             (Option.value winner ~default:base_rel, [SchemaConflict name])
+           | _ ->
+             (* Only left changed schema — take left's relation *)
+             let left_rel = Option.value
+               (Database.get_relation left_db name) ~default:base_rel in
+             (left_rel, [])
+         else (base_rel, [])
+       in
+       conflicts := schema_conflict @ !conflicts;
+       (* Apply tuple adds/removes from left *)
+       let merged_tree =
+         List.fold_left (fun t h -> Merkle.insert h t) base_tree added_tuples
+       in
+       let merged_tree =
+         List.fold_left (fun t h -> Merkle.delete h t) merged_tree removed_tuples
+       in
+       (* Apply tuple adds/removes from right if disjoint *)
+       let merged_tree = match right_diff with
+         | Some (Diff.RelationModified
+                   { added_tuples = r_add; removed_tuples = r_rem; _ }) ->
+           (* Detect tuple conflicts: same hash both added and removed *)
+           let left_add  = StringSet.of_list added_tuples   in
+           let left_rem  = StringSet.of_list removed_tuples in
+           let right_add = StringSet.of_list r_add          in
+           let right_rem = StringSet.of_list r_rem          in
+           let conflict_hashes =
+             StringSet.inter left_add right_rem
+             |> StringSet.union (StringSet.inter left_rem right_add)
+           in
+           if not (StringSet.is_empty conflict_hashes) then begin
+             StringSet.iter (fun h ->
+               conflicts := TupleConflict { relation = name; hash = h } :: !conflicts
+             ) conflict_hashes;
+             (* Resolve conflicting tuples per strategy *)
+             match strategy with
+             | PreferLeft ->
+               (* keep left's merged_tree as-is, ignore conflicting right ops *)
+               let safe_add = StringSet.diff right_add conflict_hashes in
+               let safe_rem = StringSet.diff right_rem conflict_hashes in
+               let t = StringSet.fold (fun h acc -> Merkle.insert h acc) safe_add merged_tree in
+               StringSet.fold (fun h acc -> Merkle.delete h acc) safe_rem t
+             | PreferRight ->
+               (* revert left's conflicting ops, apply right's *)
+               let t = StringSet.fold (fun h acc -> Merkle.delete h acc) conflict_hashes merged_tree in
+               let t = StringSet.fold (fun h acc -> Merkle.insert h acc) right_add t in
+               StringSet.fold (fun h acc -> Merkle.delete h acc) right_rem t
+             | RevertToAncestor ->
+               (* drop conflicting hashes from merged tree *)
+               StringSet.fold (fun h acc -> Merkle.delete h acc) conflict_hashes merged_tree
+           end else begin
+             (* Disjoint — union both sides *)
+             let t = List.fold_left (fun acc h -> Merkle.insert h acc) merged_tree r_add in
+             List.fold_left (fun acc h -> Merkle.delete h acc) t r_rem
+           end
+         | _ -> merged_tree
+       in
+       let new_hash = Hashing.hash_relation
+         ~name:resolved_rel.Relation.name
+         ~schema:resolved_rel.Relation.schema
+         ~tree:merged_tree
+       in
+       let updated_rel = { resolved_rel with
+         Relation.tree = Some merged_tree;
+         hash = Some new_hash;
+       } in
+       let new_db = Database.update_relation db ~relation:updated_rel in
+       (new_db, !conflicts))
+
+module Make
+    (Storage : Physical.S)
+    (Manip   : MANIPULATION with type storage = Storage.t) =
+struct
+
+  let err s = Error (Manip.of_string_error s)
+
+  (* Load both tips, find the lowest common ancestor, compute the diffs,
+     lookup for right diffs by relation name, start from ancestor and
+     apply all the diffs, apply first the left diffs, then right-only diffs
+     (relations only right touched). If there are no conflicts, persist the
+     merged database, otherwise return Failed, unless a strategy resolved them. *)
+  let merge ~storage ~strategy ~left_tip ~right_tip =
+    match Manip.load_database storage left_tip with
+    | Error e -> Error e
+    | Ok None -> err ("Left tip not found: " ^ left_tip)
+    | Ok (Some left_db) ->
+    match Manip.load_database storage right_tip with
+    | Error e -> Error e
+    | Ok None -> err ("Right tip not found: " ^ right_tip)
+    | Ok (Some right_db) ->
+    match find_lca left_db right_db with
+    | None -> err "No common ancestor found between branches"
+    | Some ancestor_hash ->
+    match Manip.load_database storage ancestor_hash with
+    | Error e -> Error e
+    | Ok None -> err ("Ancestor not found: " ^ ancestor_hash)
+    | Ok (Some ancestor_db) ->
+    let left_diffs  = Diff.diff ~ancestor:ancestor_db ~target:left_db  in
+    let right_diffs = Diff.diff ~ancestor:ancestor_db ~target:right_db in
+    let right_diff_map =
+      List.fold_left (fun m d ->
+        let key = match d with
+          | Diff.RelationAdded   r -> r.Relation.name
+          | Diff.RelationRemoved n -> n
+          | Diff.RelationModified { name; _ } -> name
+        in
+        Database.RelationMap.add key d m
+      ) Database.RelationMap.empty right_diffs
+    in
+    let (merged_db, all_conflicts) =
+      let (db_after_left, left_conflicts) =
+        List.fold_left (fun (db, conflicts) left_d ->
+          let rel_name = match left_d with
+            | Diff.RelationAdded   r -> r.Relation.name
+            | Diff.RelationRemoved n -> n
+            | Diff.RelationModified { name; _ } -> name
+          in
+          let right_d = Database.RelationMap.find_opt rel_name right_diff_map in
+          let (new_db, cs) =
+            apply_diff db ~strategy ~left_db ~right_db
+              ~left_diff:left_d ~right_diff:right_d
+          in
+          (new_db, cs @ conflicts)
+        ) (ancestor_db, []) left_diffs
+      in
+      let left_names =
+        List.fold_left (fun s d ->
+          let n = match d with
+            | Diff.RelationAdded   r -> r.Relation.name
+            | Diff.RelationRemoved n -> n
+            | Diff.RelationModified { name; _ } -> name
+          in
+          StringSet.add n s
+        ) StringSet.empty left_diffs
+      in
+      let right_only = List.filter (fun d ->
+        let n = match d with
+          | Diff.RelationAdded   r -> r.Relation.name
+          | Diff.RelationRemoved n -> n
+          | Diff.RelationModified { name; _ } -> name
+        in
+        not (StringSet.mem n left_names)
+      ) right_diffs in
+      let (db_final, right_conflicts) =
+        List.fold_left (fun (db, conflicts) right_d ->
+          let (new_db, cs) =
+            apply_diff db ~strategy ~left_db ~right_db
+              ~left_diff:right_d ~right_diff:None
+          in
+          (new_db, cs @ conflicts)
+        ) (db_after_left, left_conflicts) right_only
+      in
+      (db_final, right_conflicts)
+    in
+    let unresolvable = List.filter (function
+      | ConstraintConflict _ -> true
+      | _ -> false
+    ) all_conflicts in
+    if unresolvable <> [] then
+      Ok (Failed unresolvable)
+    else begin
+      match Manip.store_database storage merged_db with
+      | Error e -> Error e
+      | Ok () -> Ok (Clean merged_db)
+    end
+
+end
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index 2a43b6c..73607fa 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -44,6 +44,8 @@ let build_membership_criteria _schema : (Tuple.t -> bool) =
 (** Functor to create manipulation operations with a storage backend *)
 module Make (Storage : Management.Physical.S) = struct
   type storage = Storage.t
+  type nonrec error = error
+  let of_string_error s = StorageError s
 
   (* Constraint evaluation context *)
 
diff --git a/lib/prelude/catalog.ml b/lib/prelude/catalog.ml
index a277066..4a7241a 100644
--- a/lib/prelude/catalog.ml
+++ b/lib/prelude/catalog.ml
@@ -15,6 +15,8 @@ let attribute_rel_name  = catalog_prefix ^ "attribute"
 let constraint_rel_name = catalog_prefix ^ "constraint"
 let on_rel_name         = catalog_prefix ^ "on"
 let timing_rel_name     = catalog_prefix ^ "timing"
+let branch_rel_name     = catalog_prefix ^ "branch"
+let head_rel_name       = catalog_prefix ^ "head"
 
 let catalog_relation_names =
   [ relation_rel_name
@@ -111,3 +113,4 @@ let build_timing_tuple timing : Tuple.materialized =
       Tuple.AttributeMap.singleton "timing"
         { Attribute.value = Obj.magic timing }
   }
+