diff --git a/bin/ir_cli.ml b/bin/ir_cli.ml index 80d17d9ba6..c8ea8983c3 100644 --- a/bin/ir_cli.ml +++ b/bin/ir_cli.ml @@ -411,10 +411,10 @@ let watch = { let view (c, _) = S.of_commit c >>= fun t -> S.find_tree t path >|= function - | None -> S.Tree.empty () + | None -> S.Tree.empty | Some v -> v in - let empty = Lwt.return (S.Tree.empty ()) in + let empty = Lwt.return S.Tree.empty in let x, y = match d with | `Updated (x, y) -> view x, view y | `Added x -> empty , view x diff --git a/examples/deploy.ml b/examples/deploy.ml index 551601baba..cc6c011ae3 100644 --- a/examples/deploy.ml +++ b/examples/deploy.ml @@ -18,7 +18,7 @@ let provision repo = Store.of_branch repo "upstream" >>= fun t -> - Store.Tree.empty () |> fun v -> + Store.Tree.empty |> fun v -> Store.Tree.add v ["etc"; "manpath"] "/usr/share/man\n\ /usr/local/share/man" diff --git a/examples/views.ml b/examples/views.ml index dbd4eb6863..300c4ced73 100644 --- a/examples/views.ml +++ b/examples/views.ml @@ -21,7 +21,7 @@ let view_of_t t = Tree.add v [si;"x"] t2.x >>= fun v -> Tree.add v [si;"y"] (string_of_int t2.y) >|= fun v -> (v, i + 1) - ) (Tree.empty (), 0) t + ) (Tree.empty, 0) t >|= fun (v, _) -> v let t_of_view v = diff --git a/src/ir_s.mli b/src/ir_s.mli index 635ca79d4a..5d0cf167f2 100644 --- a/src/ir_s.mli +++ b/src/ir_s.mli @@ -318,7 +318,7 @@ module type TREE = sig type contents type node type tree = [ `Node of node | `Contents of contents * metadata ] - val empty: unit -> tree + val empty: tree val of_contents: ?metadata:metadata -> contents -> tree val of_node: node -> tree val kind: tree -> key -> [`Contents | `Node] option Lwt.t diff --git a/src/ir_store.ml b/src/ir_store.ml index 1d72bea16e..23a5d9c407 100644 --- a/src/ir_store.ml +++ b/src/ir_store.ml @@ -263,7 +263,6 @@ module Make (P: Ir_s.PRIVATE) = struct head_ref: head_ref; mutable tree: (commit * root_tree) option; (* cache for the store tree *) lock: Lwt_mutex.t; - empty: tree; (* cache for empty trees. FIXME: should be in repo *) } type step = Key.step @@ -306,7 +305,6 @@ module Make (P: Ir_s.PRIVATE) = struct lock; head_ref; repo = repo; tree = None; - empty = Tree.empty (); } let err_invalid_branch t = @@ -367,7 +365,7 @@ module Make (P: Ir_s.PRIVATE) = struct let tree t = tree_and_head t >|= function - | None -> t.empty + | None -> Tree.empty | Some (_, tree) -> (tree :> tree) let lift_head_diff repo fn = function @@ -540,7 +538,7 @@ module Make (P: Ir_s.PRIVATE) = struct | None -> Lwt.return { head = None; - root = t.empty; + root = Tree.empty; tree = None; parents = []; } @@ -632,18 +630,18 @@ module Make (P: Ir_s.PRIVATE) = struct in retry "with_tree" aux - let none_to_empty t = function None -> t.empty | Some v -> v + let none_to_empty = function None -> Tree.empty | Some v -> v let set t k ?metadata ?allow_empty ?strategy ?max_depth ?n ~info v = Log.debug (fun l -> l "set %a" Key.pp k); with_tree t ?allow_empty ?strategy ?max_depth ?n ~info k (fun tree -> - Tree.add (none_to_empty t tree) Key.empty ?metadata v >|= fun x -> + Tree.add (none_to_empty tree) Key.empty ?metadata v >|= fun x -> Some x) let set_tree t k ?allow_empty ?strategy ?max_depth ?n ~info v = Log.debug (fun l -> l "set_tree %a" Key.pp k); with_tree t ?allow_empty ?strategy ?max_depth ?n ~info k (fun tree -> - Tree.add_tree (none_to_empty t tree) Key.empty v >|= fun x -> + Tree.add_tree (none_to_empty tree) Key.empty v >|= fun x -> Some x) type strategy = [ `Test_and_set | `Set | `Merge ] diff --git a/src/ir_tree.ml b/src/ir_tree.ml index 8702b54db0..1ce8076246 100644 --- a/src/ir_tree.ml +++ b/src/ir_tree.ml @@ -202,7 +202,7 @@ module Make (P: Ir_s.PRIVATE) = struct let of_map map = { v = Map map } let of_key repo k = { v = Key (repo, k) } let both repo k m = { v = Both (repo, k, m) } - let empty () = of_map StepMap.empty + let empty = of_map StepMap.empty let import t n = let alist = P.Node.Val.list n in @@ -490,7 +490,7 @@ module Make (P: Ir_s.PRIVATE) = struct | `Node _ , `Contents _ | `Contents _, `Node _ -> Lwt.return_false - let empty () = `Node (Node.empty ()) + let empty = `Node Node.empty let is_empty = function | `Node n -> Node.is_empty n | `Contents _ -> Lwt.return false @@ -581,7 +581,7 @@ module Make (P: Ir_s.PRIVATE) = struct match Path.rdecons k with | None -> is_empty t >>= fun is_empty -> - if is_empty then Lwt.return t else Lwt.return (empty ()) + if is_empty then Lwt.return t else Lwt.return empty | Some (path, file) -> let rec aux view path = match Path.decons path with @@ -599,7 +599,7 @@ module Make (P: Ir_s.PRIVATE) = struct | true -> Node.remove view h | false -> Node.add view h (`Node child') in - let n = match t with `Node n -> n | _ -> Node.empty () in + let n = match t with `Node n -> n | _ -> Node.empty in aux n path >>= fun node -> Node.equal n node >|= function | true -> t @@ -620,7 +620,7 @@ module Make (P: Ir_s.PRIVATE) = struct | Some (h, p) -> Node.findv view h >>= function | None | Some (`Contents _) -> - aux (Node.empty ()) p >>= fun child -> + aux Node.empty p >>= fun child -> Node.add view h (`Node child) | Some (`Node child) -> aux child p >>= fun child' -> @@ -628,7 +628,7 @@ module Make (P: Ir_s.PRIVATE) = struct | true -> Lwt.return view | false -> Node.add view h (`Node child') in - let n = match t with `Node n -> n | _ -> Node.empty () in + let n = match t with `Node n -> n | _ -> Node.empty in aux n path >>= fun node -> Node.equal n node >|= function | true -> t @@ -656,7 +656,7 @@ module Make (P: Ir_s.PRIVATE) = struct | Some (h, p) -> Node.findv view h >>= function | None | Some (`Contents _) -> - aux (Node.empty ()) p >>= fun child -> + aux Node.empty p >>= fun child -> Node.add view h (`Node child) | Some (`Node child) -> aux child p >>= fun child' -> @@ -664,7 +664,7 @@ module Make (P: Ir_s.PRIVATE) = struct | true -> Lwt.return view | false -> Node.add view h (`Node child') in - let n = match t with `Node n -> n | _ -> Node.empty () in + let n = match t with `Node n -> n | _ -> Node.empty in aux n path >>= fun node -> Node.equal n node >|= function | true -> t @@ -672,7 +672,7 @@ module Make (P: Ir_s.PRIVATE) = struct let import repo k = P.Node.find (P.Repo.node_t repo) k >|= function - | None -> Node.empty () + | None -> Node.empty | Some n -> Node.both repo k (Node.import repo n) let export repo n = @@ -680,6 +680,15 @@ module Make (P: Ir_s.PRIVATE) = struct let todo = Stack.create () in let rec add_to_todo n = match n.Node.v with + | Node.Both (repo, k, x) when StepMap.is_empty x -> + Stack.push (fun () -> + P.Node.mem (P.Repo.node_t repo) k >>= function + | true -> Lwt.return_unit + | false -> + node x >>= fun k -> + n.Node.v <- Node.Both (repo, k, x); + Lwt.return_unit + ) todo | (Node.Key _ | Node.Both _ ) -> () | Node.Map x -> (* 1. we push the current node job on the stack. *) @@ -859,9 +868,9 @@ module Make (P: Ir_s.PRIVATE) = struct else Lwt.return [ Path.empty, `Updated (y, x) ] | `Node x , `Node y -> diff_node x y | `Contents x, `Node y -> - diff_node (Node.empty ()) y >|= fun diff -> (Path.empty, `Removed x) :: diff + diff_node Node.empty y >|= fun diff -> (Path.empty, `Removed x) :: diff | `Node x , `Contents y -> - diff_node x (Node.empty ()) >|= fun diff -> (Path.empty, `Added y) :: diff + diff_node x Node.empty >|= fun diff -> (Path.empty, `Added y) :: diff type concrete = [ `Tree of (step * concrete) list diff --git a/src/irmin.mli b/src/irmin.mli index 48ba0716be..6780eb2e89 100644 --- a/src/irmin.mli +++ b/src/irmin.mli @@ -2252,8 +2252,8 @@ module type S = sig (** {1 Constructors} *) - val empty: unit -> tree - (** [empty ()] is the empty tree. Empty trees do not have + val empty: tree + (** [empty] is the empty tree. The empty tree does not have associated backend configuration values, as they can perform in-memory operation, independently of any given backend. *) diff --git a/test/test_store.ml b/test/test_store.ml index 6a6dd31c59..246fb518d6 100644 --- a/test/test_store.ml +++ b/test/test_store.ml @@ -789,7 +789,7 @@ module Make (S: Test_S) = struct let i = Int64.of_int date in Irmin.Info.v ~date:i ~author:"test" "Test commit" in - let tree = S.Tree.empty () in + let tree = S.Tree.empty in let assert_lcas_err msg err l2 = let err_str = function | `Too_many_lcas -> "Too_many_lcas" @@ -1080,7 +1080,7 @@ module Make (S: Test_S) = struct (* Testing [View.remove] *) - S.Tree.empty () |> fun v1 -> + S.Tree.empty |> fun v1 -> S.Tree.add v1 ["foo";"1"] foo1 >>= fun v1 -> S.Tree.add v1 ["foo";"2"] foo2 >>= fun v1 -> @@ -1105,9 +1105,9 @@ module Make (S: Test_S) = struct let normal c = Some (c, S.Metadata.default) in let d0 = S.Metadata.default in - S.Tree.empty () |> fun v0 -> - S.Tree.empty () |> fun v1 -> - S.Tree.empty () |> fun v2 -> + S.Tree.empty |> fun v0 -> + S.Tree.empty |> fun v1 -> + S.Tree.empty |> fun v2 -> S.Tree.add v1 ["foo";"1"] foo1 >>= fun v1 -> S.Tree.find_all v1 ["foo"; "1"] >>= fun f -> check_val "view udate" (normal foo1) f; @@ -1127,7 +1127,7 @@ module Make (S: Test_S) = struct (* Testing other View operations. *) - S.Tree.empty () |> fun v0 -> + S.Tree.empty |> fun v0 -> S.Tree.add v0 [] foo1 >>= fun v0 -> S.Tree.find_all v0 [] >>= fun foo1' -> @@ -1229,7 +1229,7 @@ module Make (S: Test_S) = struct S.Tree.find_all view px >>= fun vx' -> check_val "updates" (normal vx) vx'; - S.Tree.empty () |> fun v -> + S.Tree.empty |> fun v -> S.Tree.add v [] vx >>= fun v -> S.set_tree t ~info:(infof "update file as view") ["a"] v >>= fun () -> S.find_all t ["a"] >>= fun vx' ->