Merge pull request #19 from jestabro/immutable

T5317: remove mutable references

2 files changed, 207 insertions, 156 deletions

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 9bbd2fd..35a5b55 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -1,25 +1,61 @@
 type change = Unchanged | Added | Subtracted | Updated of string list
 
-type diff_func = ?recurse:bool -> string list -> change -> unit
-
-type diff_trees = {
-    left: Config_tree.t;
-    right: Config_tree.t;
-    add: Config_tree.t ref;
-    sub: Config_tree.t ref;
-    inter: Config_tree.t ref;
-}
-
 exception Incommensurable
 exception Empty_comparison
 exception Nonexistent_child
 
-let make_diff_trees l r = { left = l; right = r;
-                           add = ref (Config_tree.make "");
-                           sub = ref (Config_tree.make "");
-                           inter = ref (Config_tree.make "");
+module Diff_tree = struct
+    type t = { left: Config_tree.t;
+               right: Config_tree.t;
+               add: Config_tree.t;
+               sub: Config_tree.t;
+               del: Config_tree.t;
+               inter: Config_tree.t;
+             }
+end
+
+module Diff_string = struct
+    type t = { left: Config_tree.t;
+               right: Config_tree.t;
+               skel: Config_tree.t;
+               ppath: string list;
+               udiff: string;
+             }
+end
+
+module Diff_cstore = struct
+    type t = { left: Config_tree.t;
+               right: Config_tree.t;
+               handle: int;
+             }
+end
+
+type _ result =
+    | Diff_tree : Diff_tree.t -> Diff_tree.t result
+    | Diff_string : Diff_string.t -> Diff_string.t result
+    | Diff_cstore : Diff_cstore.t -> Diff_cstore.t result
+
+let eval_result : type a. a result -> a = function
+    | Diff_tree x -> x
+    | Diff_string x -> x
+    | Diff_cstore x -> x
+
+type 'a diff_func = ?recurse:bool -> string list -> 'a result -> change -> 'a result
+
+let make_diff_trees l r = Diff_tree { left = l; right = r;
+                                  add = (Config_tree.make "");
+                                  sub = (Config_tree.make "");
+                                  del = (Config_tree.make "");
+                                  inter = (Config_tree.make "");
 }
 
+let make_diff_string l r = Diff_string {
+                               left = l; right = r;
+                               skel = (Config_tree.make "");
+                               ppath = [];
+                               udiff = "";
+                           }
+
 let name_of n = Vytree.name_of_node n
 let data_of n = Vytree.data_of_node n
 let children_of n = Vytree.children_of_node n
@@ -62,7 +98,7 @@ let right_opt_pairs n m =
  *)
 let opt_cmp o0 o1 =
     match o0, o1 with
-    | Some v0, Some v1 -> compare v0 v1
+    | Some v0, Some v1 -> compare (name_of v0) (name_of v1)
     | None, None -> 0
     | None, Some _ -> 1
     | Some _, None -> -1
@@ -93,24 +129,20 @@ let update_path path left_opt right_opt =
    The idea of matching on pairs of (node opt) is from
    https://github.com/LukeBurgessYeo/tree-diff
  *)
-let rec diff (path : string list) (f : diff_func) (l : (Config_tree.t option * Config_tree.t option) list) =
-    match l with
-    | [] -> ()
-    | (left_node_opt, right_node_opt) :: ls ->
-        (let path = update_path path left_node_opt right_node_opt in
-        match left_node_opt, right_node_opt with
-        | Some _, None -> f path Subtracted
-        | None, Some _ -> f path Added
-        | Some left_node, Some right_node when left_node = right_node ->
-                f path Unchanged
-        | Some left_node, Some right_node when left_node ^~ right_node ->
-                let values = (data_of right_node).values in
-                f path (Updated values)
-        | Some left_node, Some right_node ->
-                (f ~recurse:false path Unchanged;
-                diff path f (opt_zip left_node right_node))
-        | None, None -> raise Empty_comparison)
-        ; diff path f ls
+let rec diff (path : string list) (f : 'a diff_func) (res: 'a result) ((left_node_opt, right_node_opt) : Config_tree.t option * Config_tree.t option) =
+    let path = update_path path left_node_opt right_node_opt in
+    match left_node_opt, right_node_opt with
+    | None, None -> raise Empty_comparison
+    | Some _, None -> f path res Subtracted
+    | None, Some _ -> f path res Added
+    | Some left_node, Some right_node when left_node = right_node ->
+        f ~recurse:true path res Unchanged
+    | Some left_node, Some right_node when left_node ^~ right_node ->
+        let values = (data_of right_node).values in
+        f path res (Updated values)
+    | Some left_node, Some right_node ->
+        let ret = f ~recurse:false path res Unchanged in
+        List.fold_left (diff path f) ret (opt_zip left_node right_node)
 
 (* copy node paths between trees *)
 let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_done path_remaining =
@@ -143,75 +175,58 @@ let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
 
 let is_empty l = (l = [])
 
-(* define the diff_func; in this instance, we imperatively build the difference trees *)
-let decorate_trees (trees : diff_trees) ?(recurse=true) (path : string list) (m : change) =
+(* define the diff_func *)
+let decorate_trees ?(recurse=true) (path : string list) (Diff_tree res) (m : change) =
     match m with
-    | Added -> trees.add := clone trees.right !(trees.add) path
-    | Subtracted -> trees.sub := clone trees.left !(trees.sub) path
-    | Unchanged -> trees.inter := clone ~recurse:recurse trees.left !(trees.inter) path
-    | Updated v ->
-            (* if in this case, node at path is guaranteed to exist *)
-            let ov = Config_tree.get_values trees.left path in
-            match ov, v with
-            | [_], [_] -> trees.sub := clone trees.left !(trees.sub) path;
-                          trees.add := clone trees.right !(trees.add) path
-            | _, _ -> let ov_set = ValueS.of_list ov in
-                      let v_set = ValueS.of_list v in
-                      let sub_vals = ValueS.elements (ValueS.diff ov_set v_set) in
-                      let add_vals = ValueS.elements (ValueS.diff v_set ov_set) in
-                      let inter_vals = ValueS.elements (ValueS.inter ov_set v_set) in
-                      if not (is_empty sub_vals) then
-                          trees.sub := clone ~set_values:(Some sub_vals) trees.left !(trees.sub) path;
-                      if not (is_empty add_vals) then
-                          trees.add := clone ~set_values:(Some add_vals) trees.right !(trees.add) path;
-                      if not (is_empty inter_vals) then
-                          trees.inter := clone ~set_values:(Some inter_vals) trees.left !(trees.inter) path
-
-(* define the 'trim' diff_func:
-
-   One can use the diff algorithm with this function to produce 'delete'
-   commands from the sub(-tract) tree. The subtract tree contains full paths
-   not present in the right hand side of the original comparison; the delete
-   tree is the subtract tree with paths ending at the first subtracted node.
-
-   Initial application of diff algorithm with function 'diff_trees':
-       left, right -> added, subtracted, intersection
-   Second application of diff algorithm with function 'trim_trees':
-       subtracted, right -> _, delete, _
-
-   One needs to keep the distinction of sub and delete trees: the delete
-   tree is used to produce correct 'delete' commands; the sub tree contains
-   complete information of the difference, used, for example, in recursively
-   detecting changes at a node between the effective/session configs.
-
-   The two trees could be produced in one pass of the diff function, but is
-   an overloaded use and would gain little in optimization: the trim-ing
-   walk will be on a smaller tree, only involve diff_func calls on the
-   subtracted nodes, and will end at the first node not present in the
-   comparison.
- *)
-let trim_trees (trees : diff_trees) ?(recurse=false) (path : string list) (m : change) =
-    match m with
-    | Added -> ()
-    | Subtracted -> trees.sub := clone ~recurse:recurse ~set_values:(Some []) trees.left !(trees.sub) path
-    | Unchanged -> ()
+    | Added -> Diff_tree {res with add = clone res.right res.add path; }
+    | Subtracted ->
+        Diff_tree {res with sub = clone res.left res.sub path;
+         del = clone ~recurse:false ~set_values:(Some []) res.left res.del path; }
+    | Unchanged ->
+        Diff_tree {res with inter = clone ~recurse:recurse res.left res.inter path; }
     | Updated v ->
             (* if in this case, node at path is guaranteed to exist *)
-            let ov = Config_tree.get_values trees.left path in
+            let ov = Config_tree.get_values res.left path in
             match ov, v with
-            | [_], [_] -> trees.sub := clone trees.left !(trees.sub) path;
+            | [_], [_] -> Diff_tree {res with sub = clone res.left res.sub path;
+                           del = clone res.left res.del path;
+                           add = clone res.right res.add path; }
             | _, _ -> let ov_set = ValueS.of_list ov in
                       let v_set = ValueS.of_list v in
                       let sub_vals = ValueS.elements (ValueS.diff ov_set v_set) in
                       let add_vals = ValueS.elements (ValueS.diff v_set ov_set) in
-                      (* in practice, the above sets will be disjoint *)
                       let inter_vals = ValueS.elements (ValueS.inter ov_set v_set) in
-                      if not (is_empty sub_vals) then
-                          if (is_empty add_vals) && (is_empty inter_vals) then
-                              (* delete whole node, not just values *)
-                              trees.sub := clone ~set_values:(Some []) trees.left !(trees.sub) path
+                      let sub_tree =
+                          if not (is_empty sub_vals) then
+                              clone ~set_values:(Some sub_vals) res.left res.sub path
+                          else
+                              res.sub
+                      in
+                      let del_tree =
+                          if not (is_empty sub_vals) then
+                              if (is_empty add_vals) && (is_empty inter_vals) then
+                                  (* delete whole node, not just values *)
+                                  clone ~set_values:(Some []) res.left res.del path
+                              else
+                                  clone ~set_values:(Some sub_vals) res.left res.del path
+                          else
+                              res.del
+                      in
+                      let add_tree =
+                          if not (is_empty add_vals) then
+                            clone ~set_values:(Some add_vals) res.right res.add path
+                          else
+                              res.add
+                      in
+                      let inter_tree =
+                          if not (is_empty inter_vals) then
+                              clone ~set_values:(Some inter_vals) res.left res.inter path
                           else
-                              trees.sub := clone ~set_values:(Some sub_vals) trees.left !(trees.sub) path
+                              res.inter
+                      in Diff_tree { res with add = add_tree;
+                           sub = sub_tree;
+                           del = del_tree;
+                           inter = inter_tree; }
 
 (* get sub trees for path-relative comparison *)
 let tree_at_path path node =
@@ -228,24 +243,19 @@ let compare path left right =
         let (left, right) = if not (path = []) then
             (tree_at_path path left, tree_at_path path right) else (left, right) in
         let trees = make_diff_trees left right in
-        diff [] (decorate_trees trees) [(Option.some left, Option.some right)];
-        trees
+        let d = diff [] decorate_trees trees (Option.some left, Option.some right)
+        in eval_result d
 
 (* wrapper to return diff trees *)
 let diff_tree path left right =
     let trees = compare path left right in
-    let add_node = make Config_tree.default_data "add" (children_of !(trees.add)) in
-    let sub_node = make Config_tree.default_data "sub" (children_of !(trees.sub)) in
-    let int_node = make Config_tree.default_data "inter" (children_of !(trees.inter)) in
-    let ret = make Config_tree.default_data "" [add_node; sub_node; int_node] in
+    let add_node = make Config_tree.default_data "add" (children_of (trees.add)) in
+    let sub_node = make Config_tree.default_data "sub" (children_of (trees.sub)) in
+    let del_node = make Config_tree.default_data "del" (children_of (trees.del)) in
+    let int_node = make Config_tree.default_data "inter" (children_of (trees.inter)) in
+    let ret = make Config_tree.default_data "" [add_node; sub_node; del_node; int_node] in
     ret
 
-(* wrapper to return trimmed tree for 'delete' commands *)
-let trim_tree left right =
-    let trees = make_diff_trees left right in
-    diff [] (trim_trees trees) [(Option.some left, Option.some right)];
-    !(trees.sub)
-
 (* the following builds a diff_func to return a unified diff string of
    configs or config commands
  *)
@@ -253,10 +263,8 @@ let list_but_last l =
     let len = List.length l in
     List.filteri (fun i _ -> i < len - 1) l
 
-let ppath_to_string_if_new (c: string list ref) (path: string list) =
-    let p = list_but_last path in
-    if (!c <> p) then
-        (c := p; Printf.sprintf "[%s]\n" (String.concat " " !c)) else ""
+let path_to_string (path: string list) =
+    Printf.sprintf "[%s]\n" (String.concat " " path)
 
 let marked_render mark node =
     let lines = Config_tree.render_config node in
@@ -268,51 +276,76 @@ let marked_render mark node =
 let added_lines ?(cmds=false) node path =
     if not cmds then marked_render "+ " (tree_at_path path node)
     else
-        let skel = Config_tree.make "" in
-        let snode = clone node skel path in
-        (Config_tree.render_commands ~op:Set snode []) ^ "\n"
+        (Config_tree.render_commands ~op:Set node []) ^ "\n"
 
 let removed_lines ?(cmds=false) node path =
     if not cmds then marked_render "- " (tree_at_path path node)
     else
-        let skel = Config_tree.make "" in
-        let snode = clone node skel path in
-        (Config_tree.render_commands ~op:Delete snode []) ^ "\n"
+        (Config_tree.render_commands ~op:Delete node []) ^ "\n"
 
-let order_commands (strl: string ref) =
-    let l = String.split_on_char '\n' !strl in
+let order_commands (strl: string) =
+    let l = String.split_on_char '\n' strl in
     let del = List.filter (fun s -> (s <> "") && (s.[0] = 'd')) l in
     let set = List.filter (fun s -> (s <> "") && (s.[0] = 's')) l in
-    strl := (String.concat "\n" del) ^ "\n" ^ (String.concat "\n" set) ^ "\n"
-
-let ppath = ref [""]
+    (String.concat "\n" del) ^ "\n" ^ (String.concat "\n" set) ^ "\n"
 
-let unified_diff ?(cmds=false) (str_diff: string ref) (trees : diff_trees) ?recurse:_ (path : string list) (m : change) =
+let unified_diff ?(cmds=false) ?recurse:_ (path : string list) (Diff_string res) (m : change) =
+    let ppath_l = list_but_last path
+    in
+    let ppath_s =
+        if (ppath_l <> res.ppath) then path_to_string ppath_l
+        else ""
+    in
+    let str_diff =
+        if not cmds then res.udiff ^ ppath_s
+        else res.udiff
+    in
     match m with
     | Added ->
-            if not cmds then str_diff := !str_diff ^ (ppath_to_string_if_new ppath path);
-            str_diff := !str_diff ^ (added_lines ~cmds:cmds trees.right path)
+            let str_diff =
+                let add_tree = clone res.right res.skel path in
+                str_diff ^ (added_lines ~cmds:cmds add_tree path)
+            in
+            Diff_string { res with ppath = ppath_l; udiff = str_diff; }
     | Subtracted ->
-            if not cmds then str_diff := !str_diff ^ (ppath_to_string_if_new ppath path);
-            str_diff := !str_diff ^ (removed_lines ~cmds:cmds trees.left path)
-    | Unchanged -> ()
+            let str_diff =
+                let sub_tree = clone res.left res.skel path in
+                str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
+            in
+            Diff_string { res with ppath = ppath_l; udiff = str_diff; }
+    | Unchanged -> Diff_string (res)
     | Updated v ->
-            if not cmds then str_diff := !str_diff ^ (ppath_to_string_if_new ppath path);
-            let ov = Config_tree.get_values trees.left path in
+            let ov = Config_tree.get_values res.left path in
             match ov, v with
             | [_], [_] ->
-                    str_diff := !str_diff ^ (removed_lines ~cmds:cmds trees.left path);
-                    str_diff := !str_diff ^ (added_lines ~cmds:cmds trees.right path)
+                    let str_diff =
+                        let sub_tree = clone res.left res.skel path in
+                        str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
+                    in
+                    let str_diff =
+                        let add_tree = clone res.right res.skel path in
+                        str_diff ^ (added_lines ~cmds:cmds add_tree path)
+                    in
+                    Diff_string { res with ppath = ppath_l; udiff = str_diff; }
             | _, _ -> let ov_set = ValueS.of_list ov in
                       let v_set = ValueS.of_list v in
                       let sub_vals = ValueS.elements (ValueS.diff ov_set v_set) in
                       let add_vals = ValueS.elements (ValueS.diff v_set ov_set) in
-                      if not (is_empty sub_vals) then
-                          (trees.sub := clone ~set_values:(Some sub_vals) trees.left !(trees.sub) path;
-                           str_diff := !str_diff ^ (removed_lines ~cmds:cmds !(trees.sub) path));
-                      if not (is_empty add_vals) then
-                          (trees.add := clone ~set_values:(Some add_vals) trees.right !(trees.add) path;
-                           str_diff := !str_diff ^ (added_lines ~cmds:cmds !(trees.add) path))
+                      let str_diff =
+                          if not (is_empty sub_vals) then
+                              let sub_tree =
+                                  clone ~set_values:(Some sub_vals) res.left res.skel path
+                              in str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
+                          else str_diff
+                      in
+                      let str_diff =
+                          if not (is_empty add_vals) then
+                              let add_tree =
+                                  clone ~set_values:(Some add_vals) res.right res.skel path
+                              in str_diff ^ (added_lines ~cmds:cmds add_tree path)
+                          else str_diff
+                      in
+                      Diff_string { res with ppath = ppath_l; udiff = str_diff; }
 
 let add_empty_path src_node dest_node path =
     clone ~recurse:false ~set_values:(Some []) src_node dest_node path
@@ -346,12 +379,16 @@ let show_diff ?(cmds=false) path left right =
             if (path <> []) then
                 compare_at_path_maybe_empty left right path
             else (left, right) in
-        let trees = make_diff_trees left right in
-        let udiff = ref "" in
-        ppath := [""];
-        diff [] (unified_diff ~cmds:cmds udiff trees) [(Option.some left, Option.some right)];
-        if cmds then order_commands udiff;
-        !udiff
+        let dstr = make_diff_string left right in
+        let dstr =
+            diff [] (unified_diff ~cmds:cmds) dstr (Option.some left, Option.some right)
+        in
+        let dstr = eval_result dstr in
+        let strs =
+            if cmds then order_commands dstr.udiff
+            else dstr.udiff
+        in
+        strs
 
 let union_of_values (n : Config_tree.t) (m : Config_tree.t) =
     let set_n = ValueS.of_list (data_of n).values in
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 0f4ebf0..c995ba3 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -1,25 +1,39 @@
-type change = Unchanged | Added | Subtracted | Updated of string list
 
-type diff_func = ?recurse:bool -> string list -> change -> unit
+module Diff_tree : sig
+    type t = { left: Config_tree.t;
+               right: Config_tree.t;
+               add: Config_tree.t;
+               sub: Config_tree.t;
+               del: Config_tree.t;
+               inter: Config_tree.t;
+             }
+end
 
-type diff_trees = {
-    left: Config_tree.t;
-    right: Config_tree.t;
-    add: Config_tree.t ref;
-    sub: Config_tree.t ref;
-    inter: Config_tree.t ref;
-}
+module Diff_string : sig
+    type t = { left: Config_tree.t;
+               right : Config_tree.t;
+               skel: Config_tree.t;
+               ppath: string list;
+               udiff: string;
+             }
+end
+
+module Diff_cstore : sig
+    type t = { left: Config_tree.t;
+               right: Config_tree.t;
+               handle: int;
+             }
+end
+
+type _ result =
+    | Diff_tree : Diff_tree.t -> Diff_tree.t result
+    | Diff_string : Diff_string.t -> Diff_string.t result
+    | Diff_cstore : Diff_cstore.t -> Diff_cstore.t result
 
 exception Incommensurable
 exception Empty_comparison
 exception Nonexistent_child
 
-val make_diff_trees : Config_tree.t -> Config_tree.t -> diff_trees
-val clone : ?recurse:bool -> ?set_values:(string list) option -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
-val decorate_trees : diff_trees -> ?recurse:bool -> string list -> change -> unit
-val trim_trees : diff_trees -> ?recurse:bool -> string list -> change -> unit
-val compare : string list -> Config_tree.t -> Config_tree.t -> diff_trees
 val diff_tree : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t
-val trim_tree : Config_tree.t -> Config_tree.t -> Config_tree.t
 val show_diff : ?cmds:bool -> string list -> Config_tree.t -> Config_tree.t -> string
 val tree_union : Config_tree.t -> Config_tree.t -> Config_tree.t