From 921415e08e4f696e285562ed8f49112db0de5332 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Wed, 5 Aug 2026 20:59:08 -0500 Subject: T9169: factor out diff calculation module --- src/diff.ml | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) create mode 100644 src/diff.ml (limited to 'src/diff.ml') diff --git a/src/diff.ml b/src/diff.ml new file mode 100644 index 0000000..6a87d93 --- /dev/null +++ b/src/diff.ml @@ -0,0 +1,74 @@ +type change = Unchanged | Added | Subtracted | Updated of string list + +exception Incommensurable +exception Empty_comparison + +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 + +let (^~) (node : Config_tree.t) (node' : Config_tree.t) = + name_of node = name_of node' && + (data_of node).values <> (data_of node').values + +let left_opt_pairs n m = + (children_of n) |> List.map (fun x -> + let maybe_node = + (children_of m) |> List.find_opt (fun y -> + name_of y = name_of x) in + (Some x, maybe_node)) + +let right_opt_pairs n m = + (children_of m) |> List.map (fun y -> + let maybe_node = + (children_of n) |> List.find_opt (fun x -> + name_of x = name_of y) in + (maybe_node, Some y)) + +let opt_tuple_cmp t1 t2 = + let opt_tuple_val t = + match t with + | None, None -> "" + | Some x, None -> name_of x + | None, Some y -> name_of y + | Some x, Some _ -> name_of x + in Util.lexical_numeric_compare (opt_tuple_val t1) (opt_tuple_val t2) + +let opt_zip n m = + left_opt_pairs n m @ right_opt_pairs n m |> List.sort_uniq opt_tuple_cmp + +let get_opt_name left_opt right_opt = + match left_opt, right_opt with + | Some left_node, None -> name_of left_node + | None, Some right_node -> name_of right_node + | Some left_node, Some _ -> name_of left_node + | None, None -> raise Empty_comparison + +let update_path path left_opt right_opt = + let name = get_opt_name left_opt right_opt in + if name = "" then path + else path @ [name] + +module type Place = sig + type t + val diff_func : ?recurse:bool -> string list -> t -> change -> t +end + +module Diff (P: Place) = struct + let rec diff_calc (path : string list) (res: P.t) ((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 -> P.diff_func path res Subtracted + | None, Some _ -> P.diff_func path res Added + | Some left_node, Some right_node when left_node = right_node -> + P.diff_func ~recurse:true path res Unchanged + | Some left_node, Some right_node when left_node ^~ right_node -> + let values = (data_of right_node).values in + P.diff_func path res (Updated values) + | Some left_node, Some right_node -> + let ret = P.diff_func ~recurse:false path res Unchanged in + List.fold_left (diff_calc path) ret (opt_zip left_node right_node) + + let diff (init: P.t) l r = diff_calc [] init (Option.some l, Option.some r) +end -- cgit v1.2.3