+type event = Open of string * (string * string) list | Close of string | Text of string
+
+let eq_event e1 e2 =
+ match e1, e2 with
+ | Open(t1, l1), Open(t2, l2) -> t1 = t2 &&
+ let sl1 = List.sort compare l1
+ and sl2 = List.sort compare l2 in sl1 = sl2
+ | Close t1, Close t2 -> t1 = t2
+ | Text s1 , Text s2 -> s1 = s2
+ | _ -> false
+
+
+type position = {
+ byte_index : int;
+ column_num : int;
+ line_num : int;
+ byte_count : int;
+}
+
+type ctx = {
+ text_buffer : Buffer.t;
+ events : (event*position) Queue.t;
+}
+let get_position p =
+ { byte_index = Expat.get_current_byte_index p;
+ column_num = Expat.get_current_column_number p;
+ line_num = Expat.get_current_line_number p;
+ byte_count = Expat.get_current_byte_count p;
+ }
+
+
+let rec start_element_handler parser_ ctx tag attr_list =
+ do_text parser_ ctx;
+ Queue.add (Open(tag, attr_list), get_position parser_) ctx.events
+
+and end_element_handler parser_ ctx tag =
+ do_text parser_ ctx;
+ Queue.add (Close(tag), get_position parser_) ctx.events
+
+and do_text parser_ ctx =
+ if Buffer.length ctx.text_buffer != 0 then
+ let s = Buffer.contents ctx.text_buffer in
+ Buffer.clear ctx.text_buffer;
+ Queue.add (Text s, get_position parser_) ctx.events
+
+let character_data_handler parser_ ctx text =
+ Buffer.add_string ctx.text_buffer text
+
+let create_parser () =
+ let ctx1 = { text_buffer = Buffer.create 512; events = Queue.create (); } in
+ let parser1 = Expat.parser_create ~encoding:None in
+ Expat.set_start_element_handler parser1 (start_element_handler parser1 ctx1);
+ Expat.set_end_element_handler parser1 (end_element_handler parser1 ctx1);
+ Expat.set_character_data_handler
+ parser1 (character_data_handler parser1 ctx1);
+ parser1, ctx1
+
+exception Diff of position
+
+let diffs fd1 fd2 =
+ let buffer1 = String.create 4096 in
+ let buffer2 = String.create 4096 in
+ let parser1,ctx1 = create_parser () in
+ let parser2,ctx2 = create_parser () in
+ let rec loop () =
+ let read1 = input fd1 buffer1 0 4096 in
+ let read2 = input fd2 buffer2 0 4096 in
+ if read1 == 0 && read2 == 0 then () else
+ let () = Expat.parse_sub parser1 buffer1 0 read1 in
+ let () = Expat.parse_sub parser2 buffer2 0 read2 in
+ for i = 1 to min (Queue.length ctx1.events) (Queue.length ctx2.events) do
+ let e1,p1 = Queue.pop ctx1.events in
+ let e2,_ = Queue.pop ctx2.events in
+ if not (eq_event e1 e2) then
+ raise (Diff p1)
+ done;
+ loop ()
+ in
+ loop ()
+
+let main () =
+ if Array.length Sys.argv != 3 then
+ Printf.eprintf "usage: %s file1.xml file2.xml\n%!" Sys.argv.(0)
+ else
+ let fn1 = Sys.argv.(1) in
+ let fn2 = Sys.argv.(2) in
+ try
+ let fd1 = open_in fn1 in
+ let fd2 = open_in fn2 in
+ let () =
+ try
+ diffs fd1 fd2
+ with
+ Diff p -> Printf.printf "File %s and %s differ at line %i, column %i\n%!"
+ fn1 fn2 p.line_num p.column_num
+ in close_in fd1; close_in fd2
+ with
+ _ -> Printf.eprintf "Error\n%!"
+let () = main ()
+