Change the logging infrastructure:

[SXSI/xpathcomp.git] / src / transition.ml

diff --git a/src/transition.ml b/src/transition.ml
index 9f03aa0..6d868fb 100644 (file)
--- a/src/transition.ml
+++ b/src/transition.ml
@@ -15,38 +15,47 @@ include Hcons.Make(struct
                   end)
 let compare t1 t2 =
   let s1, l1, m1, f1 = node t1
-  and s2, l2, m2, f2 = node t2
-  in
+  and s2, l2, m2, f2 = node t2 in
   let r = compare s1 s2 in
+  if r != 0 then r else
+    let r = TagSet.compare l1 l2 in
     if r != 0 then r else
-      let r = TagSet.compare l1 l2 in
-       if r != 0 then r else
-         let r = compare m1 m2 in
-           if r != 0 then r else
-             Formula.compare f1 f2
+      let r = compare m1 m2 in
+      if r != 0 then r else
+       Formula.compare f1 f2
 
-let print_lhs ppf t =
+let print_lhs (ppf: Format.formatter) (t : t) : unit =
   let state, tagset , _, _ = node t in
-    fprintf ppf "(%a, %a)"
-      State.print state TagSet.print tagset
+  fprintf ppf "(%a, %a)%!"
+    State.print state TagSet.print tagset
 
 let print_arrow ppf t =
   let _, _, mark, _ = node t in
-    fprintf ppf "%s"
-      (if mark then Pretty.double_right_arrow else Pretty.right_arrow)
+  fprintf ppf "%s%!"
+    (if mark then Pretty.double_right_arrow else Pretty.right_arrow)
 
 let print_rhs ppf t =
   let _, _, _, f = node t in
-    Formula.print ppf f
+  Formula.print ppf f
 
-let print ppf f =
-  print_lhs ppf f;
-  print_arrow ppf f;
-  print_rhs ppf f
+let string_of f x =
+  ignore (flush_str_formatter());
+  fprintf str_formatter "%a" f x;
+  flush_str_formatter ()
 
-let format_list l =
+let print ppf f =
+  let s1 = string_of print_lhs f in
+  let s2 = string_of print_arrow f in
+  let s3 = string_of print_rhs f in
+  fprintf ppf "%s %s %s%!" s1 s2 s3
+(*
+  fprintf ppf "%!%a%a%a%!" print_lhs f print_arrow f print_rhs f
+*)
+let format_list =
+  let b = Buffer.create 10 in
+  fun l ->
   let make_str f x =
-    let b = Buffer.create 10 in
+    Buffer.clear b;
     let fmt = formatter_of_buffer b in
     pp_print_flush fmt ();
     fprintf fmt "%a" f x;
@@ -54,25 +63,25 @@ let format_list l =
     Buffer.contents b
   in
   let str_trans t =
-    let lhs = make_str print_lhs t
-    and arrow = make_str print_arrow t
-    and rhs = make_str print_rhs t in
-      (lhs, arrow, rhs)
+    let lhs = make_str print_lhs t in
+    let arrow = make_str print_arrow t in
+    let rhs = make_str print_rhs t in
+    (lhs, arrow, rhs)
   in
   let size, strings =
     List.fold_left
       (fun (a_size, a_str) tr ->
-        let lhs, _, _ as str = str_trans tr in
-        let len = String.length lhs in
-          ((if len > a_size then len else a_size),
-           str::a_str)) (0, []) l
+       let lhs, _, _ as str = str_trans tr in
+       let len = String.length lhs in
+       ((if len > a_size then len else a_size),
+        str::a_str)) (0, []) l
   in
-    List.map (fun (lhs, arrow, rhs) ->
-               sprintf "%s%s%s %s"
-                 lhs
-                 (Pretty.padding (size - Pretty.length lhs))
-                 arrow
-                 rhs) (List.rev strings)
+  List.map (fun (lhs, arrow, rhs) ->
+    sprintf "%s%s%s %s@?"
+      lhs
+      (Pretty.padding (size - Pretty.length lhs))
+      arrow
+      rhs) (List.rev strings)
 
 module Infix = struct
   let ( ?< ) x = x