Merge pull request #435 from samoht/empty

Revert the `empty` -> empty ()` change

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

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"

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 =

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

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 ]

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,15 +620,15 @@ 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' ->
             Node.equal child child' >>= function
             | 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,30 +656,39 @@ 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' ->
             Node.equal child child' >>= function
             | 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
       | false -> `Node node
 
   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 =
     let node n = P.Node.add (P.Repo.node_t repo) (Node.export_map n) in
     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

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. *)
 

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' ->